diff --git a/SEQTaRget/DESCRIPTION b/SEQTaRget/DESCRIPTION index 671e6f0..0b2a608 100644 --- a/SEQTaRget/DESCRIPTION +++ b/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"), diff --git a/SEQTaRget/NEWS.md b/SEQTaRget/NEWS.md new file mode 100644 index 0000000..8ce0fdc --- /dev/null +++ b/SEQTaRget/NEWS.md @@ -0,0 +1,2 @@ +# SEQTaRget v1.3.3 +- Found and fixed a bug which caused excused switches to be overwritten. \ No newline at end of file diff --git a/SEQTaRget/R/SEQexpand.R b/SEQTaRget/R/SEQexpand.R index d0c9128..d390c1d 100644 --- a/SEQTaRget/R/SEQexpand.R +++ b/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] diff --git a/SEQTaRget/tests/testthat/test_coefficients.R b/SEQTaRget/tests/testthat/test_coefficients.R index 7745f0c..4312fbd 100644 --- a/SEQTaRget/tests/testthat/test_coefficients.R +++ b/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) diff --git a/SEQTaRget/tests/testthat/test_multinomial.R b/SEQTaRget/tests/testthat/test_multinomial.R index 4376b62..cdaec44 100644 --- a/SEQTaRget/tests/testthat/test_multinomial.R +++ b/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)