test_that( "Demographic analysis", { mod1 <- define_strategy( transition = define_transition( .4, .6, .1, .9 ), define_state( cost = 543 + age * 5, ly = 1 ), define_state( cost = 432 + age, ly = 1 * age / 100 ) ) mod2 <- define_strategy( transition = define_transition( .5, .5, .1, .9 ), define_state( cost = 789 * age / 10, ly = 1 ), define_state( cost = 456 * age / 10, ly = 1 * age / 200 ) ) res <- run_model( mod1, mod2, parameters = define_parameters( age_init = 60, age = age_init + model_time ), init = 1:0, cycles = 10, cost = cost, effect = ly, method = "end" ) # generating table with demographic data new_tab <- data.frame( age_init = 40:45 ) set.seed(1) new_tab2 <- data.frame( age_init = 40:45, .weights = runif(6) ) x <- update(res, newdata = new_tab2) summary_update <- summary(x) summary_combine <- summary(x$model) expect_message(update(res, newdata = new_tab)) expect_equal( round(summary_update$summary_results$Min.[1]), 24044 ) expect_equal( round(summary_combine$res_comp$.icer[2]), -12063 ) plot(x, type = "counts") }) test_that( "Heterogeneity analysis", { mod1 <- define_strategy( transition = define_transition( .5, .5, .1, .9 ), define_state( cost = 543 + age * 5, ly = 1 ), define_state( cost = 432 + age, ly = 1 * age / 100 ) ) mod2 <- define_strategy( transition = define_transition( .5, .5, .1, .9 ), define_state( cost = 789 * age / 100, ly = 1 ), define_state( cost = 456 * age / 100, ly = 1 * age / 200 ) ) res <- run_model( mod1, mod2, parameters = define_parameters( age_init = 60, age = age_init + model_time ), init = 1:0, cycles = 10, cost = cost, effect = ly, method = "end" ) # generating table with new parameter sets new_tab <- data.frame( age_init = 40:45 ) # with run_model result ndt <- update(res, newdata = new_tab) plot(ndt, result = "icer", type = "difference") plot(ndt, result = "cost") plot(ndt, result = "effect") expect_error( update(mod1, newdata = new_tab) ) summary_update <- summary(ndt) summary_combine <- summary(ndt$model) expect_output( print(ndt), 'An analysis re-run on 6 parameter sets.', fixed= TRUE ) expect_equal( round(summary_update$summary_results$Min.)[1], 2404 ) } )