Nothing
tests/testthat/test-kmciFunctions.R
In bpcp: Beta Product Confidence Procedure for Right Censored Data
###### FUNCTION: bpcpfit ######
test_that("bpcpfit - formula and regular data have same output", {
expect_equal(bpcpfit(Surv(time, status)~1, data=df_covars),
bpcpfit(time = df_covars$time, status = df_covars$status))
})
test_that("bpcpfit - error if Surv object is not provided in formula",{
expect_error(bpcpfit(status~1, data=leuk),
regexp="Response must be a survival (Surv) object",fixed=TRUE)
})
test_that("bpcpfit formula - na.action = na.omit works", {
# Fit the model with na.omit
res_na <- bpcpfit(Surv(time=time,event=status) ~ 1, data=leuk_na, na.action="na.omit")
res <- bpcpfit(Surv(time=time,event=status) ~ 1, data=leuk)
# Check that the rows with missing values are omitted
expect_equal(res_na[[1]]$num, nrow(na.omit(leuk_na)))
# check that results are different from when there are no na values
expect_false(identical(res_na,res))
})
test_that("bpcpfit formula - na.action = na.exclude works", {
# Fit the model with na.exclude
res_na <- bpcpfit(Surv(time=time,event=status) ~ 1, data=leuk_na, na.action="na.exclude")
res <- bpcpfit(Surv(time=time,event=status) ~ 1, data=leuk)
# Check that the rows with missing values are omitted
expect_equal(res_na[[1]]$num, nrow(na.exclude(leuk_na)))
# check that results are different from when there are no na values
expect_false(identical(res_na,res))
})
test_that("bpcpfit - errors if time is not given (default)", {
expect_error(bpcpfit(status=leuk$status))
})
test_that("bpcpfit - errors if time is not given (formula)", {
expect_error(bpcpfit(Surv(event=status) ~ 1, data=leuk))
})
# FIX - add to spreadsheet
test_that("bpcpfit - no error if status is not given (default)", {
expect_error(bpcpfit(time=leuk$time), regexp=NA)
})
test_that("bpcpfit - no error if status is not given (formula)", {
expect_error(bpcpfit(Surv(time=time) ~ 1, data=leuk), regexp=NA)
})
test_that("bpcpfit - no error if status is not given with group (default)", {
expect_error(bpcpfit(time=leuk2$time,group=leuk2$treatment), regexp=NA)
})
test_that("bpcpfit - no error if status is not given with group (formula)", {
expect_error(bpcpfit(Surv(time=time) ~ treatment, data=leuk2), regexp=NA)
})
test_that("bpcpfit - no error if group is a character vector (formula)", {
expect_error(bpcpfit(Surv(time=time) ~ treatment_char, data=leuk2), regexp=NA)
})
test_that("bpcpfit - error when status is not 0 and 1 (default)", {
expect_error(bpcpfit(time=c(1,5,10,15,20),status=c(1,2,1,2,1)),
regexp="status must be a vector with values 0 or 1")
})
test_that("bpcpfit - error when status is not 0 and 1 (formula)", {
expect_error(bpcpfit(Surv(c(1,5,10,15,20),c(1,2,1,2,1)) ~ 1),
regexp="status must be a vector with values 0 or 1")
})
test_that("bpcpfit - warning is given when alpha is specified (default)", {
expect_warning(bpcpfit(time=leuk$time,status=leuk$status, alpha=0.03))
})
test_that("bpcpfit - warning is given when alpha is specified (formula)", {
expect_warning(bpcpfit(Surv(time=time,event=status) ~ 1, data=leuk, alpha=0.03))
})
test_that("bpcpfit - error when plotstyle is not ggplot or standard and NULL group", {
expect_error(bpcpfit(time=leuk$time,status=leuk$status, plotstyle = "test"),
regexp='Plot style must be either "ggplot" or "standard"')
})
test_that("bpcpfit - error when plotstyle is not ggplot or standard and group is specified", {
expect_error(bpcpfit(time=leuk2$time,status=leuk2$status, group=leuk2$treatment, plotstyle = "test"),
regexp='Plot style must be either "ggplot" or "standard"')
})
test_that(" ", {
expect_error(bpcpfit(time = c(1,5,10,15,20), status = c(0,1,2,1,0)),
regexp="status must be a vector with values 0 or 1")
})
test_that("bpcpfit - error when more than 2 statuses (default) and group is specified", {
expect_error(bpcpfit(time = c(1,5,10,15,20), status = c(0,1,2,1,0), group=c("T","T","T","P","P")),
regexp="status must be a vector with values 0 or 1")
})
test_that("bpcpfit - error when more than 2 statuses (formula)", {
expect_error(bpcpfit(Surv(time=c(1,5,10,15,20),event=c(0,1,2,1,0)) ~1 ),
regexp="status must be a vector with values 0 or 1")
})
test_that("bpcpfit - error when more than 2 statuses (formula) and group is specified", {
expect_error(bpcpfit(Surv(c(1,5,10,15,20),c(0,1,2,1,0)) ~ c("T","T","T","P","P")),
regexp="status must be a vector with values 0 or 1")
})
test_that("bpcpfit - error when more than 1 covariate", {
expect_error(bpcpfit(Surv(time, status)~group+sex, data=df_covars),
regexp = "Only a treatment/grouping variable can be specified in this function. No other covariates should be included.")
})
test_that("bpcpfit - error when interaction", {
expect_error(bpcpfit(Surv(time, status)~group*sex, data=df_covars),
regexp="Interaction terms are not valid for this function")
})
test_that("StCI - upper confidence interval is greater than lower",{
res <- bpcpfit(time=leuk2$time,status=leuk2$status)
ci_res <- StCI(res, tstar=unique(leuk2$time))
expect_true(all(ci_res$upper >= ci_res$lower))
})
test_that("Error in bpcp when Delta is less than 0", {
expect_error(bpcpfit(time=leuk2$time,status = leuk2$status, Delta=-1),
regexp="Delta must be greater than 0")
})
## In 1.3.0 there was an error when the first observation
## was censored. It was a problem in the abmm function.
## fixed March 25, 2016
test_that("No error with abmm when first observation is censored", {
expect_error(bpcp(time=c(1:3),status=c(0,1,1)), regexp = NA)
})
test_that("bpcpfit - Warning when neither km nor mue are specified as stype",{
expect_warning(bpcpfit(time=leuk2$time,status = leuk2$status, stype="test"),
regexp="assuming stype='mue' ")
})
#Pointwise confidence intervals for a single sample should equal binom.test using the number failures and successes by time t
test_that("One sample CI equals binomial test when no observations are censored - time 1", {
expect_equal(c(summary(bpcpfit(time = c(1,5,10,15,20), status = c(1,1,1,1,1)))[1,3],
summary(bpcpfit(time = c(1,5,10,15,20), status = c(1,1,1,1,1)))[1,4]),
c(binom.test(5,5)$conf.int[1], binom.test(5,5)$conf.int[2]))
})
test_that("One sample CI equals binomial test when no observations are censored - time 2", {
expect_equal(c(summary(bpcpfit(time = c(1,5,10,15,20), status = c(1,1,1,1,1)))[2,3],
summary(bpcpfit(time = c(1,5,10,15,20), status = c(1,1,1,1,1)))[2,4]),
c(binom.test(4,5)$conf.int[1], binom.test(4,5)$conf.int[2]))
})
test_that("One sample CI equals binomial test when no observations are censored - time 3", {
expect_equal(c(summary(bpcpfit(time = c(1,5,10,15,20), status = c(1,1,1,1,1)))[3,3],
summary(bpcpfit(time = c(1,5,10,15,20), status = c(1,1,1,1,1)))[3,4]),
c(binom.test(3,5)$conf.int[1], binom.test(3,5)$conf.int[2]))
})
test_that("One sample CI equals binomial test when no observations are censored - time 4", {
expect_equal(c(summary(bpcpfit(time = c(1,5,10,15,20), status = c(1,1,1,1,1)))[4,3],
summary(bpcpfit(time = c(1,5,10,15,20), status = c(1,1,1,1,1)))[4,4]),
c(binom.test(2,5)$conf.int[1], binom.test(2,5)$conf.int[2]))
})
test_that("One sample CI equals binomial test when no observations are censored - time 5", {
expect_equal(c(summary(bpcpfit(time = c(1,5,10,15,20), status = c(1,1,1,1,1)))[5,3],
summary(bpcpfit(time = c(1,5,10,15,20), status = c(1,1,1,1,1)))[5,4]),
c(binom.test(1,5)$conf.int[1], binom.test(1,5)$conf.int[2]))
})
test_that("One sample CI equals binomial test when no observations are censored - time 6", {
expect_equal(c(summary(bpcpfit(time = c(1,5,10,15,20), status = c(1,1,1,1,1)))[6,3],
summary(bpcpfit(time = c(1,5,10,15,20), status = c(1,1,1,1,1)))[6,4]),
c(binom.test(0,5)$conf.int[1], binom.test(0,5)$conf.int[2]))
})
# Should match 2016 paper
test_that("One sample CI with censoring matches 2016 table 1 - time 1", {
expect_equal(round(c(summary(bpcpfit(time = sclerosis$year, status = sclerosis$status))[1,3],
summary(bpcpfit(time = sclerosis$year, status = sclerosis$status))[1,4]),3),
c(0.897,1))
})
test_that("One sample CI with censoring matches 2016 table 1 - time 8", {
expect_equal(round(c(summary(bpcpfit(time = sclerosis$year, status = sclerosis$status))[8,3],
summary(bpcpfit(time = sclerosis$year, status = sclerosis$status))[8,4]),3),
c(0.621, 0.913))
})
test_that("One sample CI with censoring matches 2016 table 1 - time 17 (last)", {
expect_equal(round(c(summary(bpcpfit(time = sclerosis$year, status = sclerosis$status))[17,3],
summary(bpcpfit(time = sclerosis$year, status = sclerosis$status))[17,4]),3),
c(0.533, 0.869))
})
test_that("One sample CI includes KM estimate when last observation (out of 5) is censored - time 1",{
res <- last_censored(time=1,param="ci")
expect_true(contains_est(res[1],res[2],last_censored(time=1,param="est")))
})
test_that("One sample CI includes KM estimate when last observation (out of 5) is censored - time 2",{
res <- last_censored(time=2,param="ci")
expect_true(contains_est(res[1],res[2],last_censored(time=2,param="est")))
})
test_that("One sample CI includes KM estimate when last observation (out of 5) is censored - time 3",{
res <- last_censored(time=3,param="ci")
expect_true(contains_est(res[1],res[2],last_censored(time=3,param="est")))
})
test_that("One sample CI includes KM estimate when last observation (out of 5) is censored - time 4",{
res <- last_censored(time=4,param="ci")
expect_true(contains_est(res[1],res[2],last_censored(time=4,param="est")))
})
test_that("One sample CI includes KM estimate when last observation (out of 5) is censored - time 5",{
res <- last_censored(time=5,param="ci")
expect_true(contains_est(res[1],res[2],last_censored(time=5,param="est")))
})
test_that("One sample CI includes KM estimate when last observation (out of 5) is censored - time 6",{
res <- last_censored(time=6,param="ci")
expect_true(contains_est(res[1],res[2],last_censored(time=6,param="est")))
})
# With no censoring, CI's should match binomial exact mid-p
test_that("Mid-p one sample CI with no censoring matches binomial exact mid-p - time 0", {
expect_equal(no_censoring(time=0,type="bpcp",arms=1,param="ci", midp=T)[1:2],
exactci::binom.exact(6,6, midp=T)$conf.int[1:2], tolerance=0.01)
})
test_that("Mid-p one sample CI with no censoring matches binomial exact mid-p - time 1", {
expect_equal(no_censoring(time=1,type="bpcp",arms=1,param="ci", midp=T)[1:2],
exactci::binom.exact(4,6, midp=T)$conf.int[1:2], tolerance=0.01)
})
test_that("Mid-p one sample CI with no censoring matches binomial exact mid-p - time 2", {
expect_equal(no_censoring(time=2,type="bpcp",arms=1,param="ci", midp=T)[1:2],
exactci::binom.exact(3,6, midp=T)$conf.int[1:2], tolerance=0.01)
})
test_that("Mid-p one sample CI with no censoring matches binomial exact mid-p - time 3", {
expect_equal(no_censoring(time=3,type="bpcp",arms=1,param="ci", midp=T)[1:2],
exactci::binom.exact(2,6, midp=T)$conf.int[1:2], tolerance=0.01)
})
test_that("Mid-p one sample CI with no censoring matches binomial exact mid-p - time 4", {
expect_equal(no_censoring(time=4,type="bpcp",arms=1,param="ci", midp=T)[1:2],
exactci::binom.exact(1,6, midp=T)$conf.int[1:2], tolerance=0.01)
})
test_that("Mid-p one sample CI with no censoring matches binomial exact mid-p - time 5", {
expect_equal(no_censoring(time=5,type="bpcp",arms=1,param="ci", midp=T)[1:2],
exactci::binom.exact(0,6, midp=T)$conf.int[1:2], tolerance=0.01)
})
# With censoring should match 2016 paper
test_that("Mid-p one sample CI with censoring matches 2016 table 1 - time 1", {
expect_equal(round(c(summary(bpcpfit(time = sclerosis$year, status = sclerosis$status, midp=T))[1,3],
summary(bpcpfit(time = sclerosis$year, status = sclerosis$status, midp=T))[1,4]),3),
c(0.916, 1.000))
})
test_that("Mid-p one sample CI with censoring matches 2016 table 1 - time 8", {
expect_equal(round(c(summary(bpcpfit(time = sclerosis$year, status = sclerosis$status,midp=T))[8,3],
summary(bpcpfit(time = sclerosis$year, status = sclerosis$status, midp=T))[8,4]),3),
c(0.635, 0.905))
})
test_that("Mid-p one sample CI with censoring matches 2016 table 1 - time 17 (last)", {
expect_equal(round(c(summary(bpcpfit(time = sclerosis$year, status = sclerosis$status, midp=T))[17,3],
summary(bpcpfit(time = sclerosis$year, status = sclerosis$status, midp=T))[17,4]),3),
c(0.551, 0.859))
})
test_that("One sample CI with no events - final timepoint is [0,1]",{
bpcp_noevents <- no_events(time=2,type="bpcp",param="ci")
expect_equal(
c(0,1),
c(bpcp_noevents[1],bpcp_noevents[2])
)
})
test_that("bpcpfit output of base R vs ggplot works with plotstyle parameter", {
res_ggplot <- bpcpfit(time=leuk$time,status=leuk$status)
res_base <- bpcpfit(time=leuk$time,status=leuk$status, plotstyle ="standard")
p_ggp <- plot(res_ggplot)
p_base <- plot(res_base)
expect_true(inherits(p_ggp, "ggplot"))
expect_false(inherits(p_base, "ggplot"))
})
test_that("90% CI with no censoring matches binomial exact - time 0", {
expect_equal(no_censoring(time=0,type="bpcp",arms=1,param="ci", conf.level=0.9)[1:2],
exactci::binom.exact(6,6, conf.level=0.9)$conf.int[1:2], tolerance=0.01)
})
test_that("90% CI with no censoring matches binomial exact - time 1", {
expect_equal(no_censoring(time=1,type="bpcp",arms=1,param="ci", conf.level=0.9)[1:2],
exactci::binom.exact(4,6, conf.level=0.9)$conf.int[1:2], tolerance=0.01)
})
test_that("90% CI with no censoring matches binomial exact - time 2", {
expect_equal(no_censoring(time=2,type="bpcp",arms=1,param="ci", conf.level=0.9)[1:2],
exactci::binom.exact(3,6, conf.level=0.9)$conf.int[1:2], tolerance=0.01)
})
test_that("90% CI with no censoring matches binomial exact - time 3", {
expect_equal(no_censoring(time=3,type="bpcp",arms=1,param="ci", conf.level=0.9)[1:2],
exactci::binom.exact(2,6, conf.level=0.9)$conf.int[1:2], tolerance=0.01)
})
test_that("90% CI with no censoring matches binomial exact - time 4", {
expect_equal(no_censoring(time=4,type="bpcp",arms=1,param="ci", conf.level=0.9)[1:2],
exactci::binom.exact(1,6, conf.level=0.9)$conf.int[1:2], tolerance=0.01)
})
test_that("90% CI with no censoring matches binomial exact - time 5", {
expect_equal(no_censoring(time=5,type="bpcp",arms=1,param="ci", conf.level=0.9)[1:2],
exactci::binom.exact(0,6, conf.level=0.9)$conf.int[1:2], tolerance=0.01)
})
test_that("Delta standard method (no trans) for one-sample matches Borkowf's table 7, column A, lower CI", {
standard_res <- kmciDelta(time=d$time,status=d$status, trans="none", method="standard")
# check lower
expect_equal(standard_res$lower,borkowf_tb7$a_Lower,tolerance=0.01)
})
test_that("Delta standard method (no trans) for one-sample matches Borkowf's table 7, column A, upper CI", {
standard_res <- kmciDelta(time=d$time,status=d$status, trans="none", method="standard")
# check lower
expect_equal(standard_res$upper,borkowf_tb7$a_Upper,tolerance=0.01)
})
test_that("Delta regular hybrid method (no trans) for one-sample matches Borkowf's table 7, column C, lower CI", {
reg_hybrid_res <- kmciDelta(time=d$time,status=d$status, trans="none", method="reg_hybrid")
# check lower
expect_equal(reg_hybrid_res$lower,borkowf_tb7$c_Lower,tolerance=0.01)
})
test_that("Delta regular hybrid method (no trans) for one-sample matches Borkowf's table 7, column C, upper CI", {
reg_hybrid_res <- kmciDelta(time=d$time,status=d$status, trans="none", method="reg_hybrid")
# check lower
expect_equal(reg_hybrid_res$upper,borkowf_tb7$c_Upper,tolerance=0.01)
})
test_that("Delta adjusted hybrid method (no trans) for one-sample matches Borkowf's table 7, column D, lower CI", {
adj_hybrid_res <- kmciDelta(time=d$time,status=d$status, trans="none", method="adj_hybrid")
# check lower
expect_equal(adj_hybrid_res$lower,borkowf_tb7$d_Lower,tolerance=0.01)
})
test_that("Delta adjusted hybrid method (no trans) for one-sample matches Borkowf's table 7, column D, upper CI", {
adj_hybrid_res <- kmciDelta(time=d$time,status=d$status, trans="none", method="adj_hybrid")
# check lower
expect_equal(adj_hybrid_res$upper,borkowf_tb7$d_Upper,tolerance=0.01)
})
test_that("Delta shrunken adjusted hybrid method (no trans) for one-sample matches Borkowf's table 7, column E, lower CI", {
sh_adj_hybrid_res <- kmciDelta(time=d$time,status=d$status, trans="none", method="sh_adj_hybrid")
# check lower
expect_equal(sh_adj_hybrid_res$lower,borkowf_tb7$e_Lower,tolerance=0.01)
})
test_that("Delta shrunken adjusted hybrid method (no trans) for one-sample matches Borkowf's table 7, column E, upper CI", {
sh_adj_hybrid_res <- kmciDelta(time=d$time,status=d$status, trans="none", method="sh_adj_hybrid")
# check lower
expect_equal(sh_adj_hybrid_res$upper,borkowf_tb7$e_Upper,tolerance=0.01)
})
test_that("log transformation can be inverted, and vice versa", {
h<- function(S){ log(S) }
hinv<-function(y){exp(y)}
S <- seq(0,1, by = 0.1)
expect_true(all(round(hinv(h(S)),1)==round(S,1)))
# transformation bounds are -Inf to 0
y = c(-Inf,0)
expect_true(all(round(h(hinv(y)),1)==round(y,1)))
})
test_that("cloglog transformation can be inverted, and vice versa", {
h<- function(S){ log(-log(1-S)) }
hinv<-function(y){1-exp(-exp(y))}
S <- seq(0,1, by = 0.1)
expect_true(all(round(hinv(h(S)),1)==round(S,1)))
# transformation bounds are -Inf to Inf
y = c(-Inf,Inf)
expect_true(all(round(h(hinv(y)),1)==round(y,1)))
})
test_that("log odds transformation can be inverted, and vice versa", {
h<- function(S){ log(S/(1-S)) }
hinv<-function(y){ ifelse(y==Inf,1,exp(y)/(1+exp(y))) }
S <- seq(0,1, by = 0.1)
expect_true(all(round(hinv(h(S)),1)==round(S,1)))
# transformation bounds are -Inf to Inf
y = c(-Inf,Inf)
expect_true(all(round(h(hinv(y)),1)==round(y,1)))
})
test_that("clog transformation can be inverted, and vice versa", {
h<- function(S){ log(1-S) }
hinv<-function(y){1-exp(y)}
S <- seq(0,1, by = 0.1)
expect_true(all(round(hinv(h(S)),1)==round(S,1)))
# transformation bounds are -Inf to 0
y = c(-Inf,0)
expect_true(all(round(h(hinv(y)),1)==round(y,1)))
})
test_that("loglog transformation can be inverted, and vice versa", {
h<- function(S){ log(-log(S)) }
hinv<-function(y){exp(-exp(y))}
S <- seq(0,1, by = 0.1)
expect_true(all(round(hinv(h(S)),1)==round(S,1)))
# transformation bounds are -Inf to Inf
y = c(-Inf,Inf)
expect_true(all(round(h(hinv(y)),1)==round(y,1)))
})
test_that("kmciDelta no transformation produces CI in the right direction", {
res <- kmciDelta(time=leuk2$time,status=leuk2$status, trans="none", method="standard")
expect_true(all(res$lower <= res$upper))
})
test_that("kmciDelta log transformation produces CI in the right direction", {
res <- kmciDelta(time=leuk2$time,status=leuk2$status, trans="log", method="standard")
expect_true(all(res$lower <= res$upper))
})
test_that("kmciDelta cloglog transformation produces CI in the right direction", {
res <- kmciDelta(time=leuk2$time,status=leuk2$status, trans="cloglog", method="standard")
expect_true(all(res$lower <= res$upper))
})
test_that("kmciDelta clog transformation produces CI in the right direction", {
res <- kmciDelta(time=leuk2$time,status=leuk2$status, trans="clog", method="standard")
expect_true(all(res$lower <= res$upper))
})
test_that("kmciDelta logodds transformation produces CI in the right direction", {
res <- kmciDelta(time=leuk2$time,status=leuk2$status, trans="logodds", method="standard")
expect_true(all(res$lower <= res$upper))
})
test_that("kmciDelta loglog transformation produces CI in the right direction", {
res <- kmciDelta(time=leuk2$time,status=leuk2$status, trans="loglog", method="standard")
expect_true(all(res$lower <= res$upper))
})
test_that("method=st will call method=standard in kmciDelta", {
shortened <- kmciDelta(time=leuk2$time,status=leuk2$status, method="st")
full <- kmciDelta(time=leuk2$time,status=leuk2$status, method="standard")
expect_true(all(shortened$lower == full$lower))
expect_true(all(shortened$upper == full$upper))
})
test_that("method=r will call method=reg_hybrid in kmciDelta", {
shortened <- kmciDelta(time=leuk2$time,status=leuk2$status, method="r")
full <- kmciDelta(time=leuk2$time,status=leuk2$status, method="reg_hybrid")
expect_true(all(shortened$lower == full$lower))
expect_true(all(shortened$upper == full$upper))
})
test_that("method=a will call method=adj_hybrid in kmciDelta", {
shortened <- kmciDelta(time=leuk2$time,status=leuk2$status, method="a")
full <- kmciDelta(time=leuk2$time,status=leuk2$status, method="adj_hybrid")
expect_true(all(shortened$lower == full$lower))
expect_true(all(shortened$upper == full$upper))
})
test_that("method=sh will call method=sh_adj_hybrid in kmciDelta", {
shortened <- kmciDelta(time=leuk2$time,status=leuk2$status, method="sh")
full <- kmciDelta(time=leuk2$time,status=leuk2$status, method="sh_adj_hybrid")
expect_true(all(shortened$lower == full$lower))
expect_true(all(shortened$upper == full$upper))
})
test_that("zero one adjustment works with 100% survival cases, standard method, no trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="standard",zero.one.adjustment = T, trans="none")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, regular hybrid method, no trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="reg_hybrid",zero.one.adjustment = T, trans="none")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, adjusted hybrid method", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="adj_hybrid",zero.one.adjustment = T, trans="none")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, shrunken KM method, no trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="sh_adj_hybrid",zero.one.adjustment = T, trans="none")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, standard method, no trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="standard",zero.one.adjustment = T, trans="none")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, regular hybrid method, no trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="reg_hybrid",zero.one.adjustment = T, trans="none")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, adjusted hybrid method", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="adj_hybrid",zero.one.adjustment = T, trans="none")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, shrunken KM method, no trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="sh_adj_hybrid",zero.one.adjustment = T, trans="none")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, standard method, log trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="standard",zero.one.adjustment = T, trans="log")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, regular hybrid method, log trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="reg_hybrid",zero.one.adjustment = T, trans="log")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, adjusted hybrid method, log trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="adj_hybrid",zero.one.adjustment = T, trans="log")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, shrunken KM method, log trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="sh_adj_hybrid",zero.one.adjustment = T, trans="log")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, standard method, log trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="standard",zero.one.adjustment = T, trans="log")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, regular hybrid method, log trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="reg_hybrid",zero.one.adjustment = T, trans="log")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, adjusted hybrid method, log trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="adj_hybrid",zero.one.adjustment = T, trans="log")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, shrunken KM method, log trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="sh_adj_hybrid",zero.one.adjustment = T, trans="log")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, standard method, cloglog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="standard",zero.one.adjustment = T, trans="cloglog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, regular hybrid method, cloglog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="reg_hybrid",zero.one.adjustment = T, trans="cloglog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, adjusted hybrid method, cloglog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="adj_hybrid",zero.one.adjustment = T, trans="cloglog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, shrunken KM method, cloglog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="sh_adj_hybrid",zero.one.adjustment = T, trans="cloglog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, standard method, cloglog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="standard",zero.one.adjustment = T, trans="cloglog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, regular hybrid method, cloglog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="reg_hybrid",zero.one.adjustment = T, trans="cloglog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, adjusted hybrid method, cloglog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="adj_hybrid",zero.one.adjustment = T, trans="cloglog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, shrunken KM method, cloglog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="sh_adj_hybrid",zero.one.adjustment = T, trans="cloglog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, standard method, logodds trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="standard",zero.one.adjustment = T, trans="logodds")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, regular hybrid method, logodds trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="reg_hybrid",zero.one.adjustment = T, trans="logodds")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, adjusted hybrid method, logodds trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="adj_hybrid",zero.one.adjustment = T, trans="logodds")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, shrunken KM method, logodds trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="sh_adj_hybrid",zero.one.adjustment = T, trans="logodds")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, standard method, logodds trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="standard",zero.one.adjustment = T, trans="logodds")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, regular hybrid method, logodds trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="reg_hybrid",zero.one.adjustment = T, trans="logodds")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, adjusted hybrid method, logodds trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="adj_hybrid",zero.one.adjustment = T, trans="logodds")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, shrunken KM method, logodds trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="sh_adj_hybrid",zero.one.adjustment = T, trans="logodds")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, standard method, clog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="standard",zero.one.adjustment = T, trans="clog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, regular hybrid method, clog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="reg_hybrid",zero.one.adjustment = T, trans="clog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, adjusted hybrid method, clog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="adj_hybrid",zero.one.adjustment = T, trans="clog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, shrunken KM method, clog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="sh_adj_hybrid",zero.one.adjustment = T, trans="clog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, standard method, clog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="standard",zero.one.adjustment = T, trans="clog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, regular hybrid method, clog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="reg_hybrid",zero.one.adjustment = T, trans="clog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, adjusted hybrid method, clog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="adj_hybrid",zero.one.adjustment = T, trans="clog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, shrunken KM method, clog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="sh_adj_hybrid",zero.one.adjustment = T, trans="clog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, standard method, loglog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="standard",zero.one.adjustment = T, trans="loglog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, regular hybrid method, loglog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="reg_hybrid",zero.one.adjustment = T, trans="loglog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, adjusted hybrid method, loglog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="adj_hybrid",zero.one.adjustment = T, trans="loglog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, shrunken KM method, loglog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="sh_adj_hybrid",zero.one.adjustment = T, trans="loglog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, standard method, loglog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="standard",zero.one.adjustment = T, trans="loglog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, regular hybrid method, loglog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="reg_hybrid",zero.one.adjustment = T, trans="loglog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, adjusted hybrid method, loglog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="adj_hybrid",zero.one.adjustment = T, trans="loglog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, shrunken KM method, loglog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="sh_adj_hybrid",zero.one.adjustment = T, trans="loglog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
## The following tests may be used as further options are added to the package ##
# test_that("bpcpfit formula - subset parameter works", {
#
# res <- bpcpfit(Surv(time=time,event=status) ~ 1, data=leuk2, subset=treatment=="6-MP")
# data_treat <- leuk2[which(leuk2$treatment=="6-MP"),]
# expect_equal(res[[1]]$num, nrow(data_treat))
#
# })
# test_that("bpcpfit formula - na.action = na.fail works", {
#
# # Fit the model with na (default and explict na.fail) and expect an error
# expect_error(bpcpfit(Surv(time=time,event=status) ~ 1, data=leuk_na))
# expect_error(bpcpfit(Surv(time=time,event=status) ~ 1, data=leuk_na, na.action = "na.fail"))
# })
# test_that("bpcpfit - no error if group is a character vector (default)", {
# expect_error(bpcpfit(time=leuk2$time,group=leuk2$treatment_char), regexp=NA)
# })
Try the bpcp package in your browser
Any scripts or data that you put into this service are public.
bpcp documentation built on July 21, 2026, 5:08 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
###### FUNCTION: bpcpfit ######
test_that("bpcpfit - formula and regular data have same output", {
expect_equal(bpcpfit(Surv(time, status)~1, data=df_covars),
bpcpfit(time = df_covars$time, status = df_covars$status))
})
test_that("bpcpfit - error if Surv object is not provided in formula",{
expect_error(bpcpfit(status~1, data=leuk),
regexp="Response must be a survival (Surv) object",fixed=TRUE)
})
test_that("bpcpfit formula - na.action = na.omit works", {
# Fit the model with na.omit
res_na <- bpcpfit(Surv(time=time,event=status) ~ 1, data=leuk_na, na.action="na.omit")
res <- bpcpfit(Surv(time=time,event=status) ~ 1, data=leuk)
# Check that the rows with missing values are omitted
expect_equal(res_na[[1]]$num, nrow(na.omit(leuk_na)))
# check that results are different from when there are no na values
expect_false(identical(res_na,res))
})
test_that("bpcpfit formula - na.action = na.exclude works", {
# Fit the model with na.exclude
res_na <- bpcpfit(Surv(time=time,event=status) ~ 1, data=leuk_na, na.action="na.exclude")
res <- bpcpfit(Surv(time=time,event=status) ~ 1, data=leuk)
# Check that the rows with missing values are omitted
expect_equal(res_na[[1]]$num, nrow(na.exclude(leuk_na)))
# check that results are different from when there are no na values
expect_false(identical(res_na,res))
})
test_that("bpcpfit - errors if time is not given (default)", {
expect_error(bpcpfit(status=leuk$status))
})
test_that("bpcpfit - errors if time is not given (formula)", {
expect_error(bpcpfit(Surv(event=status) ~ 1, data=leuk))
})
# FIX - add to spreadsheet
test_that("bpcpfit - no error if status is not given (default)", {
expect_error(bpcpfit(time=leuk$time), regexp=NA)
})
test_that("bpcpfit - no error if status is not given (formula)", {
expect_error(bpcpfit(Surv(time=time) ~ 1, data=leuk), regexp=NA)
})
test_that("bpcpfit - no error if status is not given with group (default)", {
expect_error(bpcpfit(time=leuk2$time,group=leuk2$treatment), regexp=NA)
})
test_that("bpcpfit - no error if status is not given with group (formula)", {
expect_error(bpcpfit(Surv(time=time) ~ treatment, data=leuk2), regexp=NA)
})
test_that("bpcpfit - no error if group is a character vector (formula)", {
expect_error(bpcpfit(Surv(time=time) ~ treatment_char, data=leuk2), regexp=NA)
})
test_that("bpcpfit - error when status is not 0 and 1 (default)", {
expect_error(bpcpfit(time=c(1,5,10,15,20),status=c(1,2,1,2,1)),
regexp="status must be a vector with values 0 or 1")
})
test_that("bpcpfit - error when status is not 0 and 1 (formula)", {
expect_error(bpcpfit(Surv(c(1,5,10,15,20),c(1,2,1,2,1)) ~ 1),
regexp="status must be a vector with values 0 or 1")
})
test_that("bpcpfit - warning is given when alpha is specified (default)", {
expect_warning(bpcpfit(time=leuk$time,status=leuk$status, alpha=0.03))
})
test_that("bpcpfit - warning is given when alpha is specified (formula)", {
expect_warning(bpcpfit(Surv(time=time,event=status) ~ 1, data=leuk, alpha=0.03))
})
test_that("bpcpfit - error when plotstyle is not ggplot or standard and NULL group", {
expect_error(bpcpfit(time=leuk$time,status=leuk$status, plotstyle = "test"),
regexp='Plot style must be either "ggplot" or "standard"')
})
test_that("bpcpfit - error when plotstyle is not ggplot or standard and group is specified", {
expect_error(bpcpfit(time=leuk2$time,status=leuk2$status, group=leuk2$treatment, plotstyle = "test"),
regexp='Plot style must be either "ggplot" or "standard"')
})
test_that(" ", {
expect_error(bpcpfit(time = c(1,5,10,15,20), status = c(0,1,2,1,0)),
regexp="status must be a vector with values 0 or 1")
})
test_that("bpcpfit - error when more than 2 statuses (default) and group is specified", {
expect_error(bpcpfit(time = c(1,5,10,15,20), status = c(0,1,2,1,0), group=c("T","T","T","P","P")),
regexp="status must be a vector with values 0 or 1")
})
test_that("bpcpfit - error when more than 2 statuses (formula)", {
expect_error(bpcpfit(Surv(time=c(1,5,10,15,20),event=c(0,1,2,1,0)) ~1 ),
regexp="status must be a vector with values 0 or 1")
})
test_that("bpcpfit - error when more than 2 statuses (formula) and group is specified", {
expect_error(bpcpfit(Surv(c(1,5,10,15,20),c(0,1,2,1,0)) ~ c("T","T","T","P","P")),
regexp="status must be a vector with values 0 or 1")
})
test_that("bpcpfit - error when more than 1 covariate", {
expect_error(bpcpfit(Surv(time, status)~group+sex, data=df_covars),
regexp = "Only a treatment/grouping variable can be specified in this function. No other covariates should be included.")
})
test_that("bpcpfit - error when interaction", {
expect_error(bpcpfit(Surv(time, status)~group*sex, data=df_covars),
regexp="Interaction terms are not valid for this function")
})
test_that("StCI - upper confidence interval is greater than lower",{
res <- bpcpfit(time=leuk2$time,status=leuk2$status)
ci_res <- StCI(res, tstar=unique(leuk2$time))
expect_true(all(ci_res$upper >= ci_res$lower))
})
test_that("Error in bpcp when Delta is less than 0", {
expect_error(bpcpfit(time=leuk2$time,status = leuk2$status, Delta=-1),
regexp="Delta must be greater than 0")
})
## In 1.3.0 there was an error when the first observation
## was censored. It was a problem in the abmm function.
## fixed March 25, 2016
test_that("No error with abmm when first observation is censored", {
expect_error(bpcp(time=c(1:3),status=c(0,1,1)), regexp = NA)
})
test_that("bpcpfit - Warning when neither km nor mue are specified as stype",{
expect_warning(bpcpfit(time=leuk2$time,status = leuk2$status, stype="test"),
regexp="assuming stype='mue' ")
})
#Pointwise confidence intervals for a single sample should equal binom.test using the number failures and successes by time t
test_that("One sample CI equals binomial test when no observations are censored - time 1", {
expect_equal(c(summary(bpcpfit(time = c(1,5,10,15,20), status = c(1,1,1,1,1)))[1,3],
summary(bpcpfit(time = c(1,5,10,15,20), status = c(1,1,1,1,1)))[1,4]),
c(binom.test(5,5)$conf.int[1], binom.test(5,5)$conf.int[2]))
})
test_that("One sample CI equals binomial test when no observations are censored - time 2", {
expect_equal(c(summary(bpcpfit(time = c(1,5,10,15,20), status = c(1,1,1,1,1)))[2,3],
summary(bpcpfit(time = c(1,5,10,15,20), status = c(1,1,1,1,1)))[2,4]),
c(binom.test(4,5)$conf.int[1], binom.test(4,5)$conf.int[2]))
})
test_that("One sample CI equals binomial test when no observations are censored - time 3", {
expect_equal(c(summary(bpcpfit(time = c(1,5,10,15,20), status = c(1,1,1,1,1)))[3,3],
summary(bpcpfit(time = c(1,5,10,15,20), status = c(1,1,1,1,1)))[3,4]),
c(binom.test(3,5)$conf.int[1], binom.test(3,5)$conf.int[2]))
})
test_that("One sample CI equals binomial test when no observations are censored - time 4", {
expect_equal(c(summary(bpcpfit(time = c(1,5,10,15,20), status = c(1,1,1,1,1)))[4,3],
summary(bpcpfit(time = c(1,5,10,15,20), status = c(1,1,1,1,1)))[4,4]),
c(binom.test(2,5)$conf.int[1], binom.test(2,5)$conf.int[2]))
})
test_that("One sample CI equals binomial test when no observations are censored - time 5", {
expect_equal(c(summary(bpcpfit(time = c(1,5,10,15,20), status = c(1,1,1,1,1)))[5,3],
summary(bpcpfit(time = c(1,5,10,15,20), status = c(1,1,1,1,1)))[5,4]),
c(binom.test(1,5)$conf.int[1], binom.test(1,5)$conf.int[2]))
})
test_that("One sample CI equals binomial test when no observations are censored - time 6", {
expect_equal(c(summary(bpcpfit(time = c(1,5,10,15,20), status = c(1,1,1,1,1)))[6,3],
summary(bpcpfit(time = c(1,5,10,15,20), status = c(1,1,1,1,1)))[6,4]),
c(binom.test(0,5)$conf.int[1], binom.test(0,5)$conf.int[2]))
})
# Should match 2016 paper
test_that("One sample CI with censoring matches 2016 table 1 - time 1", {
expect_equal(round(c(summary(bpcpfit(time = sclerosis$year, status = sclerosis$status))[1,3],
summary(bpcpfit(time = sclerosis$year, status = sclerosis$status))[1,4]),3),
c(0.897,1))
})
test_that("One sample CI with censoring matches 2016 table 1 - time 8", {
expect_equal(round(c(summary(bpcpfit(time = sclerosis$year, status = sclerosis$status))[8,3],
summary(bpcpfit(time = sclerosis$year, status = sclerosis$status))[8,4]),3),
c(0.621, 0.913))
})
test_that("One sample CI with censoring matches 2016 table 1 - time 17 (last)", {
expect_equal(round(c(summary(bpcpfit(time = sclerosis$year, status = sclerosis$status))[17,3],
summary(bpcpfit(time = sclerosis$year, status = sclerosis$status))[17,4]),3),
c(0.533, 0.869))
})
test_that("One sample CI includes KM estimate when last observation (out of 5) is censored - time 1",{
res <- last_censored(time=1,param="ci")
expect_true(contains_est(res[1],res[2],last_censored(time=1,param="est")))
})
test_that("One sample CI includes KM estimate when last observation (out of 5) is censored - time 2",{
res <- last_censored(time=2,param="ci")
expect_true(contains_est(res[1],res[2],last_censored(time=2,param="est")))
})
test_that("One sample CI includes KM estimate when last observation (out of 5) is censored - time 3",{
res <- last_censored(time=3,param="ci")
expect_true(contains_est(res[1],res[2],last_censored(time=3,param="est")))
})
test_that("One sample CI includes KM estimate when last observation (out of 5) is censored - time 4",{
res <- last_censored(time=4,param="ci")
expect_true(contains_est(res[1],res[2],last_censored(time=4,param="est")))
})
test_that("One sample CI includes KM estimate when last observation (out of 5) is censored - time 5",{
res <- last_censored(time=5,param="ci")
expect_true(contains_est(res[1],res[2],last_censored(time=5,param="est")))
})
test_that("One sample CI includes KM estimate when last observation (out of 5) is censored - time 6",{
res <- last_censored(time=6,param="ci")
expect_true(contains_est(res[1],res[2],last_censored(time=6,param="est")))
})
# With no censoring, CI's should match binomial exact mid-p
test_that("Mid-p one sample CI with no censoring matches binomial exact mid-p - time 0", {
expect_equal(no_censoring(time=0,type="bpcp",arms=1,param="ci", midp=T)[1:2],
exactci::binom.exact(6,6, midp=T)$conf.int[1:2], tolerance=0.01)
})
test_that("Mid-p one sample CI with no censoring matches binomial exact mid-p - time 1", {
expect_equal(no_censoring(time=1,type="bpcp",arms=1,param="ci", midp=T)[1:2],
exactci::binom.exact(4,6, midp=T)$conf.int[1:2], tolerance=0.01)
})
test_that("Mid-p one sample CI with no censoring matches binomial exact mid-p - time 2", {
expect_equal(no_censoring(time=2,type="bpcp",arms=1,param="ci", midp=T)[1:2],
exactci::binom.exact(3,6, midp=T)$conf.int[1:2], tolerance=0.01)
})
test_that("Mid-p one sample CI with no censoring matches binomial exact mid-p - time 3", {
expect_equal(no_censoring(time=3,type="bpcp",arms=1,param="ci", midp=T)[1:2],
exactci::binom.exact(2,6, midp=T)$conf.int[1:2], tolerance=0.01)
})
test_that("Mid-p one sample CI with no censoring matches binomial exact mid-p - time 4", {
expect_equal(no_censoring(time=4,type="bpcp",arms=1,param="ci", midp=T)[1:2],
exactci::binom.exact(1,6, midp=T)$conf.int[1:2], tolerance=0.01)
})
test_that("Mid-p one sample CI with no censoring matches binomial exact mid-p - time 5", {
expect_equal(no_censoring(time=5,type="bpcp",arms=1,param="ci", midp=T)[1:2],
exactci::binom.exact(0,6, midp=T)$conf.int[1:2], tolerance=0.01)
})
# With censoring should match 2016 paper
test_that("Mid-p one sample CI with censoring matches 2016 table 1 - time 1", {
expect_equal(round(c(summary(bpcpfit(time = sclerosis$year, status = sclerosis$status, midp=T))[1,3],
summary(bpcpfit(time = sclerosis$year, status = sclerosis$status, midp=T))[1,4]),3),
c(0.916, 1.000))
})
test_that("Mid-p one sample CI with censoring matches 2016 table 1 - time 8", {
expect_equal(round(c(summary(bpcpfit(time = sclerosis$year, status = sclerosis$status,midp=T))[8,3],
summary(bpcpfit(time = sclerosis$year, status = sclerosis$status, midp=T))[8,4]),3),
c(0.635, 0.905))
})
test_that("Mid-p one sample CI with censoring matches 2016 table 1 - time 17 (last)", {
expect_equal(round(c(summary(bpcpfit(time = sclerosis$year, status = sclerosis$status, midp=T))[17,3],
summary(bpcpfit(time = sclerosis$year, status = sclerosis$status, midp=T))[17,4]),3),
c(0.551, 0.859))
})
test_that("One sample CI with no events - final timepoint is [0,1]",{
bpcp_noevents <- no_events(time=2,type="bpcp",param="ci")
expect_equal(
c(0,1),
c(bpcp_noevents[1],bpcp_noevents[2])
)
})
test_that("bpcpfit output of base R vs ggplot works with plotstyle parameter", {
res_ggplot <- bpcpfit(time=leuk$time,status=leuk$status)
res_base <- bpcpfit(time=leuk$time,status=leuk$status, plotstyle ="standard")
p_ggp <- plot(res_ggplot)
p_base <- plot(res_base)
expect_true(inherits(p_ggp, "ggplot"))
expect_false(inherits(p_base, "ggplot"))
})
test_that("90% CI with no censoring matches binomial exact - time 0", {
expect_equal(no_censoring(time=0,type="bpcp",arms=1,param="ci", conf.level=0.9)[1:2],
exactci::binom.exact(6,6, conf.level=0.9)$conf.int[1:2], tolerance=0.01)
})
test_that("90% CI with no censoring matches binomial exact - time 1", {
expect_equal(no_censoring(time=1,type="bpcp",arms=1,param="ci", conf.level=0.9)[1:2],
exactci::binom.exact(4,6, conf.level=0.9)$conf.int[1:2], tolerance=0.01)
})
test_that("90% CI with no censoring matches binomial exact - time 2", {
expect_equal(no_censoring(time=2,type="bpcp",arms=1,param="ci", conf.level=0.9)[1:2],
exactci::binom.exact(3,6, conf.level=0.9)$conf.int[1:2], tolerance=0.01)
})
test_that("90% CI with no censoring matches binomial exact - time 3", {
expect_equal(no_censoring(time=3,type="bpcp",arms=1,param="ci", conf.level=0.9)[1:2],
exactci::binom.exact(2,6, conf.level=0.9)$conf.int[1:2], tolerance=0.01)
})
test_that("90% CI with no censoring matches binomial exact - time 4", {
expect_equal(no_censoring(time=4,type="bpcp",arms=1,param="ci", conf.level=0.9)[1:2],
exactci::binom.exact(1,6, conf.level=0.9)$conf.int[1:2], tolerance=0.01)
})
test_that("90% CI with no censoring matches binomial exact - time 5", {
expect_equal(no_censoring(time=5,type="bpcp",arms=1,param="ci", conf.level=0.9)[1:2],
exactci::binom.exact(0,6, conf.level=0.9)$conf.int[1:2], tolerance=0.01)
})
test_that("Delta standard method (no trans) for one-sample matches Borkowf's table 7, column A, lower CI", {
standard_res <- kmciDelta(time=d$time,status=d$status, trans="none", method="standard")
# check lower
expect_equal(standard_res$lower,borkowf_tb7$a_Lower,tolerance=0.01)
})
test_that("Delta standard method (no trans) for one-sample matches Borkowf's table 7, column A, upper CI", {
standard_res <- kmciDelta(time=d$time,status=d$status, trans="none", method="standard")
# check lower
expect_equal(standard_res$upper,borkowf_tb7$a_Upper,tolerance=0.01)
})
test_that("Delta regular hybrid method (no trans) for one-sample matches Borkowf's table 7, column C, lower CI", {
reg_hybrid_res <- kmciDelta(time=d$time,status=d$status, trans="none", method="reg_hybrid")
# check lower
expect_equal(reg_hybrid_res$lower,borkowf_tb7$c_Lower,tolerance=0.01)
})
test_that("Delta regular hybrid method (no trans) for one-sample matches Borkowf's table 7, column C, upper CI", {
reg_hybrid_res <- kmciDelta(time=d$time,status=d$status, trans="none", method="reg_hybrid")
# check lower
expect_equal(reg_hybrid_res$upper,borkowf_tb7$c_Upper,tolerance=0.01)
})
test_that("Delta adjusted hybrid method (no trans) for one-sample matches Borkowf's table 7, column D, lower CI", {
adj_hybrid_res <- kmciDelta(time=d$time,status=d$status, trans="none", method="adj_hybrid")
# check lower
expect_equal(adj_hybrid_res$lower,borkowf_tb7$d_Lower,tolerance=0.01)
})
test_that("Delta adjusted hybrid method (no trans) for one-sample matches Borkowf's table 7, column D, upper CI", {
adj_hybrid_res <- kmciDelta(time=d$time,status=d$status, trans="none", method="adj_hybrid")
# check lower
expect_equal(adj_hybrid_res$upper,borkowf_tb7$d_Upper,tolerance=0.01)
})
test_that("Delta shrunken adjusted hybrid method (no trans) for one-sample matches Borkowf's table 7, column E, lower CI", {
sh_adj_hybrid_res <- kmciDelta(time=d$time,status=d$status, trans="none", method="sh_adj_hybrid")
# check lower
expect_equal(sh_adj_hybrid_res$lower,borkowf_tb7$e_Lower,tolerance=0.01)
})
test_that("Delta shrunken adjusted hybrid method (no trans) for one-sample matches Borkowf's table 7, column E, upper CI", {
sh_adj_hybrid_res <- kmciDelta(time=d$time,status=d$status, trans="none", method="sh_adj_hybrid")
# check lower
expect_equal(sh_adj_hybrid_res$upper,borkowf_tb7$e_Upper,tolerance=0.01)
})
test_that("log transformation can be inverted, and vice versa", {
h<- function(S){ log(S) }
hinv<-function(y){exp(y)}
S <- seq(0,1, by = 0.1)
expect_true(all(round(hinv(h(S)),1)==round(S,1)))
# transformation bounds are -Inf to 0
y = c(-Inf,0)
expect_true(all(round(h(hinv(y)),1)==round(y,1)))
})
test_that("cloglog transformation can be inverted, and vice versa", {
h<- function(S){ log(-log(1-S)) }
hinv<-function(y){1-exp(-exp(y))}
S <- seq(0,1, by = 0.1)
expect_true(all(round(hinv(h(S)),1)==round(S,1)))
# transformation bounds are -Inf to Inf
y = c(-Inf,Inf)
expect_true(all(round(h(hinv(y)),1)==round(y,1)))
})
test_that("log odds transformation can be inverted, and vice versa", {
h<- function(S){ log(S/(1-S)) }
hinv<-function(y){ ifelse(y==Inf,1,exp(y)/(1+exp(y))) }
S <- seq(0,1, by = 0.1)
expect_true(all(round(hinv(h(S)),1)==round(S,1)))
# transformation bounds are -Inf to Inf
y = c(-Inf,Inf)
expect_true(all(round(h(hinv(y)),1)==round(y,1)))
})
test_that("clog transformation can be inverted, and vice versa", {
h<- function(S){ log(1-S) }
hinv<-function(y){1-exp(y)}
S <- seq(0,1, by = 0.1)
expect_true(all(round(hinv(h(S)),1)==round(S,1)))
# transformation bounds are -Inf to 0
y = c(-Inf,0)
expect_true(all(round(h(hinv(y)),1)==round(y,1)))
})
test_that("loglog transformation can be inverted, and vice versa", {
h<- function(S){ log(-log(S)) }
hinv<-function(y){exp(-exp(y))}
S <- seq(0,1, by = 0.1)
expect_true(all(round(hinv(h(S)),1)==round(S,1)))
# transformation bounds are -Inf to Inf
y = c(-Inf,Inf)
expect_true(all(round(h(hinv(y)),1)==round(y,1)))
})
test_that("kmciDelta no transformation produces CI in the right direction", {
res <- kmciDelta(time=leuk2$time,status=leuk2$status, trans="none", method="standard")
expect_true(all(res$lower <= res$upper))
})
test_that("kmciDelta log transformation produces CI in the right direction", {
res <- kmciDelta(time=leuk2$time,status=leuk2$status, trans="log", method="standard")
expect_true(all(res$lower <= res$upper))
})
test_that("kmciDelta cloglog transformation produces CI in the right direction", {
res <- kmciDelta(time=leuk2$time,status=leuk2$status, trans="cloglog", method="standard")
expect_true(all(res$lower <= res$upper))
})
test_that("kmciDelta clog transformation produces CI in the right direction", {
res <- kmciDelta(time=leuk2$time,status=leuk2$status, trans="clog", method="standard")
expect_true(all(res$lower <= res$upper))
})
test_that("kmciDelta logodds transformation produces CI in the right direction", {
res <- kmciDelta(time=leuk2$time,status=leuk2$status, trans="logodds", method="standard")
expect_true(all(res$lower <= res$upper))
})
test_that("kmciDelta loglog transformation produces CI in the right direction", {
res <- kmciDelta(time=leuk2$time,status=leuk2$status, trans="loglog", method="standard")
expect_true(all(res$lower <= res$upper))
})
test_that("method=st will call method=standard in kmciDelta", {
shortened <- kmciDelta(time=leuk2$time,status=leuk2$status, method="st")
full <- kmciDelta(time=leuk2$time,status=leuk2$status, method="standard")
expect_true(all(shortened$lower == full$lower))
expect_true(all(shortened$upper == full$upper))
})
test_that("method=r will call method=reg_hybrid in kmciDelta", {
shortened <- kmciDelta(time=leuk2$time,status=leuk2$status, method="r")
full <- kmciDelta(time=leuk2$time,status=leuk2$status, method="reg_hybrid")
expect_true(all(shortened$lower == full$lower))
expect_true(all(shortened$upper == full$upper))
})
test_that("method=a will call method=adj_hybrid in kmciDelta", {
shortened <- kmciDelta(time=leuk2$time,status=leuk2$status, method="a")
full <- kmciDelta(time=leuk2$time,status=leuk2$status, method="adj_hybrid")
expect_true(all(shortened$lower == full$lower))
expect_true(all(shortened$upper == full$upper))
})
test_that("method=sh will call method=sh_adj_hybrid in kmciDelta", {
shortened <- kmciDelta(time=leuk2$time,status=leuk2$status, method="sh")
full <- kmciDelta(time=leuk2$time,status=leuk2$status, method="sh_adj_hybrid")
expect_true(all(shortened$lower == full$lower))
expect_true(all(shortened$upper == full$upper))
})
test_that("zero one adjustment works with 100% survival cases, standard method, no trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="standard",zero.one.adjustment = T, trans="none")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, regular hybrid method, no trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="reg_hybrid",zero.one.adjustment = T, trans="none")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, adjusted hybrid method", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="adj_hybrid",zero.one.adjustment = T, trans="none")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, shrunken KM method, no trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="sh_adj_hybrid",zero.one.adjustment = T, trans="none")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, standard method, no trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="standard",zero.one.adjustment = T, trans="none")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, regular hybrid method, no trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="reg_hybrid",zero.one.adjustment = T, trans="none")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, adjusted hybrid method", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="adj_hybrid",zero.one.adjustment = T, trans="none")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, shrunken KM method, no trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="sh_adj_hybrid",zero.one.adjustment = T, trans="none")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, standard method, log trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="standard",zero.one.adjustment = T, trans="log")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, regular hybrid method, log trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="reg_hybrid",zero.one.adjustment = T, trans="log")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, adjusted hybrid method, log trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="adj_hybrid",zero.one.adjustment = T, trans="log")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, shrunken KM method, log trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="sh_adj_hybrid",zero.one.adjustment = T, trans="log")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, standard method, log trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="standard",zero.one.adjustment = T, trans="log")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, regular hybrid method, log trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="reg_hybrid",zero.one.adjustment = T, trans="log")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, adjusted hybrid method, log trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="adj_hybrid",zero.one.adjustment = T, trans="log")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, shrunken KM method, log trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="sh_adj_hybrid",zero.one.adjustment = T, trans="log")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, standard method, cloglog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="standard",zero.one.adjustment = T, trans="cloglog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, regular hybrid method, cloglog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="reg_hybrid",zero.one.adjustment = T, trans="cloglog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, adjusted hybrid method, cloglog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="adj_hybrid",zero.one.adjustment = T, trans="cloglog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, shrunken KM method, cloglog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="sh_adj_hybrid",zero.one.adjustment = T, trans="cloglog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, standard method, cloglog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="standard",zero.one.adjustment = T, trans="cloglog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, regular hybrid method, cloglog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="reg_hybrid",zero.one.adjustment = T, trans="cloglog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, adjusted hybrid method, cloglog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="adj_hybrid",zero.one.adjustment = T, trans="cloglog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, shrunken KM method, cloglog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="sh_adj_hybrid",zero.one.adjustment = T, trans="cloglog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, standard method, logodds trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="standard",zero.one.adjustment = T, trans="logodds")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, regular hybrid method, logodds trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="reg_hybrid",zero.one.adjustment = T, trans="logodds")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, adjusted hybrid method, logodds trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="adj_hybrid",zero.one.adjustment = T, trans="logodds")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, shrunken KM method, logodds trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="sh_adj_hybrid",zero.one.adjustment = T, trans="logodds")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, standard method, logodds trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="standard",zero.one.adjustment = T, trans="logodds")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, regular hybrid method, logodds trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="reg_hybrid",zero.one.adjustment = T, trans="logodds")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, adjusted hybrid method, logodds trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="adj_hybrid",zero.one.adjustment = T, trans="logodds")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, shrunken KM method, logodds trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="sh_adj_hybrid",zero.one.adjustment = T, trans="logodds")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, standard method, clog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="standard",zero.one.adjustment = T, trans="clog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, regular hybrid method, clog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="reg_hybrid",zero.one.adjustment = T, trans="clog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, adjusted hybrid method, clog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="adj_hybrid",zero.one.adjustment = T, trans="clog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, shrunken KM method, clog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="sh_adj_hybrid",zero.one.adjustment = T, trans="clog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, standard method, clog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="standard",zero.one.adjustment = T, trans="clog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, regular hybrid method, clog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="reg_hybrid",zero.one.adjustment = T, trans="clog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, adjusted hybrid method, clog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="adj_hybrid",zero.one.adjustment = T, trans="clog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, shrunken KM method, clog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="sh_adj_hybrid",zero.one.adjustment = T, trans="clog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, standard method, loglog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="standard",zero.one.adjustment = T, trans="loglog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, regular hybrid method, loglog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="reg_hybrid",zero.one.adjustment = T, trans="loglog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, adjusted hybrid method, loglog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="adj_hybrid",zero.one.adjustment = T, trans="loglog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 100% survival cases, shrunken KM method, loglog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = d_failure_obs$status, method="sh_adj_hybrid",zero.one.adjustment = T, trans="loglog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, standard method, loglog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="standard",zero.one.adjustment = T, trans="loglog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, regular hybrid method, loglog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="reg_hybrid",zero.one.adjustment = T, trans="loglog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, adjusted hybrid method, loglog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="adj_hybrid",zero.one.adjustment = T, trans="loglog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
test_that("zero one adjustment works with 0% survival cases, shrunken KM method, loglog trans", {
d_failure_obs <- d_failure[which(d_failure$rx=="Obs"),]
zero.one.res <- kmciDelta(time=d_failure_obs$time, status = 1-d_failure_obs$status, method="sh_adj_hybrid",zero.one.adjustment = T, trans="loglog")
# expect Upper - Lower CI > 0
expect_true(all(zero.one.res$upper - zero.one.res$lower > 0))
# expect lower CI >= 0 and upper CI <= 1
expect_true(all(zero.one.res$upper <= 1 & zero.one.res$lower >= 0))
})
## The following tests may be used as further options are added to the package ##
# test_that("bpcpfit formula - subset parameter works", {
#
# res <- bpcpfit(Surv(time=time,event=status) ~ 1, data=leuk2, subset=treatment=="6-MP")
# data_treat <- leuk2[which(leuk2$treatment=="6-MP"),]
# expect_equal(res[[1]]$num, nrow(data_treat))
#
# })
# test_that("bpcpfit formula - na.action = na.fail works", {
#
# # Fit the model with na (default and explict na.fail) and expect an error
# expect_error(bpcpfit(Surv(time=time,event=status) ~ 1, data=leuk_na))
# expect_error(bpcpfit(Surv(time=time,event=status) ~ 1, data=leuk_na, na.action = "na.fail"))
# })
# test_that("bpcpfit - no error if group is a character vector (default)", {
# expect_error(bpcpfit(time=leuk2$time,group=leuk2$treatment_char), regexp=NA)
# })
Try the bpcp package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.