Nothing
#library(rpsftm)
context("Test for desired errors in rpsftm")
immdef$propX <- with(immdef, 1-xoyrs/progyrs)
test_that("Errors in test argument",{
expect_error( rpsftm(Surv(progyrs, prog)~rand(imm, propX),test=mantelhaen.test,immdef, censor_time = censyrs,
low_psi=-1, hi_psi=1), "Test must be one of: survdiff, coxph, survreg")
})
test_that("No Surv object as a response",
{
expect_error(
rpsftm(progyrs~rand(imm, propX),immdef, censor_time = censyrs),
"Response must be a survival object")
})
test_that("Wrong type of Survival object",
{
expect_error(
rpsftm(Surv(progyrs, prog, type="left")~rand(imm, propX),immdef, censor_time = censyrs),
"rpsftm doesn't support \"left\" survival data")
})
#Check up the error functions i.e. wrong order of censoring/ events
#rx outside of [0,1]
test_that("Errors in arm >1",{
expect_error( rpsftm(Surv(progyrs, prog)~rand(imm, propX+1),immdef, censor_time = censyrs,
low_psi=-1, hi_psi=1), "Invalid values for rx")
})
test_that("Errors in arm <1",{
expect_error( rpsftm(Surv(progyrs, prog)~rand(imm, propX-1),immdef, censor_time = censyrs,
low_psi=-1, hi_psi=1), "Invalid values for rx")
})
test_that("Errors in randomisation out of {0,1}",{
expect_error( rpsftm(Surv(progyrs, prog)~rand(imm+0.5, propX-1),immdef, censor_time = censyrs,
low_psi=-1, hi_psi=1), "Invalid values for rx")
})
test_that("Censoring before Time warning",{
expect_warning( rpsftm(Surv(progyrs, prog )~rand(imm, propX),immdef, censor_time=censyrs*0.5,
low_psi=-1, hi_psi=1), "You have observed events AFTER censoring")
})
test_that("Variables on left and right terms",
{
expect_error( rpsftm(Surv(progyrs, prog)~rand(imm, 1-xoyrs/progyrs)+progyrs,immdef, censor_time = censyrs,
low_psi=-1, hi_psi=1, test=coxph), "a variable appears on both the left and right sides of the formula")
}
)
# formula <- Surv(progyrs, prog)~rand(imm, 1-xoyrs/progyrs)+progyrs
#
# if(length(formula)>2){
# ytemp <- termsinner(formula[[2]])
# xtemp <- termsinner(formula[[3]])
# if (any(!is.na(match(xtemp, ytemp))))
# stop("a variable appears on both the left and right sides of the formula")
# }
test_that("No rand() terms",
{
expect_error( rpsftm(Surv(progyrs, prog)~imm,immdef, censor_time = censyrs,
low_psi=-1, hi_psi=1), "Exactly one rand\\(\\) term allowed")
}
)
test_that("Too many rand() terms",
{
expect_error( rpsftm(Surv(progyrs, prog)~def*rand(imm, 1-xoyrs/progyrs),immdef, censor_time = censyrs,
low_psi=-1, hi_psi=1), "Exactly one rand\\(\\) term allowed")
}
)
test_that("rand() interaction",
{
expect_error( rpsftm(Surv(progyrs, prog)~def/rand(imm, 1-xoyrs/progyrs),immdef, censor_time = censyrs,
low_psi=-1, hi_psi=1), "rand\\(\\) term must not be in any interactions")
}
)
test_that("using covariates with special clashing names",
{
.arm <- rep(0:1,500)
expect_warning(
rpsftm(Surv(progyrs, prog)~rand(imm, 1-xoyrs/progyrs)+ .arm ,immdef, test=coxph, censor_time = censyrs)
,
"Please rename"
)
}
)
test_that("More than 2 arms",
{
myarm <- factor(rep(1:4,250))
expect_error( rpsftm(Surv(progyrs, prog)~rand(myarm, 1-xoyrs/progyrs),immdef, censor_time = censyrs,
low_psi=-1, hi_psi=1), "arm must have exactly 2 observed values")
}
)
test_that("less than 2 arms",
{
expect_error( rpsftm(Surv(progyrs, prog)~rand(1, 1-xoyrs/progyrs),immdef, censor_time = censyrs,
low_psi=-1, hi_psi=1), "arm must have exactly 2 observed values")
}
)
# missing data handling
#to be implimented
test_that("na actions",
{
index <- sample(dim(immdef)[1],20)
myarm <- immdef$imm
myarm[index] <- NA
fit <- rpsftm(Surv(progyrs, prog)~rand(imm, 1-xoyrs/progyrs),immdef, censor_time = censyrs, na.action=na.fail,
low_psi=-1, hi_psi=1)
expect_is(fit$psi, class="numeric")
fit <- rpsftm(Surv(progyrs, prog)~rand(myarm, 1-xoyrs/progyrs),immdef, censor_time = censyrs, na.action=na.omit,
low_psi=-1, hi_psi=1)
expect_is(fit$psi, class="numeric")
expect_is(fit$na.action, class="omit")
expect_error(rpsftm(Surv(progyrs, prog)~rand(myarm, 1-xoyrs/progyrs),immdef, censor_time = censyrs, na.action=na.fail,
low_psi=-1, hi_psi=1),
"missing values in object")
}
)
test_that("warning for poor initial starting values",{
expect_warning( fit <- rpsftm(Surv(progyrs, prog)~rand(imm,1-xoyrs/progyrs),immdef, censor_time = censyrs,
low_psi=-1, hi_psi=-0.9),
"The starting interval"
)
})
test_that("warning for non-convergencevalues",{
expect_error( fit <- rpsftm(Surv(progyrs, prog)~rand(imm,1-xoyrs/progyrs)+entry,immdef, censor_time = censyrs)
)
# expect_equal(is.na(fit$psi),TRUE)
})
test_that("eval_z incorrect input - too small a number",
{
expect_error( rpsftm(Surv(progyrs, prog)~rand(imm,1-xoyrs/progyrs),
data=immdef, censor_time = censyrs, n_eval_z=1),
"invalid value of n_eval_z"
)
}
)
test_that("eval_z incorrect input - vector input",
{
expect_error( rpsftm(Surv(progyrs, prog)~rand(imm,1-xoyrs/progyrs),
data=immdef, censor_time = censyrs, n_eval_z=2:10),
"invalid value of n_eval_z"
)
}
)
test_that("eval_z incorrect input - non-numeric input",
{
expect_error( rpsftm(Surv(progyrs, prog)~rand(imm,1-xoyrs/progyrs),
data=immdef, censor_time = censyrs, n_eval_z="hello"),
"invalid value of n_eval_z"
)
}
)
test_that("NA handling in rand",{
imm2 <- immdef$imm
imm2[1:100] <- NA
rpsftm(Surv(progyrs, prog)~rand(imm2,1-xoyrs/progyrs),
data=immdef, censor_time = censyrs)
imm3 <- factor(imm2, levels=0:1, labels=c("Cx","Rx"))
rpsftm(Surv(progyrs, prog)~rand(imm3,1-xoyrs/progyrs),
data=immdef, censor_time = censyrs)
expect_error(rpsftm(Surv(progyrs, prog)~rand(1-xoyrs/progyrs,imm),
data=immdef, censor_time = censyrs))
imm_3arms <- factor(rep(1:3, ceiling(1000/3))[1:1000])
expect_error(rpsftm(Surv(progyrs, prog)~rand(imm_3arms,1-xoyrs/progyrs),
data=immdef, censor_time = censyrs))
}
)
test_that("Checking of Treatment modifier",
{
mod <- rep(0, nrow(immdef))
expect_error(rpsftm(Surv(progyrs, prog)~rand(imm,1-xoyrs/progyrs),
data=immdef, treat_modifier=mod, censor_time = censyrs))
mod <- rep(-1, nrow(immdef))
expect_warning(rpsftm(Surv(progyrs, prog)~rand(imm,1-xoyrs/progyrs),
data=immdef,treat_modifier = mod, censor_time = censyrs),
"treat_modifier values are not all strictly positive"
)
mod <- c(0,rep(2,nrow(immdef)-1))
expect_warning(fit <- rpsftm(Surv(progyrs, prog)~rand(imm,1-xoyrs/progyrs),
data=immdef,treat_modifier =mod, censor_time = censyrs),
"treat_modifier values are not all strictly positive"
)
expect_s3_class(fit, class="rpsftm")
}
)
test_that("Multiple Roots",
{
load("multi_root.Rdata")
expect_warning(
fit <- rpsftm(Surv(progyrs, prog)~rand(imm,1-xoyrs/progyrs),multi_root, censyrs),
"Multiple Roots found"
)
}
)
test_that("problems with limits",
{
expect_warning(rpsftm(Surv(progyrs, prog)~rand(imm,1-xoyrs/progyrs),immdef, censyrs,
low_psi = 1, hi_psi=2, test=survreg
), "The starting interval")
expect_warning(rpsftm(Surv(progyrs, prog)~rand(imm,1-xoyrs/progyrs),immdef, censyrs,
low_psi = -1, hi_psi=-0.1
), "Evaluation of a limit")
expect_warning(rpsftm(Surv(progyrs, prog)~rand(imm,1-xoyrs/progyrs),immdef, censyrs,
low_psi = -2, hi_psi=-1), "Evaluation of the estimated values of psi failed")
}
)
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.