tests/testthat/test-simulators.R

In readsdr: Translate Models from System Dynamics Software into 'R'

context("Simulators")

deSolve_m1 <- list(
  stocks = c(Population = 100),
  consts = c(growth_rate = 0.01),
  func   =
    function(time, stocks, auxs) {
      with(as.list(c(stocks, auxs)), {
        net_growth      <- Population * growth_rate
        d_Population_dt <- net_growth
        return(list(c(d_Population_dt), net_growth = net_growth,
                    growth_rate = growth_rate))
      })
    },
  sim_params = list(start = 0, stop = 1, dt = 0.25))

deSolve_m2 <- list(
  stocks = c(Population = 100),
  consts = c(growth_rate = 0.01),
  func   =     function(time, stocks, auxs, graph_funs) {
    with(as.list(c(stocks, auxs, graph_funs)), {
      non_linear_effect <- f_non_linear_effect(Population)
      net_growth        <- Population*growth_rate*non_linear_effect
      d_Population_dt   <- net_growth
      return(list(c(d_Population_dt), net_growth = net_growth,
                  growth_rate = growth_rate))
    })
  },
  sim_params = list(start = 0, stop = 1, dt = 0.25),
  graph_funs = list(
    f_non_linear_effect =
      approxfun(
        x      = 100:105,
        y      = c(2, 2, 2, 1, 1, 1),
        method = "linear",
        yleft  = 2,
        yright = 1
  )))

deSolve_m3 <- list(
  stocks = c(Population = 100,
             Cumulative_Deaths = 0),
  consts = c(birth_rate = 0.01, death_rate = 0.01),
  func   =
    function(time, stocks, auxs) {
      with(as.list(c(stocks, auxs)), {
        births                 <- Population * birth_rate
        deaths                 <- Population * death_rate
        d_Population_dt        <- births - deaths
        d_Cumulative_Deaths_dt <- deaths
        return(list(c(d_Population_dt, d_Cumulative_Deaths_dt), births = births,
                    deaths = deaths,
                    birth_rate = birth_rate,
                    death_rate = death_rate))
      })
    },
  sim_params = list(start = 0, stop = 1, dt = 0.25))


test_that("sd_simulate() returns the expected output", {
  output <- sd_simulate(deSolve_m1)
  expect_is(output, "data.frame")
  expect_equal(output[nrow(output), "Population"], 101.003756)
})

test_that("sd_simulate() allows changing default sim params", {
  output <- sd_simulate(deSolve_m1, start_time = 1, stop_time = 2,
                        timestep = 0.5)

  expect_equal(output[1, "time"], 1)
  expect_equal(output[nrow(output), "time"], 2)
  expect_equal(nrow(output), 3)
})

test_that("sd_simulate() handles graphical functions", {
  output <- sd_simulate(deSolve_m2)
  expect_equal(output[nrow(output), "Population"], 102.015050)
})

test_that("sd_sensitivity_run() returns the expected output for constant sensitivity", {
  consts_df <- data.frame(growth_rate = c(0.01, 0.02))
  output    <- sd_sensitivity_run(deSolve_m1, consts_df = consts_df)
  expect_equal(output[c(5, 10), "Population"], c(101.003756, 102.015050))
})

test_that("sd_sensitivity_run() returns the expected output for sensitivity of initial values ", {
  stocks_df <- data.frame(Population = c(10,100))
  output    <- sd_sensitivity_run(deSolve_m1, stocks_df = stocks_df)
  expect_equal(output[c(5, 10), "Population"], c(10.100376, 101.003756))
})

test_that("sd_sensitivity_run() works for simultaneous sensitivity to stocks and constants", {
  consts_df <- data.frame(growth_rate = c(0.01, 0.02))
  stocks_df <- data.frame(Population = c(100, 10))
  output    <- sd_sensitivity_run(deSolve_m1, consts_df = consts_df,
                                  stocks_df = stocks_df)
  expect_equal(output[c(5, 10), "Population"], c(101.003756, 	10.2015050))
})

test_that("sd_sensitivity_run() returns an error when the input data frames are
of unequal size", {
  consts_df <- data.frame(growth_rate = c(0.01))
  stocks_df <- data.frame(Population = c(100, 10))

  expect_error(
    sd_sensitivity_run(deSolve_m1, consts_df = consts_df,
                       stocks_df = stocks_df),
    "the number of rows in both data frames (consts & stocks) must be of equal size",
    fixed = TRUE)
})

test_that("sd_sensitivity_run() works for models with graph funs", {
  consts_df <- data.frame(growth_rate = c(0.01, 0.02))
  output    <- sd_sensitivity_run(deSolve_m2, consts_df = consts_df)
  expect_equal(output[c(5, 10), "Population"], c(102.015050, 103.540124))
})

test_that("sd_sensitivity_run() works for a subset of constants", {
  consts_df <- data.frame(death_rate = c(0, 0.01))
  output    <- sd_sensitivity_run(deSolve_m3, consts_df = consts_df)
  expect_equal(output[c(5, 10), "Population"], c(101.003756, 100))
})

test_that("sd_sensitivity_run() works for a subset of stocks", {
  stocks_df <- data.frame(Population = c(10,100))
  output    <- sd_sensitivity_run(deSolve_m3, stocks_df = stocks_df)
  expect_equal(output[c(5, 10), "Population"], c(10, 100))
})

test_that("sd_sensitivity_run() works for a subset of constants & stocks", {
  stocks_df <- data.frame(Population = c(10, 100))
  consts_df <- data.frame(death_rate = c(0, 0.01))
  output    <- sd_sensitivity_run(deSolve_m3, consts_df = consts_df,
                                  stocks_df = stocks_df)
  expect_equal(output[c(5, 10), "Population"], c(10.1003756, 100))
})

test_that("sd_sensitivity_run() deals with the order of the stocks", {
  stocks_df <- data.frame(Cumulative_Deaths = c(0, 10))
  output    <- sd_sensitivity_run(deSolve_m3, stocks_df = stocks_df)
  expect_equal(output[c(5, 10), "Cumulative_Deaths"], c(1, 11))
})

test_that("sd_sensitivity_run() works with several cores", {
  consts_df <- data.frame(growth_rate = c(0.01, 0.02))
  output    <- sd_sensitivity_run(deSolve_m1, consts_df = consts_df,
                                  multicore = TRUE, n_cores = 2)
  expect_equal(output[c(5, 10), "Population"], c(101.003756, 102.015050))


  stocks_df <- data.frame(Population = c(10,100))
  output    <- sd_sensitivity_run(deSolve_m1, stocks_df = stocks_df,
                                  multicore = TRUE, n_cores = 2)
  expect_equal(output[c(5, 10), "Population"], c(10.100376, 101.003756))


  consts_df <- data.frame(growth_rate = c(0.01, 0.02))
  stocks_df <- data.frame(Population = c(100, 10))
  output    <- sd_sensitivity_run(deSolve_m1, consts_df = consts_df,
                                  stocks_df = stocks_df,
                                  multicore = TRUE, n_cores = 2)
  expect_equal(output[c(5, 10), "Population"], c(101.003756, 	10.2015050))
})