Feat/grid

[giovannic]

Still WIP. Speed up rendering of statistics in year wide age-bands between 0 and 100.

Here is an example of how it would be run:

library(malariasimulation)

# Parameters that specify more output with a single age group
p_single_age <- get_parameters(
  overrides = list(
    human_population = 1000
  )
) |>
  set_equilibrium(
    init_EIR = 5
  )
p_single_age$prevalence_rendering_min_ages <- 0
p_single_age$prevalence_rendering_max_ages <- 100 * 365

# Parameters that specify output with multiple age groups
p_multiple_age <- p_single_age
p_multiple_age$prevalence_rendering_min_ages <- 0:99 * 365
p_multiple_age$prevalence_rendering_max_ages <- 1:100 * 365 - 1
p_multiple_age$clinical_incidence_rendering_min_ages <- 0:99 * 365
p_multiple_age$clinical_incidence_rendering_max_ages <- 1:100 * 365 - 1

p_grid <- p_single_age
p_grid$render_grid <- c('p_detect_', 'p_inc_clinical_')

set.seed(1)

system.time({
  s_single_age <- run_simulation(
    timesteps = 365 * 2,
    parameters = p_single_age
  )
})

set.seed(1)

system.time({
  s_grid <- run_simulation(
    timesteps = 365 * 2,
    parameters = p_grid
  )
})

jpeg('grid.jpg')
for (i in c(1, 50, 100)) {
  if (i == 1) {
    plot(
      as.numeric(s_grid$timestep),
      as.numeric(s_grid[[paste0(
        'grid_p_detect_',
        i
      )]]),
      type = 'l'
    )
  } else {
    lines(
      as.numeric(s_grid$timestep),
      as.numeric(s_grid[[paste0(
        'grid_p_detect_',
        i
      )]])
    )
  }
}
dev.off()

jpeg('grid_inc.jpg')
for (i in c(1, 50, 100)) {
  if (i == 1) {
    plot(
      as.numeric(s_grid$timestep),
      as.numeric(s_grid[[paste0(
        'grid_p_inc_clinical_',
        i
      )]]),
      type = 'l'
    )
  } else {
    lines(
      as.numeric(s_grid$timestep),
      as.numeric(s_grid[[paste0(
        'grid_p_inc_clinical_',
        i
      )]])
    )
  }
}
dev.off()


set.seed(1)

system.time({
  s_multiple_age <- run_simulation(
    timesteps = 365 * 2,
    parameters = p_multiple_age
  )
})

jpeg('multiple.jpg')
for (i in c(1, 50, 100)) {
  if (i == 1) {
    plot(
      as.numeric(s_multiple_age$timestep),
      as.numeric(s_multiple_age[[paste0(
        'p_detect_',
        p_multiple_age$prevalence_rendering_min_ages[i],
        '_',
        p_multiple_age$prevalence_rendering_max_ages[i]
      )]]),
      type = 'l'
    )
  } else {
    lines(
      as.numeric(s_multiple_age$timestep),
      as.numeric(s_multiple_age[[paste0(
        'p_detect_',
        p_multiple_age$prevalence_rendering_min_ages[i],
        '_',
        p_multiple_age$prevalence_rendering_max_ages[i]
      )]])
    )
  }
}
dev.off()

jpeg('multiple_inc.jpg')
for (i in c(1, 50, 100)) {
  if (i == 1) {
    plot(
      as.numeric(s_multiple_age$timestep),
      as.numeric(s_multiple_age[[paste0(
        'p_inc_clinical_',
        p_multiple_age$prevalence_rendering_min_ages[i],
        '_',
        p_multiple_age$prevalence_rendering_max_ages[i]
      )]]),
      type = 'l'
    )
  } else {
    lines(
      as.numeric(s_multiple_age$timestep),
      as.numeric(s_multiple_age[[paste0(
        'p_inc_clinical_',
        p_multiple_age$prevalence_rendering_min_ages[i],
        '_',
        p_multiple_age$prevalence_rendering_max_ages[i]
      )]])
    )
  }
}
dev.off()

Performance

This outputs the following (6x speedup)

   user  system elapsed
  5.492   0.000   5.458
   user  system elapsed
 14.934   0.000  14.940
null device
          1
null device
          1
   user  system elapsed
 91.076   0.000  91.095
null device
          1
null device
          1

TODO

• Resolve minor differences in p_detect outputs
• Implement microbenchmarks to better measure the improvements
• Better validation on grid parameterisation

[lmhaile]

Hi Giovanni!

Here is a snippet of test code. It seems like I can observe the speed up with smaller populations (IE 10k), but do not observe a speed-up with larger populations (50k example shown below). This is a relatively long model run (116 years), so that may be part of it?

Using the progress bar functionality as a quick runtime estimate, but open to suggestions! Sending the filepath over via Teams.

site<- readRDS('site_file_example.rds')

params <- site::site_parameters(
  interventions = site$interventions,
  demography = site$demography,
  vectors = site$vectors,
  seasonality = site$seasonality,
  eir = site$eir$eir[1],
  burnin = 15,
  overrides = list(human_population = 50000)
)

# quick profiling
params$progress_bar <- TRUE

# check estimated runtime for default :estimate 35 min
malariasimulation::run_simulation(timesteps = params$timesteps,
                                  parameters = params)


# comparator for single year age groups: 1 hour
params$clinical_incidence_rendering_min_ages = 0:99 * 365
params$clinical_incidence_rendering_max_ages = 1:100 * 365 - 1
params$severe_incidence_rendering_min_ages =  0:99 * 365
params$severe_incidence_rendering_max_ages = 1:100 * 365 - 1
params$age_group_rendering_min_ages =  0:99 * 365
params$age_group_rendering_max_ages = 1:100 * 365 - 1

malariasimulation::run_simulation(timesteps = params$timesteps,
                                  parameters = params)



# parameter grid example: estimate 1 hour
params$clinical_incidence_rendering_min_ages = numeric(0)
params$clinical_incidence_rendering_max_ages = numeric(0)
params$severe_incidence_rendering_min_ages = numeric(0)
params$severe_incidence_rendering_max_ages = numeric(0)
params$age_group_rendering_min_ages = numeric(0)
params$age_group_rendering_max_ages = numeric(0)


p_grid <- params
p_grid$render_grid <- c('n_inc_clinical_', 'n_inc_sev_')
malariasimulation::run_simulation(timesteps = p_grid$timesteps,
                                  parameters = p_grid)