Nothing
context("DropoutMechanism")
#Note no validation of GetDropTime function
test_that("CreateNewDropoutMechanism_invalid_args",{
expect_error(CreateNewDropoutMechanism(type="MMAR",text="hello",GetDropTime=function(){}))
expect_error(CreateNewDropoutMechanism(type=c("MAR","DE"),text="hello",GetDropTime=function(){}))
expect_error(CreateNewDropoutMechanism(type="MAR",text=c("hello","x"),GetDropTime=function(){}))
expect_error(CreateNewDropoutMechanism(type="MAR",text="hello",GetDropTime=45))
expect_error(CreateNewDropoutMechanism(type="MAR",text="hello",GetDropTime=function(){},cols.needed=NULL))
expect_error(CreateNewDropoutMechanism(type="MAR",text="hello",GetDropTime=function(){},parameters=c("hello")))
})
test_that("DummyDropout",{
d <- CreateNewDropoutMechanism(type="MAR",text="hello",GetDropTime=function(){})
expect_equal("DropoutMechanism",class(d))
expect_equal("MAR",d$type)
expect_equal("hello",d$text)
expect_true(is.function(d$GetDropTime))
d <- CreateNewDropoutMechanism(type="MNAR",text="hello",GetDropTime=function(){},cols.needed=c("a","b"),parameters=list(a=1,b=2))
expect_equal("DropoutMechanism",class(d))
expect_equal("MNAR",d$type)
expect_equal("hello",d$text)
expect_true(is.function(d$GetDropTime))
expect_equal(c("a","b"),d$cols.needed)
expect_equal(list(a=1,b=2),d$parameters)
})
test_that("ConstantRateDrop_validargs",{
expect_error(ConstantRateDrop(rate=Inf))
expect_error(ConstantRateDrop(rate=0))
expect_error(ConstantRateDrop(rate=c(4,5)))
expect_error(ConstantRateDrop(rate=5,var=-5))
crd <- ConstantRateDrop(rate=0.1)
expect_equal("MCAR",crd$type)
expect_equal(list(rate=0.1,between.subject.var=0),crd$parameters)
expect_equal("censored.time",crd$cols.needed)
crd <- ConstantRateDrop(rate=0.1,var=4)
expect_equal(list(rate=0.1,between.subject.var=4),crd$parameters)
})
test_that("LinearRateChangeDrop_validargs",{
expect_error(LinearRateChangeDrop(starting.rate=-4,rate.change=0.5))
expect_error(LinearRateChangeDrop(starting.rate=0,rate.change=0.5))
expect_error(LinearRateChangeDrop(starting.rate=c(4,10),rate.change=1.5))
expect_error(LinearRateChangeDrop(starting.rate=0.5,rate.change="dc"))
expect_error(LinearRateChangeDrop(starting.rate=0.5,rate.change=0.005,var=-5))
lrcd <- LinearRateChangeDrop(starting.rate=0.5,rate.change=-0.005)
expect_equal("MAR",lrcd$type)
expect_equal(list(starting.rate=0.5,rate.change.after.event=-0.005,between.subject.var=0),lrcd$parameters)
expect_equal("censored.time",lrcd$cols.needed)
lrcd <- LinearRateChangeDrop(starting.rate=0.5,rate.change=-0.005,var=4)
expect_equal(list(starting.rate=0.5,rate.change.after.event=-0.005,between.subject.var=4),lrcd$parameters)
})
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.