tests/testthat/test-ExtendTrial.R

In stephematician/trialcostR: Trial Cost-Effectiveness in R

library(trialcostR)
context('ExtendTrial class')

test_that('Can construct empty ExtendTrial class', {

    expect_is(ExtendTrial(df=data.frame(),
                          df_mu=data.frame(mu=numeric(0)),
                          participant=~1,
                          outcome=~1,
                          hazard=mu~1,
                          followup=numeric(0),
                          censor=logical(0),
                          s=numeric(0),
                          s_max=numeric(0),
                          discount=0),
              'ExtendTrial')

    A <- ExtendTrial(df=data.frame(),
                     df_mu=data.frame(mu=numeric(0)),
                     participant=~1,
                     outcome=~1,
                     hazard=mu~1,
                     followup=numeric(0),
                     censor=logical(0),
                     s=numeric(0),
                     s_max=numeric(0),
                     discount=0)

    expect_identical(dim(participants(A)), rep(as.integer(0), 2))
    expect_identical(dim(outcomes(A)), rep(as.integer(0), 2))
    expect_identical(lifeyear(A), numeric(0))
    expect_identical(dlifeyear(A), numeric(0))

})

test_that('Can construct simple ExtendTrial', {

    expect_is(ExtendTrial(df=data.frame(x=1:3, y=2, z=F),
                          df_mu=data.frame(mu=1, s=0),
                          participant=~1,
                          outcome=~x,
                          hazard=mu~1,
                          followup=y,
                          censor=z,
                          s=s,
                          s_max=rep(2, 3),
                          discount=0),
              'ExtendTrial')

})

test_that('Given no extension beyond follow-up, ly is equal to followup', {

    A <- ExtendTrial(df=data.frame(x=1:3, y=2, z=F),
                     df_mu=data.frame(mu=1, s=0),
                     participant=~1,
                     outcome=~x,
                     hazard=mu~1,
                     followup=y,
                     censor=z,
                     s=s,
                     s_max=rep(2, 3),
                     discount=0)

    expect_identical(lifeyear(A), rep(2, 3))

})

test_that(paste('Given one year extension, and zero hazard,',
                'ly is equal to follow up plus one year'), {

    A <- ExtendTrial(df=data.frame(x=1:3, y=2, z=T),
                     df_mu=data.frame(mu=0 ,s=0),
                     participant=~1,
                     outcome=~x,
                     hazard=mu~1,
                     followup=y,
                     censor=z,
                     s=s,
                     s_max=rep(3, 3),
                     discount=0)

    expect_identical(lifeyear(A), rep(3, 3))

})

test_that(paste('Given one year extension, and unit hazard,',
                'ly is equal to follow up plus exact result'), {

    A <- ExtendTrial(df=data.frame(x=1:3, y=2,z=T),
                     df_mu=data.frame(mu=1,s=0),
                     participant=~1,
                     outcome=~x,
                     hazard=mu~1,
                     followup=y,
                     censor=z,
                     s=s,
                     s_max=rep(3,3),
                     discount=0)

    expect_lt(sum(abs(lifeyear(A) - 
                          ((1 - exp(-1)) + 2))),
              1E-14)

})

test_that(paste('Given one year extension, and infinite hazard,', 
                'ly is equal to follow up'), {

    A <- ExtendTrial(df=data.frame(x=1:3, y=2, z=T),
                     df_mu=data.frame(mu=Inf,s=0),
                     participant=~1,
                     outcome=~x,
                     hazard=mu~1,
                     followup=y,
                     censor=z,
                     s=s,
                     s_max=rep(3,3),
                     discount=0)

    expect_identical(lifeyear(A), rep(2, 3))

})

test_that(paste('Given one year extension and discount rate of zero,',
                'ly is equal to dly'), {

    A <- ExtendTrial(df=data.frame(x=1:3, y=2, z=T),
                     df_mu=data.frame(mu=1,s=0),
                     participant=~1,
                     outcome=~x,
                     hazard=mu~1,
                     followup=y,
                     censor=z,
                     s=s,
                     s_max=rep(3,3),
                     discount=0)

    expect_identical(lifeyear(A), dlifeyear(A))

})

test_that(paste('Given one year extension and discount rate of infinity,',
                'dly is zero'), {

    A <- ExtendTrial(df=data.frame(x=1:3, y=2, z=T),
                     df_mu=data.frame(mu=1,s=0),
                     participant=~1,
                     outcome=~x,
                     hazard=mu~1,
                     followup=y,
                     censor=z,
                     s=s,
                     s_max=rep(3,3),
                     discount=Inf)

    expect_identical(dlifeyear(A), rep(0,3))

})

test_that(paste('Given one year extension, discount rate of one and unit',
                'hazard, dly is equal to analytic (exact) value'), {

    A <- ExtendTrial(df=data.frame(x=1:3, y=2, z=T),
                     df_mu=data.frame(mu=1,s=0),
                     participant=~1,
                     outcome=~x,
                     hazard=mu~1,
                     followup=y,
                     censor=z,
                     s=s,
                     s_max=rep(3,3),
                     discount=1)

    expect_lt(sum(abs(dlifeyear(A) - 
                          (1 - (exp(-2) + exp(-4)) / 2))),
              1E-14)

})

test_that(paste('Given mix of censored and one-year extended, discount rate',
                'of one and unit hazard,',
                'dly is equal to analytic (exact) value'), {

    A <- ExtendTrial(df=data.frame(x=1:3, y=2, z=c(F,T,T)),
                     df_mu=data.frame(mu=1,s=0),
                     participant=~1,
                     outcome=~x,
                     hazard=mu~1,
                     followup=y,
                     censor=z,
                     s=s,
                     s_max=rep(3,3),
                     discount=1)

    expect_lt(sum(abs(dlifeyear(A) - 
                          c(1 - exp(-2),
                            rep(1 - (exp(-2) + exp(-4)) / 2, 2)))),
              1E-14)

})