Fix excusing override

SEQTaRget/DESCRIPTION

@@ -1,7 +1,7 @@
 Package: SEQTaRget
 Type: Package
 Title: Sequential Trial Emulation
-Version: 1.3.2
+Version: 1.3.3
 Authors@R: c(person(given = "Ryan",
                     family = "O'Dea",
                     role = c("aut", "cre"),

SEQTaRget/NEWS.md

@@ -0,0 +1,2 @@
+# SEQTaRget v1.3.3
+- Found and fixed a bug which caused excused switches to be overwritten.

SEQTaRget/R/SEQexpand.R

@@ -118,9 +118,12 @@ SEQexpand <- function(params) {
 
           for (i in seq_along(params@treat.level)) {
             if (!is.na(params@excused.cols[[i]])) {
-              out[(switch) & get(params@treatment) != lag, isExcused := ifelse(get(params@excused.cols[[i]]) == 1, 1, 0)]
+              out[(switch) & 
+                    get(params@treatment) != lag & 
+                    get(params@treatment) == params@treat.level[[i]], isExcused := ifelse(get(params@excused.cols[[i]]) == 1, 1, 0)]
             }
           }
+          setorderv(out, c(params@id, "trial", "followup"))
           out[!is.na(isExcused), excused_tmp := cumsum(isExcused), by = c(params@id, "trial")
               ][(excused_tmp) > 0, switch := FALSE, by = c(params@id, "trial")
                 ][, excused_tmp := NULL]

SEQTaRget/tests/testthat/test_coefficients.R

@@ -105,9 +105,9 @@ test_that("Pre-Expansion Excused Censoring", {
   ))
   expect_s4_class(model, "SEQoutput")
 
-  expected <- list(`(Intercept)` = -5.42052158047681, tx_init_bas1 = 0.0154227345149424, 
-                   followup = -0.0408558825362014, followup_sq = 0.00179320897922023, 
-                   trial = 0.108000684079347, trial_sq = -0.000921161480033338)
+  expected <- list(`(Intercept)` = -5.4207746927666, tx_init_bas1 = 0.124102810577887, 
+                   followup = -0.0363940708696263, followup_sq = 0.00170562670290001, 
+                   trial = 0.105672012267695, trial_sq = -0.000913283586987528)
 
   test <- as.list(coef(model@outcome.model[[1]][[1]]))
   expect_equal(test, expected, tolerance = 1e-2)
@@ -121,15 +121,15 @@ test_that("Post-Expansion Excused Censoring", {
     options = SEQopts(
       weighted = TRUE, excused = TRUE,
       excused.cols = c("excusedZero", "excusedOne"),
-      weight.preexpansion = FALSE)
+      weight.preexpansion = FALSE, weight.upper = 1)
   ))
   expect_s4_class(model, "SEQoutput")
 
-  expected <- list(`(Intercept)` = -8.88763717868362, tx_init_bas1 = 0.198051643351188, 
-                   followup = 0.0317279217251541, followup_sq = -3.88168649840642e-05, 
-                   trial = 0.0850672288677481, trial_sq = 0.000212131078797662, 
-                   sex1 = 0.272915352241597, N_bas = 0.0022299598871816, L_bas = 0.0200873699867599, 
-                   P_bas = 0.402646071551357)
+  expected <- list(`(Intercept)` = -7.72244119581646, tx_init_bas1 = 0.250404227055899, 
+                   followup = 0.0364424922903061, followup_sq = -0.000191693952826804, 
+                   trial = 0.0536773648010366, trial_sq = 0.000564318943610163, 
+                   sex1 = 0.0837024333706547, N_bas = 0.00525047866692634, L_bas = 0.00146794938896796, 
+                   P_bas = 0.300876994280762)
 
   test <- as.list(coef(model@outcome.model[[1]][[1]]))
   expect_equal(test, expected, tolerance = 1e-2)

SEQTaRget/tests/testthat/test_multinomial.R

@@ -65,9 +65,9 @@ test_that("Multinomial Censoring Excused Pre-Expansion", {
   )
   expect_s4_class(model, "SEQoutput")
 
-  expected <- list(`(Intercept)` = -52.3894943563174, tx_init_bas1 = -4.39028002359654, 
-                   followup = 0.709855917998915, followup_sq = -0.0273142821592202, 
-                   trial = 3.60040336502847, trial_sq = -0.0706023467658923)
+  expected <- list(`(Intercept)` = -50.7111118692773, tx_init_bas1 = -4.566272104771, 
+                   followup = 0.777168505, followup_sq = -0.0278074277750756, 
+                   trial = 3.50456119247621, trial_sq = -0.0697743189877489)
 
   test <- as.list(coef(model@outcome.model[[1]][[1]]))
   expect_equal(test, expected, tolerance = 1e-2)
@@ -82,11 +82,11 @@ test_that("Multinomial Censoring Excused Post-Expansion", {
   )
   expect_s4_class(model, "SEQoutput")
 
-  expected <- list(`(Intercept)` = -22.8581470824005, tx_init_bas1 = -3.61440913739626, 
-                   followup = 0.243691412750202, followup_sq = -0.0164953482205765, 
-                   trial = 1.1171226465557, trial_sq = -0.024879010022683, sex1 = 21.3341934036542, 
-                   N_bas = -0.0331495480042171, L_bas = -0.0656028381271247, 
-                   P_bas = -2.5498722549852)
+  expected <- list(`(Intercept)` = -8.93642594359111, tx_init_bas1 = -5.61451410491509, 
+                   followup = 1.04686013063719, followup_sq = -0.0993244245914494, 
+                   trial = 0.486647207785848, trial_sq = -0.0121460057546972, 
+                   sex1 = 10.2124817342716, N_bas = 0.114894698211935, L_bas = 0.377648021676872, 
+                   P_bas = -2.23793202270577)
 
   test <- as.list(coef(model@outcome.model[[1]][[1]]))
   expect_equal(test, expected, tolerance = 1e-2)