diff --git a/.gitignore b/.gitignore index b2bb43e..1892e6d 100644 --- a/.gitignore +++ b/.gitignore @@ -8,4 +8,5 @@ *.o *.so *.Rcheck -temp_out/ \ No newline at end of file +temp_out/ +r_versions/ \ No newline at end of file diff --git a/.lintr b/.lintr index 582e57a..51004e1 100644 --- a/.lintr +++ b/.lintr @@ -1 +1,3 @@ -exclusions: list("r_versions", "comoOdeCpp/tests/testthat/v13.13.core.R", "comoOdeCpp/R/RcppExports.R") +linters: with_defaults(line_length_linter(120)) +comment_bot: FALSE +exclusions: list("r_versions", "comoOdeCpp/tests/testthat/v16.2.core.R", "tests/testthat/v16.2.core.R", "comoOdeCpp/tests/testthat/v16.2.core.input_mod.R", "tests/testthat/v16.2.core.input_mod.R", "comoOdeCpp/R/RcppExports.R", "R/RcppExports.R") diff --git a/.travis.yml b/.travis.yml index e736472..8ae6690 100644 --- a/.travis.yml +++ b/.travis.yml @@ -2,9 +2,11 @@ language: r r: 3.6.3 cache: packages +warnings_are_errors: false r_packages: - covr + - lintr before_install: - cd comoOdeCpp @@ -12,9 +14,9 @@ before_install: global: - R_BUILD_ARGS="--no-build-vignettes --no-manual" - R_CHECK_ARGS="--no-build-vignettes --no-manual" - + - LINTR_COMMENT_BOT=FALSE + r_build_args: --no-build-vignettes --no-manual r_check_args: --no-build-vignettes --no-manual after_success: - - Rscript -e 'library(covr);codecov()' \ No newline at end of file diff --git a/README.md b/README.md index 26045a9..01bfb46 100644 --- a/README.md +++ b/README.md @@ -1,9 +1,9 @@ # comoOdeCpp [![GitHub release](https://img.shields.io/github/v/release/bogaotory/comoOdeCpp.svg)](https://GitHub.com/bogaotory/comoOdeCpp/releases/) -[![Build Status](https://travis-ci.org/ocelhay/comoOdeCpp.svg?branch=master)](https://travis-ci.org/ocelhay/comoOdeCpp) +[![Build Status](https://travis-ci.org/bogaotory/comoOdeCpp.svg?branch=master)](https://travis-ci.org/bogaotory/comoOdeCpp) ![Maintenance](https://img.shields.io/maintenance/yes/2020) -[![CodeFactor](https://www.codefactor.io/repository/github/ocelhay/comoodecpp/badge)](https://www.codefactor.io/repository/github/ocelhay/comoodecpp) +[![CodeFactor](https://www.codefactor.io/repository/github/bogaotory/comoodecpp/badge)](https://www.codefactor.io/repository/github/bogaotory/comoodecpp) [![Codecov](https://img.shields.io/codecov/c/github/bogaotory/comoOdeCpp)](https://codecov.io/gh/bogaotory/comoOdeCpp) diff --git a/comoOdeCpp/DESCRIPTION b/comoOdeCpp/DESCRIPTION index 75188f0..c745061 100644 --- a/comoOdeCpp/DESCRIPTION +++ b/comoOdeCpp/DESCRIPTION @@ -1,8 +1,8 @@ Package: comoOdeCpp Type: Package Title: Cpp version of CoMo Consortium's COVID-19 transmission model -Version: 16.2.0 -Date: 2020-10-01 +Version: 16.2.1 +Date: 2020-10-23 Author: Ricardo Aguas, Bo Gao, Sompob Saralamba Maintainer: Bo Gao Description: Cpp version of CoMo Consortium's COVID-19 transmission model @@ -10,10 +10,10 @@ License: Attribution-NonCommercial 4.0 International Depends: stats (>= 3.1.3) Imports: - Rcpp (>= 1.0.4.6) + Rcpp (>= 1.0.4.6), + dplyr Suggests: testthat, deSolve, - dplyr, readxl LinkingTo: Rcpp, RcppArmadillo diff --git a/comoOdeCpp/NAMESPACE b/comoOdeCpp/NAMESPACE index ce3e009..714df17 100644 --- a/comoOdeCpp/NAMESPACE +++ b/comoOdeCpp/NAMESPACE @@ -1,5 +1,5 @@ importFrom(stats, splinefun) importFrom(Rcpp, evalCpp) +importFrom(dplyr, arrange) useDynLib(comoOdeCpp, .registration=TRUE) exportPattern("^[[:alpha:]]+") - diff --git a/comoOdeCpp/R/io.R b/comoOdeCpp/R/io.R new file mode 100644 index 0000000..b4fbf16 --- /dev/null +++ b/comoOdeCpp/R/io.R @@ -0,0 +1,114 @@ +#' Read the "Interventions" tab of the template into a list of time-series vectors +#' +#' This function is to provide the same functionality of the inputs function that's part of the como App +#' which is to translate the information from the Excel spreadsheet to a list of time-series vectors controlling +#' the actions of different interventions during the course of the simulation +#' @return A list of vectors including those listed as `val_vec` and `bol_vec` in `intv_profile_list` +#' @export +read_intervention_schedule <- function( + inp, # read_excel(file_path, sheet = "Interventions") + run, # 'Baseline (Calibration)' or 'Hypothetical Scenario' + time_max, # tail(times,1) + steps_per_time, # 20 <- 1/hini; hini = 0.05 + startdate, # Date, Simulation Start, "Parameters" tab + stopdate, # Date, Simulation End, "Parameters" tab + age_testing_min, # "Interventions Param" tab + age_testing_max, # "Interventions Param" tab + age_vaccine_min, # "Interventions Param" tab + age_vaccine_max, # "Interventions Param" tab + fill_day_gap = TRUE + ) { + + v <- (format(as.POSIXct(inp[["Date Start"]], format = "%Y/%m/%d %H:%M:%S"), format = "%d/%m/%y")) + v2 <- as.Date(v, format = "%d/%m/%y") + inp[["Date Start"]] <- v2 + + v <- (format(as.POSIXct(inp[["Date End"]], format = "%Y/%m/%d %H:%M:%S"), format = "%d/%m/%y")) + v2 <- as.Date(v, format = "%d/%m/%y") + inp[["Date End"]] <- v2 + + + inp[["Date Start"]] <- pmax(startdate, as.Date(inp[["Date Start"]])) + inp[["Date End"]] <- pmax(startdate, as.Date(inp[["Date End"]])) + + # cap intervention end dates with simulation end date + inp[["Date Start"]] <- pmin(stopdate, as.Date(inp[["Date Start"]])) + inp[["Date End"]] <- pmin(stopdate, as.Date(inp[["Date End"]])) + + + inp <- dplyr::arrange(inp, "Date Start") + + tv <- which(inp[["Apply to"]] == run) + + intv_profile_list <- list( + list(text = "Self-isolation if Symptomatic", val_vec = "si_vector", val_default = 0, bol_vec = "isolation"), + list(text = "(*Self-isolation) Screening", val_vec = "scr_vector", val_default = 0, bol_vec = "screen"), + list(text = "(*Self-isolation) Household Isolation", val_vec = "q_vector", val_default = 0, bol_vec = "quarantine"), + list(text = "Social Distancing", val_vec = "sd_vector", val_default = 0, bol_vec = "distancing"), + list(text = "Handwashing", val_vec = "hw_vector", val_default = 0, bol_vec = "handwash"), + list(text = "Mask Wearing", val_vec = "msk_vector", val_default = 0, bol_vec = "masking"), + list(text = "Working at Home", val_vec = "wah_vector", val_default = 0, bol_vec = "workhome"), + list(text = "School Closures", val_vec = "sc_vector", val_default = 0, bol_vec = "schoolclose"), + list(text = "Shielding the Elderly", val_vec = "cte_vector", val_default = 0, bol_vec = "cocoon"), + list(text = "International Travel Ban", val_vec = "tb_vector", val_default = 0, bol_vec = "travelban"), + list(text = "Vaccination", val_vec = "vc_vector", val_default = 0, bol_vec = "vaccine"), + list(text = "(*Vaccination) Age Vaccine Minimum", val_vec = "minav_vector", val_default = age_vaccine_min), + list(text = "(*Vaccination) Age Vaccine Maximum", val_vec = "maxav_vector", val_default = age_vaccine_max), + list(text = "Mass Testing", val_vec = "mt_vector", val_default = 0, bol_vec = "masstesting"), + list(text = "(*Mass Testing) Age Testing Minimum", val_vec = "minas_vector", val_default = age_testing_min), + list(text = "(*Mass Testing) Age Testing Maximum", val_vec = "maxas_vector", val_default = age_testing_max), + list(text = "Dexamethasone", bol_vec = "dex") + ) + + intv_vectors <- list() + + for (intv in intv_profile_list) { + # print(intv[["text"]]) + + # default vectors + ii_val_vec <- rep(0, time_max * steps_per_time) + if (!is.null( intv[["val_default"]] )) { + ii_val_vec <- rep(intv[["val_default"]], time_max * steps_per_time) + } + ii_bol_vec <- rep(0, time_max * steps_per_time) + + ii_rows <- intersect(which(inp[["Intervention"]] == intv[["text"]]), tv) + + if (length(ii_rows) >= 1) { + prev_t2 <- -10 + for (rr in ii_rows) { + + t1 <- inp[["Date Start"]][rr] - startdate + t2 <- inp[["Date End"]][rr] - startdate + + if (fill_day_gap && (t1 == (prev_t2 + 1))) { + t1 <- t1 - 1 + } + prev_t2 <- t2 + + stopifnot(t1 >= 0) + stopifnot(t2 >= 0) + + if (t1 < t2) { + idx1 <- t1 * steps_per_time + 1 + idx2 <- t2 * steps_per_time + ii_val_vec[idx1:idx2] <- inp[["Value"]][rr] + ii_bol_vec[idx1:idx2] <- 1 + } + + } + } + + if (!is.null( intv[["val_vec"]] )) { + intv_vectors[[ intv[["val_vec"]] ]] <- ii_val_vec + } + if (!is.null( intv[["bol_vec"]] )) { + intv_vectors[[ intv[["bol_vec"]] ]] <- ii_bol_vec + } + + } + + intv_vectors[["mt_vector"]] <- intv_vectors[["mt_vector"]] * 1000 + + return(intv_vectors) +} \ No newline at end of file diff --git a/comoOdeCpp/tests/testthat/common.R b/comoOdeCpp/tests/testthat/common.R new file mode 100644 index 0000000..287de75 --- /dev/null +++ b/comoOdeCpp/tests/testthat/common.R @@ -0,0 +1,110 @@ +CORE_FILE <- "/v16.2.core.input_mod.R" + +check_libraries <- function() { + library_list <- list( + "deSolve", + "dplyr", + "readxl" + ) + for (ll in library_list) { + if (!requireNamespace(ll, quietly = TRUE)) { + testthat::skip(paste(ll, "needed but not available")) + } + } +} + +load_libraries <- function() { + check_libraries() + library("deSolve") + library("dplyr") + library("readxl") + library("comoOdeCpp") +} + +init <- function(e) { + load_libraries() + load("data/data_CoMo.RData", envir = e) +} + +check_parameters_list_for_na <- function(parameters_list) { + for (pp_name in names(parameters_list)) { + if (is.na(parameters_list[[pp_name]])) { + print(paste0("parameters_list[\"", pp_name, "\"] = ", parameters_list[[pp_name]]), quote = FALSE) + testthat::expect_equal(is.na(parameters_list[[pp_name]]), FALSE) + stop() + } + } +} + +match_outputs <- function( + output_a, # output matrix #1 + output_b, # output matrix #2 + tlr = 0.0001, # tolerance + smp = 1000 # num samples to take + ) { + + # for (ii in 1:smp) { + for (ii in seq_len(smp)) { + # rr <- sample(1:nrow(output_a), 1) + # cc <- sample(1:ncol(output_a), 1) + rr <- sample(seq_len(nrow(output_a)), 1) + cc <- sample(seq_len(ncol(output_a)), 1) + # print(paste("output_a[rr,cc] =", output_a[rr,cc])) + # print(paste("output_b[rr,cc] =", output_b[rr,cc])) + + out_a <- output_a[rr, cc] + out_b <- output_b[rr, cc] + + testthat::expect_true(is.numeric(out_a)) + testthat::expect_true(is.numeric(out_b)) + + testthat::expect_gte(out_a, 0) # >=0 + testthat::expect_gte(out_b, 0) # >=0 + + if (out_a > 0) { + + res <- expect_equal( + out_b, + out_a, + tolerance = tlr, + scale = out_a + ) + + if (abs(out_b - out_a) > out_a * tlr) { + print(paste( + "not equal: rr=", rr, + ", cc=", cc, + ", pp=", pp, + ", output_a[rr,cc]", out_a, + ", output_b[rr,cc]", out_b + )) + } + + } + } + +} + +match_processed_outputs <- function( + output_a, # processed output matrix + output_b, # processed output matrix + tlr = 0.0001 # tolerance + ) { + + testthat::expect_true(is.numeric(output_a$total_cm_deaths_end)) + testthat::expect_true(is.numeric(output_a$total_reportable_deaths_end)) + + testthat::expect_equal( + output_a$total_cm_deaths_end, + output_b$total_cm_deaths_end, + tolerance = tlr, + scale = output_b$total_cm_deaths_end + ) + + testthat::expect_equal( + output_a$total_reportable_deaths_end, + output_b$total_reportable_deaths_end, + tolerance = tlr, + scale = output_b$total_reportable_deaths_end + ) +} diff --git a/comoOdeCpp/tests/testthat/data/Template_CoMoCOVID-19App_new_16.1.xlsx b/comoOdeCpp/tests/testthat/data/Template_CoMoCOVID-19App_new_16.1.xlsx deleted file mode 100644 index 00975fa..0000000 Binary files a/comoOdeCpp/tests/testthat/data/Template_CoMoCOVID-19App_new_16.1.xlsx and /dev/null differ diff --git a/comoOdeCpp/tests/testthat/data/templates_v16.2/Template_CoMoCOVID-19App_intv_split.xlsx b/comoOdeCpp/tests/testthat/data/templates_v16.2/Template_CoMoCOVID-19App_intv_split.xlsx new file mode 100644 index 0000000..e670380 Binary files /dev/null and b/comoOdeCpp/tests/testthat/data/templates_v16.2/Template_CoMoCOVID-19App_intv_split.xlsx differ diff --git a/comoOdeCpp/tests/testthat/data/templates_v16.2/Template_CoMoCOVID-19App_io_intv_sched.xlsx b/comoOdeCpp/tests/testthat/data/templates_v16.2/Template_CoMoCOVID-19App_io_intv_sched.xlsx new file mode 100644 index 0000000..f2a7bfa Binary files /dev/null and b/comoOdeCpp/tests/testthat/data/templates_v16.2/Template_CoMoCOVID-19App_io_intv_sched.xlsx differ diff --git a/comoOdeCpp/tests/testthat/data/templates_v16.2/Template_CoMoCOVID-19App_r_v_cpp.xlsx b/comoOdeCpp/tests/testthat/data/templates_v16.2/Template_CoMoCOVID-19App_r_v_cpp.xlsx new file mode 100644 index 0000000..0eb0a02 Binary files /dev/null and b/comoOdeCpp/tests/testthat/data/templates_v16.2/Template_CoMoCOVID-19App_r_v_cpp.xlsx differ diff --git a/comoOdeCpp/tests/testthat/data/templates_v16.2/Template_CoMoCOVID-19App_sa.xlsx b/comoOdeCpp/tests/testthat/data/templates_v16.2/Template_CoMoCOVID-19App_sa.xlsx new file mode 100644 index 0000000..775b2ea Binary files /dev/null and b/comoOdeCpp/tests/testthat/data/templates_v16.2/Template_CoMoCOVID-19App_sa.xlsx differ diff --git a/comoOdeCpp/tests/testthat/test-io_functions.R b/comoOdeCpp/tests/testthat/test-io_functions.R new file mode 100644 index 0000000..ea74e65 --- /dev/null +++ b/comoOdeCpp/tests/testthat/test-io_functions.R @@ -0,0 +1,124 @@ +test_that("compare read_intervention_schedule of comoOdeCpp and inputs of como App", { + # skip("temp skip") + rm(list = ls()) + source(paste0(getwd(), "/common.R"), local = environment()) + init(e = environment()) + + file_path <- paste0(getwd(), "/data/templates_v16.2/Template_CoMoCOVID-19App_io_intv_sched.xlsx") + + if (!exists("inputs", mode = "function")) { + source(paste0(getwd(), CORE_FILE), local = environment()) + } + + intv_schd_base <- read_intervention_schedule( + inp = read_excel(file_path, sheet = "Interventions"), + run = "Baseline (Calibration)", + time_max = tail(times, 1), + steps_per_time = 20, + startdate = startdate, + stopdate = stopdate, + age_testing_min = parameters["age_testing_min"], + age_testing_max = parameters["age_testing_max"], + age_vaccine_min = parameters["age_vaccine_min"], + age_vaccine_max = parameters["age_vaccine_max"] + ) + + intv_schd_hype <- read_intervention_schedule( + inp = read_excel(file_path, sheet = "Interventions"), + run = "Hypothetical Scenario", + time_max = tail(times, 1), + steps_per_time = 20, + startdate = startdate, + stopdate = stopdate, + age_testing_min = parameters["age_testing_min"], + age_testing_max = parameters["age_testing_max"], + age_vaccine_min = parameters["age_vaccine_min"], + age_vaccine_max = parameters["age_vaccine_max"] + ) + + for (vv in names(vectors0)) { + if (!all(vectors0[[vv]] == intv_schd_base[[vv]])) { + print(vv) + print("vectors0[[vv]]") + print(vectors0[[vv]]) + print("intv_schd_base[[vv]]") + print(intv_schd_base[[vv]]) + } + expect_true(is.numeric((intv_schd_base[[vv]]))) + expect_true(all(vectors0[[vv]] == intv_schd_base[[vv]])) + } + for (vv in names(vectors)) { + if (!all(vectors[[vv]] == intv_schd_hype[[vv]])) { + print(vv) + print("vectors[[vv]]") + print(vectors[[vv]]) + print("intv_schd_hype[[vv]]") + print(intv_schd_hype[[vv]]) + } + expect_true(is.numeric((intv_schd_hype[[vv]]))) + expect_true(all(vectors[[vv]] == intv_schd_hype[[vv]])) + } + + + check_parameters_list_for_na(parameters) + + parameters["p"] <- 0.05 + + input_list <- list( + vectors0, + intv_schd_base, + vectors, + intv_schd_hype + ) + + output_list <- list() + output_processed_list <- list() + + cc <- 0 + for (ii in input_list) { + + + covidOdeCpp_reset() + output_message <- capture_output( + output <- ode( + y = Y, times = times, method = "euler", hini = 0.05, + func = covidOdeCpp, parms = parameters, + input = ii, A = A, + contact_home = contact_home, + contact_school = contact_school, + contact_work = contact_work, + contact_other = contact_other, + popbirth_col2 = popbirth[, 2], + popstruc_col2 = popstruc[, 2], + ageing = ageing, + ifr_col2 = ifr[, 2], + ihr_col2 = ihr[, 2], + mort_col = mort + ) + ) + output_processed <- process_ode_outcome_mortality(output, ii, parameters) + + cc <- cc + 1 + output_list[[cc]] <- output + output_processed_list[[cc]] <- output_processed + + } + + for (ii in c(1, 3)) { + + match_processed_outputs( + output_a = output_processed_list[[ii]], + output_b = output_processed_list[[ii + 1]], + tlr = 0.0001 + ) + + match_outputs( + output_a = output_list[[ii]], + output_b = output_list[[ii + 1]], + tlr = 0.0001, + smp = 100 + ) + + } + +}) \ No newline at end of file diff --git a/comoOdeCpp/tests/testthat/test-scenario01.R b/comoOdeCpp/tests/testthat/test-scenario01.R index 48cdcc7..48e1577 100644 --- a/comoOdeCpp/tests/testthat/test-scenario01.R +++ b/comoOdeCpp/tests/testthat/test-scenario01.R @@ -1,46 +1,91 @@ -check_libraries <- function() { - library_list <- list( - "deSolve", - "dplyr", - "readxl" +test_that("Splitting intervention", { + # skip("temp skip") + rm(list = ls()) + source(paste0(getwd(), "/common.R"), local = environment()) + init(e = environment()) + + file_path <- paste0(getwd(), "/data/templates_v16.2/Template_CoMoCOVID-19App_intv_split.xlsx") + + # if (!exists("inputs", mode = "function")) { + source(paste0(getwd(), CORE_FILE), local = environment()) + # } + + check_parameters_list_for_na(parameters) + covidOdeCpp_reset() + output_message <- capture_output( + out_base <- ode( + y = Y, times = times, method = "euler", hini = 0.05, + func = covidOdeCpp, parms = parameters, + input = vectors0, A = A, + contact_home = contact_home, + contact_school = contact_school, + contact_work = contact_work, + contact_other = contact_other, + popbirth_col2 = popbirth[, 2], + popstruc_col2 = popstruc[, 2], + ageing = ageing, + ifr_col2 = ifr[, 2], + ihr_col2 = ihr[, 2], + mort_col = mort + ) ) - for (ll in library_list) { - if (!requireNamespace(ll, quietly = TRUE)) { - testthat::skip(paste(ll, "needed but not available")) - } - } -} + processed_base_results <- process_ode_outcome_mortality(out_base, vectors0, parameters) + + + covidOdeCpp_reset() + output_message <- capture_output( + out_hype <- ode( + y = Y, times = times, method = "euler", hini = 0.05, + func = covidOdeCpp, parms = parameters, + input = vectors, A = A, + contact_home = contact_home, + contact_school = contact_school, + contact_work = contact_work, + contact_other = contact_other, + popbirth_col2 = popbirth[, 2], + popstruc_col2 = popstruc[, 2], + ageing = ageing, + ifr_col2 = ifr[, 2], + ihr_col2 = ihr[, 2], + mort_col = mort + ) + ) + processed_hype_results <- process_ode_outcome_mortality(out_hype, vectors, parameters) + + expect_equal( + processed_base_results$total_cm_deaths_end, + processed_hype_results$total_cm_deaths_end + ) + + match_outputs( + output_a = out_base, + output_b = out_hype, + tlr = 0.0001, + smp = 100 + ) + +}) test_that("Matching Rcpp and R version at p={0.00,0.01, ... 0.1}", { - check_libraries() - rm(list = ls()) + # skip("temp skip") - library("deSolve") - library("dplyr") - library("readxl") - library("comoOdeCpp") + rm(list = ls()) + source(paste0(getwd(), "/common.R"), local = environment()) + init(e = environment()) - load("data/data_CoMo.RData") - - file_path <- paste0(getwd(), "/data/Template_CoMoCOVID-19App_new_16.1.xlsx") + file_path <- paste0(getwd(), "/data/templates_v16.2/Template_CoMoCOVID-19App_r_v_cpp.xlsx") if (!exists("inputs", mode = "function")) { - source(paste0(getwd(), "/v16.2.core.R"), local = environment()) + source(paste0(getwd(), CORE_FILE), local = environment()) } - for (pp_name in names(parameters)) { - if (is.na(parameters[[pp_name]])) { - print(paste0("parameters[\"",pp_name, "\"] = ", parameters[[pp_name]]), quote = FALSE) - expect_equal(is.na(parameters[[pp_name]]), FALSE) - stop() - } - } + check_parameters_list_for_na(parameters) # environment(check_mortality_count) <- environment() - p_value_list = seq(0.0, 0.1, by = 0.02) - # p_value_list = seq(0.1, 0.1) + p_value_list <- seq(0.0, 0.1, by = 0.025) + # p_value_list <- seq(0.1, 0.1) scenario_list <- list( vectors0, # Baseline @@ -58,7 +103,7 @@ test_that("Matching Rcpp and R version at p={0.00,0.01, ... 0.1}", { + rnorm( length(parameters_noise), mean = 0, - sd = noise*abs(parameters[parameters_noise]) + sd = noise * abs(parameters[parameters_noise]) ) covidOdeCpp_reset() @@ -86,7 +131,7 @@ test_that("Matching Rcpp and R version at p={0.00,0.01, ... 0.1}", { expect_equal( processed_cpp_results$total_reportable_deaths_end, processed_cpp_results$total_cm_deaths_end, - tolerance = 0.01, + tolerance = 0.1, scale = processed_cpp_results$total_cm_deaths_end ) @@ -104,70 +149,26 @@ test_that("Matching Rcpp and R version at p={0.00,0.01, ... 0.1}", { expect_equal( processed_r_results$total_reportable_deaths_end, processed_r_results$total_cm_deaths_end, - tolerance = 0.01, + tolerance = 0.1, scale = processed_r_results$total_cm_deaths_end ) - expect_equal( - processed_cpp_results$total_cm_deaths_end, - processed_r_results$total_cm_deaths_end, - tolerance = 0.0001, - scale = processed_r_results$total_cm_deaths_end - ) - expect_equal( - processed_cpp_results$total_reportable_deaths_end, - processed_r_results$total_reportable_deaths_end, - tolerance = 0.0001, - scale = processed_r_results$total_reportable_deaths_end + match_processed_outputs( + output_a = processed_cpp_results, + output_b = processed_r_results, + tlr = 0.0001 ) - # print(paste("processed_r$total_reported_deaths_end=", processed_r$total_reported_deaths_end)) - # print(paste("processed_r$total_deaths_end=", processed_r$total_deaths_end)) - - # print(paste( - # "results$attributable_deaths_end:", processed_cpp$attributable_deaths_end, ",", processed_r$attributable_deaths_end, - # "results$reportable_death:", processed_cpp$reportable_death, ",", processed_r$reportable_death, - # "results$total_deaths_end:", processed_cpp$total_deaths_end, ",", processed_r$total_deaths_end - # )) - - # expect_equal(processed_cpp$attributable_deaths_end, processed_r$attributable_deaths_end) - # expect_equal(processed_cpp$reportable_death, processed_r$reportable_death) - # expect_equal(processed_cpp$total_deaths_end, processed_r$total_deaths_end) - # sss = 1 # write.csv(out_cpp, paste0("out_cpp_",sss,"_",parameters["p"],".csv"),row.names = FALSE) # write.csv(out_r, paste0("out_r_",sss,"_",parameters["p"],".csv"),row.names = FALSE) - for (ii in 1:1000) { - rr = sample(1:nrow(out_r),1) - cc = sample(1:ncol(out_r),1) - # print(paste("out_r[rr,cc] =", out_r[rr,cc])) - # print(paste("out_cpp[rr,cc] =", out_cpp[rr,cc])) - - expect_gte(out_r[rr,cc], 0) # >=0 - expect_gte(out_cpp[rr,cc], 0) # >=0 - - if (out_r[rr,cc] > 0) { - - res = expect_equal( - out_cpp[rr,cc], - out_r[rr,cc], - tolerance = 0.0001, - scale = out_r[rr,cc] - ) - - if(abs(out_cpp[rr,cc]-out_r[rr,cc])>out_r[rr,cc]*0.0001){ - print(paste( - "not equal: rr=", rr, - ", cc=", cc, - ", pp=", pp, - ", out_r[rr,cc]", out_r[rr,cc], - ", out_cpp[rr,cc]", out_cpp[rr,cc] - )) - } - - } - } + match_outputs( + output_a = out_r, + output_b = out_cpp, + tlr = 0.0001, + smp = 1000 + ) } } diff --git a/comoOdeCpp/tests/testthat/test-sensitivity.R b/comoOdeCpp/tests/testthat/test-sensitivity.R new file mode 100644 index 0000000..58e18a7 --- /dev/null +++ b/comoOdeCpp/tests/testthat/test-sensitivity.R @@ -0,0 +1,130 @@ +test_that("Sensitivity", { + # skip("temp skip") + rm(list = ls()) + source(paste0(getwd(), "/common.R"), local = environment()) + init(e = environment()) + + VERBOSE <- FALSE + + file_path <- paste0(getwd(), "/data/templates_v16.2/Template_CoMoCOVID-19App_sa.xlsx") + + if (!exists("inputs", mode = "function")) { + source(paste0(getwd(), CORE_FILE), local = environment()) + } + + check_parameters_list_for_na(parameters) + + parameters["p"] <- 0.05 + + covidOdeCpp_reset() + output_message <- capture_output( + out_hype <- ode( + y = Y, times = times, method = "euler", hini = 0.05, + func = covidOdeCpp, parms = parameters, + input = vectors, A = A, + contact_home = contact_home, + contact_school = contact_school, + contact_work = contact_work, + contact_other = contact_other, + popbirth_col2 = popbirth[, 2], + popstruc_col2 = popstruc[, 2], + ageing = ageing, + ifr_col2 = ifr[, 2], + ihr_col2 = ihr[, 2], + mort_col = mort + ) + ) + processed_hype_results <- process_ode_outcome_mortality(out_hype, vectors, parameters) + + sa_parameters <- c( + "selfis_eff", + "dist_eff", + "hand_eff", + "mask_eff", + "work_eff", + + # "school_eff", + "cocoon_eff", + # "travelban_eff", + "vaccine_eff" + ) + sa_multipliers <- c( + 0.1, + 0.1, + 0.1, + 0.1, + 0.1, + + # 0.1, + 0.1, + # 0.1, + 0.1 + ) + sa_expect_mort_inc <- c( + TRUE, + TRUE, + TRUE, + TRUE, + TRUE, + + # TRUE, + TRUE, + # TRUE, + TRUE + ) + + for (pp_name in sa_parameters) { + + parameters_mod <- parameters + parameters_mod[pp_name] <- parameters_mod[pp_name] * sa_multipliers[match(pp_name, sa_parameters)] + + if (VERBOSE) { + print(pp_name) + print(parameters[pp_name]) + print(parameters_mod[pp_name]) + } + + covidOdeCpp_reset() + output_message <- capture_output( + out_hype_mod <- ode( + y = Y, times = times, method = "euler", hini = 0.05, + func = covidOdeCpp, parms = parameters_mod, + input = vectors, A = A, + contact_home = contact_home, + contact_school = contact_school, + contact_work = contact_work, + contact_other = contact_other, + popbirth_col2 = popbirth[, 2], + popstruc_col2 = popstruc[, 2], + ageing = ageing, + ifr_col2 = ifr[, 2], + ihr_col2 = ihr[, 2], + mort_col = mort + ) + ) + + processed_hype_mod_results <- process_ode_outcome_mortality(out_hype_mod, vectors, parameters_mod) + + if (VERBOSE) { + print("processed_hype_results$total_cm_deaths_end:") + print(processed_hype_results$total_cm_deaths_end) + print("processed_hype_mod_results$total_cm_deaths_end:") + print(processed_hype_mod_results$total_cm_deaths_end) + } + + if (sa_expect_mort_inc[match(pp_name, sa_parameters)]) { + expect_gt( + processed_hype_mod_results$total_cm_deaths_end, + processed_hype_results$total_cm_deaths_end + ) + } else { + expect_gt( + processed_hype_mod_results$total_cm_deaths_end, + processed_hype_results$total_cm_deaths_end + ) + } + + } + + + }) \ No newline at end of file diff --git a/comoOdeCpp/tests/testthat/v16.2.core.R b/comoOdeCpp/tests/testthat/v16.2.core.R index c66c931..4231f42 100644 --- a/comoOdeCpp/tests/testthat/v16.2.core.R +++ b/comoOdeCpp/tests/testthat/v16.2.core.R @@ -487,6 +487,7 @@ initS<-popstruc[,2]-initE-initI-initCL-initR-initX-initZ-initV-initH-initHC-init inp <- read_excel(file_path, sheet = "Interventions") inputs<-function(inp, run){ # cap intervention end dates with simulation end date + inp$`Date Start` = pmin(stopdate, as.Date(inp$`Date Start`)) inp$`Date End` = pmin(stopdate, as.Date(inp$`Date End`)) tv<-which(inp$`Apply to`==run) @@ -1658,9 +1659,9 @@ process_ode_outcome_mortality <- function(out_mean, intv_vector, param_used, pri cinc_mort_10 <- cumsum(rowSums(param_used["nu_ventc"]*param_used["pdeath_ventc"]*dexvc_hist*(out_mean[,(VentCindex+1)]%*%ifr[,2]))) cinc_mort_11 <- cumsum(rowSums(param_used["nu_ventc"]*param_used["pdeath_ventc"]*dexvc_hist*(out_mean[,(ICUCVindex+1)]%*%ifr[,2]))) - cinc_mort_14 <- cumsum(rowSums(param_used["nu_ventc"]*parameters["report_death_HC"]*param_used["pdeath_vent_hc"]*(out_mean[,(HCVindex+1)]%*%ifr[,2]))) - cinc_mort_12 <- cumsum(rowSums(param_used["nu_icuc"] *parameters["report_death_HC"]*param_used["propo2"]*param_used["pdeath_icu_hco"]*(out_mean[,(HCICUindex+1)]%*%ifr[,2]))) - cinc_mort_13 <- cumsum(rowSums(param_used["nu_icuc"] *parameters["report_death_HC"]*(1-param_used["propo2"])*param_used["pdeath_icu_hc"]*(out_mean[,(HCICUindex+1)]%*%ifr[,2]))) + cinc_mort_14 <- cumsum(rowSums(param_used["nu_ventc"]*param_used["report_death_HC"]*param_used["pdeath_vent_hc"]*(out_mean[,(HCVindex+1)]%*%ifr[,2]))) + cinc_mort_12 <- cumsum(rowSums(param_used["nu_icuc"] *param_used["report_death_HC"]*param_used["propo2"]*param_used["pdeath_icu_hco"]*(out_mean[,(HCICUindex+1)]%*%ifr[,2]))) + cinc_mort_13 <- cumsum(rowSums(param_used["nu_icuc"] *param_used["report_death_HC"]*(1-param_used["propo2"])*param_used["pdeath_icu_hc"]*(out_mean[,(HCICUindex+1)]%*%ifr[,2]))) cinc_mort_H1 <- cinc_mort_1 + cinc_mort_2 cinc_mort_HC1 <- cinc_mort_3 + cinc_mort_4 + cinc_mort_12 + cinc_mort_13 + cinc_mort_14 diff --git a/comoOdeCpp/tests/testthat/v16.2.core.input_mod.R b/comoOdeCpp/tests/testthat/v16.2.core.input_mod.R new file mode 100644 index 0000000..080dd61 --- /dev/null +++ b/comoOdeCpp/tests/testthat/v16.2.core.input_mod.R @@ -0,0 +1,2193 @@ +# require("deSolve") +# library("ggplot2") +# library("dplyr") +# library("reshape2") +# require(gridExtra) +# library(ggpubr) +# library(bsplus) +# library(deSolve) +# library(DT) +# library(highcharter) +# library(lubridate) +# library(pushbar) +# library(readxl) +# library(reshape2) +# library(scales) +# library(shiny) +# library(shinyBS) +# library(shinycssloaders) +# library(shinyhelper) +# library(shinythemes) +# library(shinyWidgets) +# library(tidyverse) +# library(XLConnect) +# # library("comoOdeCpp") + +# #read data from excel file +# setwd("C:/covid19/covid_age") +# load("data_CoMo.RData") +# file_path <- paste0(getwd(),"/Template_CoMoCOVID-19App_new.xlsx") +country_name<-"United Kingdom of Great Britain" +# fit_mat <- read.table("fit_mat.txt",header = T) + + +# Cases +dta <- read_excel(file_path, sheet = "Cases") +names(dta) <- c("date", "cases", "deaths") + +cases_rv <- dta %>% + mutate(date = as.Date(date), cumulative_death = cumsum(deaths)) %>% + as.data.frame() + +# Severity/Mortality +dta <- read_excel(file_path, sheet = "Severity-Mortality") +names(dta) <- c("age_category", "ifr", "ihr") + +mort_sever_rv <- dta %>% + mutate(ihr = ihr/100) %>% # starting unit should be % - scaling to a value between 0 and 1 + mutate(ifr = ifr/max(ifr)) # scaling to a value between 0 and 1 + +# Population +dta <- read_excel(file_path, sheet = "Population") +names(dta) <- c("age_category", "pop", "birth", "death") + +population_rv <- dta %>% + transmute(country = NA, age_category, pop, birth, death) + +# Parameters +param <- bind_rows(read_excel(file_path, sheet = "Parameters"), + read_excel(file_path, sheet = "Country Area Param"), + read_excel(file_path, sheet = "Virus Param"), + read_excel(file_path, sheet = "Hospitalisation Param"), + read_excel(file_path, sheet = "Interventions Param"), + read_excel(file_path, sheet = "Interventions")) %>% + mutate(Value_Date = as.Date(Value_Date)) + +# START Bridge ---- +popstruc <- population_rv %>% + select(age_category, pop) %>% + rename(agefloor = age_category) %>% + as.data.frame() + +popbirth <- population_rv %>% + select(age_category, birth) %>% + as.data.frame() # unit should be per person per day + +mort <- population_rv %>% + pull(death) # unit should be per person per day + +ihr <- mort_sever_rv %>% + select(age_category, ihr) %>% + as.data.frame() + +ifr <- mort_sever_rv %>% + select(age_category, ifr) %>% + as.data.frame() + + +######### POP AGEING +# per year ageing matrix +A<-length(popstruc[,2]) +dd<-seq(1:A)/seq(1:A) +ageing <- t(diff(diag(dd),lag=1)/(5*365.25)) +ageing<-cbind(ageing,0*seq(1:A)) # no ageing from last compartment + +# +# pop<-population$country==country_name +# pp<-population$pop[pop] +### CONTACT MATRICES +c_home <- contact_home[[country_name]] %>% as.matrix() +c_school <- contact_school[[country_name]] %>% as.matrix() +c_work <- contact_work[[country_name]] %>% as.matrix() +c_other <- contact_other[[country_name]] %>% as.matrix() +nce <-A-length(c_home[1,]) + +contact_home<-matrix(0,nrow=A,ncol=A) +contact_school<-matrix(0,nrow=A,ncol=A) +contact_work<-matrix(0,nrow=A,ncol=A) +contact_other<-matrix(0,nrow=A,ncol=A) + +for (i in 1:(A-nce)){ + for (j in 1:(A-nce)){ + contact_home[i,j]<-c_home[i,j] + contact_school[i,j]<-c_school[i,j] + contact_work[i,j]<-c_work[i,j] + contact_other[i,j]<-c_other[i,j] + } +} + +for (i in (A+1-nce):A){ + for (j in 1:(A-nce)){ + contact_home[i,j]<-c_home[(A-nce),j] + contact_school[i,j]<-c_school[(A-nce),j] + contact_work[i,j]<-c_work[(A-nce),j] + contact_other[i,j]<-c_other[(A-nce),j] + } +} +for (i in 1:(A-nce)){ + for (j in (A+1-nce):A){ + contact_home[i,j]<-c_home[i,(A-nce)] + contact_school[i,j]<-c_school[i,(A-nce)] + contact_work[i,j]<-c_work[i,(A-nce)] + contact_other[i,j]<-c_other[i,(A-nce)] + } +} +for (i in (A+1-nce):A){ + for (j in (A+1-nce):A){ + contact_home[i,j]<-c_home[(A-nce),(A-nce)] + contact_school[i,j]<-c_school[(A-nce),(A-nce)] + contact_work[i,j]<-c_work[(A-nce),(A-nce)] + contact_other[i,j]<-c_other[(A-nce),(A-nce)] + } +} + + + +######### INITIALISE SIMULATION/INTERVENTION START TIMES +startdate <- param$Value_Date[param$Parameter == "date_range_simul_start"] +stopdate <- param$Value_Date[param$Parameter == "date_range_simul_end"] +startdate <- startdate[1] +stopdate <- stopdate[1] + + +day_start <- as.numeric(startdate-startdate) +day_stop <- as.numeric(stopdate-startdate) +times <- seq(day_start, day_stop) + +tin<-as.numeric(startdate-as.Date("2020-01-01"))/365.25 +initP<-sum(popstruc[,2]) # population size +ageindcase<-20 # age of index case (years) +aci <- floor((ageindcase/5)+1) # age class of index case + + +############# DEFINE PARAMETERS +parameters <- c( + + ### Transmission instrinsic + p = param$Value[param$Parameter=="p"][1], + rho = param$Value[param$Parameter=="rho"][1], + omega = param$Value[param$Parameter=="omega"][1], + gamma = param$Value[param$Parameter=="gamma"][1], + nui = param$Value[param$Parameter=="nui"][1], + report = param$Value[param$Parameter=="report"][1], + reportc = param$Value[param$Parameter=="reportc"][1], + reporth = param$Value[param$Parameter=="reporth"][1], + beds_available = param$Value[param$Parameter=="beds_available"][1], + icu_beds_available = param$Value[param$Parameter=="icu_beds_available"][1], + ventilators_available = param$Value[param$Parameter=="ventilators_available"][1], + give = 95, + pdeath_h = mean( param$Value[param$Parameter=="pdeath_h"],na.rm=T), + pdeath_ho = mean( param$Value[param$Parameter=="pdeath_ho"],na.rm=T), + pdeath_hc = mean( param$Value[param$Parameter=="pdeath_hc"],na.rm=T), + pdeath_hco = mean( param$Value[param$Parameter=="pdeath_hco"],na.rm=T), + pdeath_icu = mean( param$Value[param$Parameter=="pdeath_icu"],na.rm=T), + pdeath_icuo = mean( param$Value[param$Parameter=="pdeath_icuo"],na.rm=T), + pdeath_icuc = mean( param$Value[param$Parameter=="pdeath_icuc"],na.rm=T), + pdeath_icuco = mean( param$Value[param$Parameter=="pdeath_icuco"],na.rm=T), + pdeath_vent = mean( param$Value[param$Parameter=="pdeath_vent"],na.rm=T), + pdeath_ventc = mean( param$Value[param$Parameter=="pdeath_ventc"],na.rm=T), + ihr_scaling = param$Value[param$Parameter=="ihr_scaling"][1], + nus = param$Value[param$Parameter=="nus"][1], + nusc = param$Value[param$Parameter=="nus"][1], # nusc = nus + nu_icu = param$Value[param$Parameter=="nu_icu"][1], + nu_icuc = param$Value[param$Parameter=="nu_icu"][1], # nu_icuc = nu_icu + nu_vent = param$Value[param$Parameter=="nu_vent"][1], + nu_ventc = param$Value[param$Parameter=="nu_vent"][1], # nu_ventc = nu_vent + rhos = param$Value[param$Parameter=="rhos"][1], + amp = param$Value[param$Parameter=="amp"][1], + phi = param$Value[param$Parameter=="phi"][1], + pclin = param$Value[param$Parameter=="pclin"][1], + prob_icu = param$Value[param$Parameter=="prob_icu"][1], + prob_vent = param$Value[param$Parameter=="prob_vent"][1], + propo2 = param$Value[param$Parameter=="propo2"][1], + dexo2 = mean( param$Value[param$Parameter=="dexo2"],na.rm=T), + dexo2c = mean( param$Value[param$Parameter=="dexo2c"],na.rm=T), + dexv = mean( param$Value[param$Parameter=="dexvc"],na.rm=T), + dexvc = mean( param$Value[param$Parameter=="dexvc"],na.rm=T), + vent_dex = mean(param$Value[param$Parameter=="vent_dex"],na.rm=T), + prob_icu_v = mean(param$Value[param$Parameter=="prob_icu_v"],na.rm=T), + prob_icu_vr = mean(param$Value[param$Parameter=="prob_icu_vr"],na.rm=T), + prob_icu_r = mean(param$Value[param$Parameter=="prob_icu_r"],na.rm=T), + prob_v_v = mean(param$Value[param$Parameter=="prob_v_v"],na.rm=T), + prob_v_vr = mean(param$Value[param$Parameter=="prob_v_vr"],na.rm=T), + prob_v_r = mean(param$Value[param$Parameter=="prob_v_r"],na.rm=T), + pclin_v = mean(param$Value[param$Parameter=="pclin_v"],na.rm=T), + pclin_vr = mean(param$Value[param$Parameter=="pclin_vr"],na.rm=T), + pclin_r = mean(param$Value[param$Parameter=="pclin_r"],na.rm=T), + sigmaEV = mean(param$Value[param$Parameter=="sigmaEV"],na.rm=T), + sigmaEVR = mean(param$Value[param$Parameter=="sigmaEVR"],na.rm=T), + sigmaER = mean(param$Value[param$Parameter=="sigmaER"],na.rm=T), + sigmaR = mean(param$Value[param$Parameter=="sigmaR"],na.rm=T), + vac_dur = mean(param$Value[param$Parameter=="vac_dur"],na.rm=T), + vac_dur_r = mean(param$Value[param$Parameter=="vac_dur_r"],na.rm=T), + report_natdeathI = mean(param$Value[param$Parameter=="report_natdeathI"],na.rm=T), + report_natdeathCL = mean(param$Value[param$Parameter=="report_natdeathCL"],na.rm=T), + pre = mean(param$Value[param$Parameter=="pre"],na.rm=T), + report_v = param$Value[param$Parameter=="report_v"][1], + report_cv = param$Value[param$Parameter=="report_cv"][1], + report_vr = param$Value[param$Parameter=="report_vr"][1], + report_cvr = param$Value[param$Parameter=="report_cvr"][1], + report_r = param$Value[param$Parameter=="report_r"][1], + report_cr = param$Value[param$Parameter=="report_cr"][1], + reporth_ICU = param$Value[param$Parameter=="reporth_ICU"][1], + report_death_HC = param$Value[param$Parameter=="report_death_HC"][1], + pdeath_vent_hc = mean( param$Value[param$Parameter=="pdeath_vent_hc"],na.rm=T), + pdeath_icu_hc = mean( param$Value[param$Parameter=="pdeath_icu_hc"],na.rm=T), + pdeath_icu_hco = mean( param$Value[param$Parameter=="pdeath_icu_hco"],na.rm=T), + reporth_g = param$Value[param$Parameter=="reporth_g"][1], + seroneg = param$Value[param$Parameter=="seroneg"][1], + + ### INTERVENTIONS + # self isolation + selfis_eff = mean(param$Value[param$Parameter=="selfis_eff"],na.rm=T), + # social distancing + dist_eff = mean(param$Value[param$Parameter=="dist_eff"],na.rm=T), + # hand washing + hand_eff = mean(param$Value[param$Parameter=="hand_eff"],na.rm=T), + # mask wearing + mask_eff = mean(param$Value[param$Parameter=="mask_eff"],na.rm=T), + # working at home + work_eff = mean(param$Value[param$Parameter=="work_eff"],na.rm=T), + w2h = mean(param$Value[param$Parameter=="w2h"],na.rm=T), + # school closures + school_eff = mean(param$Value[param$Parameter=="school_eff"],na.rm=T), + s2h = mean(param$Value[param$Parameter=="s2h"],na.rm=T), + # cocooning the elderly + cocoon_eff = mean(param$Value[param$Parameter=="cocoon_eff"],na.rm=T), + age_cocoon = mean(param$Value[param$Parameter=="age_cocoon"],na.rm=T), + # vaccination campaign + # vaccine_on = as.numeric(param$Value_Date[param$Parameter=="date_vaccine_on"] - startdate), + vaccine_eff = mean(param$Value[param$Parameter=="vaccine_eff"],na.rm=T), + vaccine_eff_r = mean(param$Value[param$Parameter=="vaccine_eff_r"],na.rm=T), + age_vaccine_min = mean(param$Value[param$Parameter=="age_vaccine_min"],na.rm=T), + age_vaccine_max = mean(param$Value[param$Parameter=="age_vaccine_max"],na.rm=T), + # vaccine_cov = param$Value[param$Parameter=="vaccine_cov"], + vac_campaign = mean(param$Value[param$Parameter=="vac_campaign"],na.rm=T), + # travel ban + mean_imports = mean(param$Value[param$Parameter=="mean_imports"],na.rm=T), + # screening + screen_test_sens = mean(param$Value[param$Parameter=="screen_test_sens"],na.rm=T), + # screen_contacts = mean(param$Value[param$Parameter=="screen_contacts"],na.rm=T), + screen_overdispersion = mean(param$Value[param$Parameter=="screen_overdispersion"],na.rm=T), + # voluntary home quarantine + quarantine_days = mean(param$Value[param$Parameter=="quarantine_days"],na.rm=T), + quarantine_effort = mean(param$Value[param$Parameter=="quarantine_effort"],na.rm=T), + quarantine_eff_home = mean(param$Value[param$Parameter=="quarantine_eff_home"],na.rm=T), + quarantine_eff_other = mean(param$Value[param$Parameter=="quarantine_eff_other"],na.rm=T), + # mass testing + age_testing_min = mean(param$Value[param$Parameter=="age_testing_min"],na.rm=T), + age_testing_max = mean(param$Value[param$Parameter=="age_testing_max"],na.rm=T), + mass_test_sens = mean(param$Value[param$Parameter=="mass_test_sens"],na.rm=T), + isolation_days = mean(param$Value[param$Parameter=="isolation_days"],na.rm=T), + + ### Initialisation + init = param$Value[param$Parameter=="init"][1], + + ### Others + household_size = param$Value[param$Parameter=="household_size"][1], + noise = param$Value[param$Parameter=="noise"][1], + iterations = param$Value[param$Parameter=="iterations"][1], + confidence = param$Value[param$Parameter=="confidence"][1] +) +ihr[,2]<- parameters["ihr_scaling"]*ihr[,2] +parameters["ifr_correction_young"]<-1 +parameters["ifr_correction_old"]<-1 +# ifr[1:12,2]<-ifr[1:12,2]/ifr_correction_young +# ihr$ihr[15:21]<-ihr$ihr[15:21]*ifr_correction_old + +ifr[1:12,2]<-ifr[1:12,2]/parameters["ifr_correction_young"] +ihr$ihr[15:21]<-ihr$ihr[15:21]*parameters["ifr_correction_old"] + +# Scale parameters to percentages/ rates +parameters["rho"]<-parameters["rho"]/100 +parameters["omega"]<-(1/(parameters["omega"]*365)) +parameters["gamma"]<-1/parameters["gamma"] +parameters["nui"]<-1/parameters["nui"] +parameters["report"]<-parameters["report"]/100 +parameters["reportc"]<-parameters["reportc"]/100 +parameters["report_v"]<-parameters["report_v"]/100 +parameters["report_cv"]<-parameters["report_cv"]/100 +parameters["report_vr"]<-parameters["report_vr"]/100 +parameters["report_cvr"]<-parameters["report_cvr"]/100 +parameters["report_r"]<-parameters["report_r"]/100 +parameters["report_cr"]<-parameters["report_cr"]/100 +parameters["reporth"]<-parameters["reporth"]/100 +parameters["nus"]<-1/parameters["nus"] +parameters["rhos"]<-parameters["rhos"]/100 +parameters["amp"]<-parameters["amp"]/100 +parameters["selfis_eff"]<-parameters["selfis_eff"]/100 +parameters["dist_eff"]<-parameters["dist_eff"]/100 +parameters["hand_eff"]<-parameters["hand_eff"]/100 +parameters["mask_eff"]<-parameters["mask_eff"]/100 +parameters["work_eff"]<-parameters["work_eff"]/100 +parameters["w2h"]<-parameters["w2h"]/100 +parameters["school_eff"]<-parameters["school_eff"]/100 +parameters["s2h"]<-parameters["s2h"]/100 +parameters["cocoon_eff"]<-parameters["cocoon_eff"]/100 +parameters["age_cocoon"]<-floor((parameters["age_cocoon"]/5)+1) +parameters["vaccine_eff"]<-parameters["vaccine_eff"]/100 +parameters["vaccine_eff_r"]<-parameters["vaccine_eff_r"]/100 +age_vaccine_min<-(parameters["age_vaccine_min"]) +age_vaccine_max<-(parameters["age_vaccine_max"]) +# parameters["vaccine_cov"]<-parameters["vaccine_cov"]/100 +# parameters["vac_campaign"]<-parameters["vac_campaign"]*7 +parameters["screen_test_sens"]<-parameters["screen_test_sens"]/100 +parameters["quarantine_days"]<-parameters["quarantine_days"] +parameters["quarantine_effort"]<-1/parameters["quarantine_effort"] +parameters["quarantine_eff_home"]<-parameters["quarantine_eff_home"]/-100 +parameters["quarantine_eff_other"]<-parameters["quarantine_eff_other"]/100 +parameters["give"]<-parameters["give"]/100 +parameters["pdeath_h"]<-parameters["pdeath_h"]/100 +parameters["pdeath_ho"]<-parameters["pdeath_ho"]/100 +parameters["pdeath_hc"]<-parameters["pdeath_hc"]/100 +parameters["pdeath_hco"]<-parameters["pdeath_hco"]/100 +parameters["pdeath_icu"]<-parameters["pdeath_icu"]/100 +parameters["pdeath_icuo"]<-parameters["pdeath_icuo"]/100 +parameters["pdeath_icuc"]<-parameters["pdeath_icuc"]/100 +parameters["pdeath_icuco"]<-parameters["pdeath_icuco"]/100 +parameters["pdeath_vent"]<-parameters["pdeath_vent"]/100 +parameters["pdeath_ventc"]<-parameters["pdeath_ventc"]/100 +parameters["nusc"]<-1/parameters["nusc"] +parameters["nu_icu"]<-1/parameters["nu_icu"] +parameters["nu_icuc"]<-1/parameters["nu_icuc"] +parameters["nu_vent"]<-1/parameters["nu_vent"] +parameters["nu_ventc"]<-1/parameters["nu_ventc"] +parameters["pclin"]<-parameters["pclin"]/100 +parameters["prob_icu"]<-parameters["prob_icu"]/100 +parameters["prob_vent"]<-parameters["prob_vent"]/100 +iterations<-parameters["iterations"] +noise<-parameters["noise"] +confidence<-parameters["confidence"]/100 +parameters["mass_test_sens"]<-parameters["mass_test_sens"]/100 +age_testing_min<-(parameters["age_testing_min"]) +age_testing_max<-(parameters["age_testing_max"]) +parameters["isolation_days"]<-parameters["isolation_days"] +parameters["propo2"]<-parameters["propo2"]/100 +parameters["dexo2"]<-parameters["dexo2"]/100 +parameters["dexo2c"]<-parameters["dexo2c"]/100 +parameters["dexv"]<-parameters["dexv"]/100 +parameters["dexvc"]<-parameters["dexvc"]/100 +parameters["vent_dex"]<-parameters["vent_dex"]/100 +parameters["prob_icu_v"]<-parameters["prob_icu_v"]/100 +parameters["prob_icu_vr"]<-parameters["prob_icu_vr"]/100 +parameters["prob_icu_r"]<-parameters["prob_icu_r"]/100 +parameters["prob_v_v"]<-parameters["prob_v_v"]/100 +parameters["prob_v_r"]<-parameters["prob_v_r"]/100 +parameters["prob_v_vr"]<-parameters["prob_v_vr"]/100 +parameters["pclin_v"]<-parameters["pclin_v"]/100 +parameters["pclin_vr"]<-parameters["pclin_vr"]/100 +parameters["pclin_r"]<-parameters["pclin_r"]/100 +parameters["sigmaEV"]<-parameters["sigmaEV"]/100 +parameters["sigmaER"]<-parameters["sigmaER"]/100 +parameters["sigmaEVR"]<-parameters["sigmaEVR"]/100 +parameters["sigmaR"]<-parameters["sigmaR"]/100 +parameters["vac_dur"]<-1/parameters["vac_dur"]/100 +parameters["vac_dur_r"]<-1/parameters["vac_dur_r"]/100 +parameters["report_natdeathI"]<-parameters["report_natdeathI"]/100 +parameters["report_natdeathCL"]<-parameters["report_natdeathCL"]/100 +parameters["report_death_HC"]<-parameters["report_death_HC"]/100 +parameters["reporth_ICU"]<-parameters["reporth_ICU"]/100 +parameters["pre"]<-parameters["pre"]/100 +parameters["pdeath_vent_hc"]<-parameters["pdeath_vent_hc"]/100 +parameters["pdeath_icu_hc"]<-parameters["pdeath_icu_hc"]/100 +parameters["pdeath_icu_hco"]<-parameters["pdeath_icu_hco"]/100 +parameters["reporth_g"]<-parameters["reporth_g"]/100 +parameters["seroneg"]<-(1/parameters["seroneg"]) + + +parameters_noise <- c("p", "rho", "omega", "gamma", "nui", "ihr_scaling","nus", "nu_icu","nu_vent", + "rhos", "selfis_eff", "dist_eff", "hand_eff", "mask_eff", "work_eff", + "w2h", "school_eff", "s2h", "cocoon_eff", "mean_imports", "screen_overdispersion", + "quarantine_effort", "quarantine_eff_home", "quarantine_eff_other") + +# parameters_fit <- c("p", "ihr_scaling","ifr_correction_young","ifr_correction_old","init") +# parameters_fit <- rownames(fit_mat) +########################################################################### +# Define the indices for each variable +Sindex<-1:A +Eindex<-(A+1):(2*A) +Iindex<-(2*A+1):(3*A) +Rindex<-(3*A+1):(4*A) +Xindex<-(4*A+1):(5*A) +Hindex<-(5*A+1):(6*A) +HCindex<-(6*A+1):(7*A) +Cindex<-(7*A+1):(8*A) +CMindex<-(8*A+1):(9*A) +Vindex<-(9*A+1):(10*A) +QSindex<-(10*A+1):(11*A) +QEindex<-(11*A+1):(12*A) +QIindex<-(12*A+1):(13*A) +QRindex<-(13*A+1):(14*A) +CLindex<-(14*A+1):(15*A) +QCindex<-(15*A+1):(16*A) +ICUindex<-(16*A+1):(17*A) +ICUCindex<-(17*A+1):(18*A) +ICUCVindex<-(18*A+1):(19*A) +Ventindex<-(19*A+1):(20*A) +VentCindex<-(20*A+1):(21*A) +CMCindex<-(21*A+1):(22*A) +Zindex<-(22*A+1):(23*A) +EVindex<-(23*A+1):(24*A) +ERindex<-(24*A+1):(25*A) +EVRindex<-(25*A+1):(26*A) +VRindex<-(26*A+1):(27*A) +QVindex<-(27*A+1):(28*A) +QEVindex<-(28*A+1):(29*A) +QEVRindex<-(29*A+1):(30*A) +QERindex<-(30*A+1):(31*A) +QVRindex<-(31*A+1):(32*A) +HCICUindex<-(32*A+1):(33*A) +HCVindex<-(33*A+1):(34*A) +Abindex<-(34*A+1):(35*A) + +########################################################################### +# MODEL INITIAL CONDITIONS +initI<-0*popstruc[,2] # Infected and symptomatic +initE<-0*popstruc[,2] # Incubating +# initE[aci]<-1 # place random index case in E compartment +initE[aci]<-round(sum(popstruc[,2])/parameters["init"]) # place random index case in E compartment +initR<-parameters["pre"]*popstruc[,2] # Immune +initX<-0*popstruc[,2] # Isolated +initV<-0*popstruc[,2] # Vaccinated +initQS<-0*popstruc[,2] # quarantined S +initQE<-0*popstruc[,2] # quarantined E +initQI<-0*popstruc[,2] # quarantined I +initQR<-0*popstruc[,2] # quarantined R +initH<-0*popstruc[,2] # hospitalised +initHC<-0*popstruc[,2] # hospital critical +initC<-0*popstruc[,2] # Cumulative cases (true) +initCM<-0*popstruc[,2] # Cumulative deaths (true) +initCL<-0*popstruc[,2] # symptomatic cases +initQC<-0*popstruc[,2] # quarantined C +initICU<-0*popstruc[,2] # icu +initICUC<-0*popstruc[,2] # icu critical +initICUCV<-0*popstruc[,2] # icu critical +initVent<-0*popstruc[,2] # icu vent +initVentC<-0*popstruc[,2] # icu vent crit +initCMC<-0*popstruc[,2] # Cumulative deaths - overload (true) +initZ<-0*popstruc[,2] # testing - quarantined (true) +initEV<-0*popstruc[,2] # vaccinated exposed +initER<-0*popstruc[,2] # recovered exposed +initEVR<-0*popstruc[,2] # recovered and vaccinated exposed +initVR<-0*popstruc[,2] # recovered and vaccinated +initQV<-0*popstruc[,2] # quarantined and vaccinated +initQEV<-0*popstruc[,2] # quarantined, exposed and vaccinated +initQEVR<-0*popstruc[,2] # quarantined, exposed, recovered and vaccinated +initQER<-0*popstruc[,2] # quarantined, exposed and recovered +initQVR<-0*popstruc[,2] # quarantined, recovered and vaccinated +initHCICU<-0*popstruc[,2] # icu not seeking +initHCV<-0*popstruc[,2] # ventilator not seeking +initAb<-0*popstruc[,2] # ventilator not seeking + +initS<-popstruc[,2]-initE-initI-initCL-initR-initX-initZ-initV-initH-initHC-initICU-initICUC-initICUCV-initVent-initVentC- + initQS-initQE-initQI-initQR-initQC-initEV-initER-initEVR-initVR-initQV-initQEV-initQEVR-initQER-initQVR- + initHCICU-initHCV # Susceptible (non-immune) + + +inp <- read_excel(file_path, sheet = "Interventions") +inputs<-function(inp, run){ + + # cap intervention start and end dates with simulation end date + # inp$`Date Start` = pmin(stopdate, inp$`Date Start`) + # inp$`Date End` = pmin(stopdate, inp$`Date End`) + + inp[["Date Start"]] = pmin(stopdate, as.Date(inp[["Date Start"]])) + inp[["Date End"]] = pmin(stopdate, as.Date(inp[["Date End"]])) + + inp <- inp %>% arrange(`Date Start`) + + tv<-which(inp$`Apply to`==run) + + si<-intersect(which(inp$Intervention=="Self-isolation if Symptomatic"),tv) + scr<-intersect(which(inp$Intervention=="(*Self-isolation) Screening"),tv) + sd<-intersect(which(inp$Intervention=="Social Distancing"),tv) + hw<-intersect(which(inp$Intervention=="Handwashing"),tv) + msk<-intersect(which(inp$Intervention=="Mask Wearing"),tv) + wah<-intersect(which(inp$Intervention=="Working at Home"),tv) + sc<-intersect(which(inp$Intervention=="School Closures"),tv) + cte<-intersect(which(inp$Intervention=="Shielding the Elderly"),tv) + q<-intersect(which(inp$Intervention=="(*Self-isolation) Household Isolation"),tv) + tb<-intersect(which(inp$Intervention=="International Travel Ban"),tv) + mt<-intersect(which(inp$Intervention=="Mass Testing"),tv) + minas<-intersect(which(inp$Intervention=="(*Mass Testing) Age Testing Minimum"),tv) + maxas<-intersect(which(inp$Intervention=="(*Mass Testing) Age Testing Maximum"),tv) + vc<-intersect(which(inp$Intervention=="Vaccination"),tv) + minav<-intersect(which(inp$Intervention=="(*Vaccination) Age Vaccine Minimum"),tv) + maxav<-intersect(which(inp$Intervention=="(*Vaccination) Age Vaccine Maximum"),tv) + dx<-intersect(which(inp$Intervention=="Dexamethasone"),tv) + + v<-(format(as.POSIXct(inp$`Date Start`,format='%Y/%m/%d %H:%M:%S'),format="%d/%m/%y")) + v2<-as.Date(v,format="%d/%m/%y") + inp$`Date Start`<-v2 + + v<-(format(as.POSIXct(inp$`Date End`,format='%Y/%m/%d %H:%M:%S'),format="%d/%m/%y")) + v2<-as.Date(v,format="%d/%m/%y") + inp$`Date End`<-v2 + + ## self isolation + f<-c() + si_vector<-c() + isolation<-c() + if (length(si)>=1){ + for (i in 1:length(si)){ + f<-c(f,as.numeric(inp$`Date Start`[si[i]]-startdate),as.numeric(inp$`Date End`[si[i]]-startdate)) + + if(i==1){ + if (inp$`Date Start`[si[i]]>startdate){ + si_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[si[i]],(f[i+1]-f[i])*20)) + isolation<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) + } + else{ + si_vector<-c(rep(inp$`Value`[si[i]],(f[i+1])*20)) + isolation<-c(rep(1,(f[i+1])*20)) + } + } + else{ + if (f[(i-1)*2+1]-f[(i-1)*2]==1){ + si_vector<-c(si_vector,rep(inp$`Value`[si[i]],20)) + isolation<-c(isolation,rep(1,20)) + }else{ + si_vector<-c(si_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) + isolation<-c(isolation,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) + } + si_vector<-c(si_vector,rep(inp$`Value`[si[i]],(f[i*2]-f[i*2-1])*20)) + isolation<-c(isolation,rep(1,(f[i*2]-f[i*2-1])*20)) + } + if(i==length(si) && f[i*2]=1){ + for (i in 1:length(sd)){ + + f<-c(f,as.numeric(inp$`Date Start`[sd[i]]-startdate),as.numeric(inp$`Date End`[sd[i]]-startdate)) + + if(i==1){ + if (inp$`Date Start`[sd[i]]>startdate){ + sd_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[sd[i]],(f[i+1]-f[i])*20)) + distancing<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) + } + else{ + sd_vector<-c(rep(inp$`Value`[sd[i]],(f[i+1])*20)) + distancing<-c(rep(1,(f[i+1])*20)) + } + } + else{ + if (f[(i-1)*2+1]-f[(i-1)*2]==1){ + sd_vector<-c(sd_vector,rep(inp$`Value`[sd[i]],20)) + distancing<-c(distancing,rep(1,20)) + }else{ + sd_vector<-c(sd_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) + distancing<-c(distancing,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) + } + sd_vector<-c(sd_vector,rep(inp$`Value`[sd[i]],(f[i*2]-f[i*2-1])*20)) + distancing<-c(distancing,rep(1,(f[i*2]-f[i*2-1])*20)) + } + if(i==length(sd)&& f[i*2]=1){ + for (i in 1:length(scr)){ + + f<-c(f,as.numeric(inp$`Date Start`[scr[i]]-startdate),as.numeric(inp$`Date End`[scr[i]]-startdate)) + + if(i==1){ + if (inp$`Date Start`[scr[i]]>startdate){ + scr_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[scr[i]],(f[i+1]-f[i])*20)) + screen<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) + } + else{ + scr_vector<-c(rep(inp$`Value`[scr[i]],(f[i+1])*20)) + screen<-c(rep(1,(f[i+1])*20)) + } + } + else{ + if (f[(i-1)*2+1]-f[(i-1)*2]==1){ + scr_vector<-c(scr_vector,rep(inp$`Value`[scr[i]],20)) + screen<-c(screen,rep(1,20)) + }else{ + scr_vector<-c(scr_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) + screen<-c(screen,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) + } + scr_vector<-c(scr_vector,rep(inp$`Value`[scr[i]],(f[i*2]-f[i*2-1])*20)) + screen<-c(screen,rep(1,(f[i*2]-f[i*2-1])*20)) + } + if(i==length(scr)&& f[i*2]=1){ + for (i in 1:length(hw)){ + + f<-c(f,as.numeric(inp$`Date Start`[hw[i]]-startdate),as.numeric(inp$`Date End`[hw[i]]-startdate)) + + if(i==1){ + if (inp$`Date Start`[hw[i]]>startdate){ + hw_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[hw[i]],(f[i+1]-f[i])*20)) + handwash<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) + } + else{ + hw_vector<-c(rep(inp$`Value`[hw[i]],(f[i+1])*20)) + handwash<-c(rep(1,(f[i+1])*20)) + } + } + else{ + if (f[(i-1)*2+1]-f[(i-1)*2]==1){ + hw_vector<-c(hw_vector,rep(inp$`Value`[hw[i]],20)) + handwash<-c(handwash,rep(1,20)) + }else{ + hw_vector<-c(hw_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) + handwash<-c(handwash,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) + } + hw_vector<-c(hw_vector,rep(inp$`Value`[hw[i]],(f[i*2]-f[i*2-1])*20)) + handwash<-c(handwash,rep(1,(f[i*2]-f[i*2-1])*20)) + } + if(i==length(hw)&& f[i*2]=1){ + for (i in 1:length(msk)){ + + f<-c(f,as.numeric(inp$`Date Start`[msk[i]]-startdate),as.numeric(inp$`Date End`[msk[i]]-startdate)) + + if(i==1){ + if (inp$`Date Start`[msk[i]]>startdate){ + msk_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[msk[i]],(f[i+1]-f[i])*20)) + masking<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) + } + else{ + msk_vector<-c(rep(inp$`Value`[msk[i]],(f[i+1])*20)) + masking<-c(rep(1,(f[i+1])*20)) + } + } + else{ + if (f[(i-1)*2+1]-f[(i-1)*2]==1){ + msk_vector<-c(msk_vector,rep(inp$`Value`[msk[i]],20)) + masking<-c(masking,rep(1,20)) + }else{ + msk_vector<-c(msk_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) + masking<-c(masking,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) + } + msk_vector<-c(msk_vector,rep(inp$`Value`[msk[i]],(f[i*2]-f[i*2-1])*20)) + masking<-c(masking,rep(1,(f[i*2]-f[i*2-1])*20)) + } + if(i==length(msk)&& f[i*2]=1){ + for (i in 1:length(dx)){ + f<-c(f,as.numeric(inp$`Date Start`[dx[i]]-startdate),as.numeric(inp$`Date End`[dx[i]]-startdate)) + + if(i==1){ + if (inp$`Date Start`[dx[i]]>startdate){ + dex<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) + } + else{ + dex<-c(rep(1,(f[i+1])*20)) + } + } + else{ + if (f[(i-1)*2+1]-f[(i-1)*2]==1){ + dex<-c(dex,rep(1,20)) + }else{ + dex<-c(dex,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) + } + dex<-c(dex,rep(1,(f[i*2]-f[i*2-1])*20)) + } + if(i==length(dx)&& f[i*2]=1){ + for (i in 1:length(wah)){ + + f<-c(f,as.numeric(inp$`Date Start`[wah[i]]-startdate),as.numeric(inp$`Date End`[wah[i]]-startdate)) + + if(i==1){ + if (inp$`Date Start`[wah[i]]>startdate){ + wah_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[wah[i]],(f[i+1]-f[i])*20)) + workhome<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) + } + else{ + wah_vector<-c(rep(inp$`Value`[wah[i]],(f[i+1])*20)) + workhome<-c(rep(1,(f[i+1])*20)) + } + } + else{ + if (f[(i-1)*2+1]-f[(i-1)*2]==1){ + wah_vector<-c(wah_vector,rep(inp$`Value`[wah[i]],20)) + workhome<-c(workhome,rep(1,20)) + }else{ + wah_vector<-c(wah_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) + workhome<-c(workhome,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) + } + wah_vector<-c(wah_vector,rep(inp$`Value`[wah[i]],(f[i*2]-f[i*2-1])*20)) + workhome<-c(workhome,rep(1,(f[i*2]-f[i*2-1])*20)) + } + if(i==length(wah)&& f[i*2]=1){ + for (i in 1:length(sc)){ + + f<-c(f,as.numeric(inp$`Date Start`[sc[i]]-startdate),as.numeric(inp$`Date End`[sc[i]]-startdate)) + + if(i==1){ + if (inp$`Date Start`[sc[i]]>startdate){ + sc_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[sc[i]],(f[i+1]-f[i])*20)) + schoolclose<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) + } + else{ + sc_vector<-c(rep(inp$`Value`[sc[i]],(f[i+1])*20)) + schoolclose<-c(rep(1,(f[i+1])*20)) + } + } + else{ + if (f[(i-1)*2+1]-f[(i-1)*2]==1){ + sc_vector<-c(sc_vector,rep(inp$`Value`[sc[i]],20)) + schoolclose<-c(schoolclose,rep(1,20)) + }else{ + sc_vector<-c(sc_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) + schoolclose<-c(schoolclose,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) + } + sc_vector<-c(sc_vector,rep(inp$`Value`[sc[i]],(f[i*2]-f[i*2-1])*20)) + schoolclose<-c(schoolclose,rep(1,(f[i*2]-f[i*2-1])*20)) + } + if(i==length(sc)&& f[i*2]=1){ + for (i in 1:length(cte)){ + + f<-c(f,as.numeric(inp$`Date Start`[cte[i]]-startdate),as.numeric(inp$`Date End`[cte[i]]-startdate)) + + if(i==1){ + if (inp$`Date Start`[cte[i]]>startdate){ + cte_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[cte[i]],(f[i+1]-f[i])*20)) + cocoon<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) + } + else{ + cte_vector<-c(rep(inp$`Value`[cte[i]],(f[i+1])*20)) + cocoon<-c(rep(1,(f[i+1])*20)) + } + } + else{ + if (f[(i-1)*2+1]-f[(i-1)*2]==1){ + cte_vector<-c(cte_vector,rep(inp$`Value`[cte[i]],20)) + cocoon<-c(cocoon,rep(1,20)) + }else{ + cte_vector<-c(cte_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) + cocoon<-c(cocoon,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) + } + cte_vector<-c(cte_vector,rep(inp$`Value`[cte[i]],(f[i*2]-f[i*2-1])*20)) + cocoon<-c(cocoon,rep(1,(f[i*2]-f[i*2-1])*20)) + } + if(i==length(cte)&& f[i*2]=1){ + for (i in 1:length(q)){ + + f<-c(f,as.numeric(inp$`Date Start`[q[i]]-startdate),as.numeric(inp$`Date End`[q[i]]-startdate)) + + if(i==1){ + if (inp$`Date Start`[q[i]]>startdate){ + q_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[q[i]],(f[i+1]-f[i])*20)) + quarantine<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) + } + else{ + q_vector<-c(rep(inp$`Value`[q[i]],(f[i+1])*20)) + quarantine<-c(rep(1,(f[i+1])*20)) + } + } + else{ + if (f[(i-1)*2+1]-f[(i-1)*2]==1){ + q_vector<-c(q_vector,rep(inp$`Value`[q[i]],20)) + quarantine<-c(quarantine,rep(1,20)) + }else{ + q_vector<-c(q_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) + quarantine<-c(quarantine,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) + } + q_vector<-c(q_vector,rep(inp$`Value`[q[i]],(f[i*2]-f[i*2-1])*20)) + quarantine<-c(quarantine,rep(1,(f[i*2]-f[i*2-1])*20)) + } + if(i==length(q)&& f[i*2]=1){ + for (i in 1:length(tb)){ + + f<-c(f,as.numeric(inp$`Date Start`[tb[i]]-startdate),as.numeric(inp$`Date End`[tb[i]]-startdate)) + + if(i==1){ + if (inp$`Date Start`[tb[i]]>startdate){ + tb_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[tb[i]],(f[i+1]-f[i])*20)) + travelban<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) + } + else{ + tb_vector<-c(rep(inp$`Value`[tb[i]],(f[i+1])*20)) + travelban<-c(rep(1,(f[i+1])*20)) + } + } + else{ + if (f[(i-1)*2+1]-f[(i-1)*2]==1){ + tb_vector<-c(tb_vector,rep(inp$`Value`[tb[i]],20)) + travelban<-c(travelban,rep(1,20)) + }else{ + tb_vector<-c(tb_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) + travelban<-c(travelban,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) + } + tb_vector<-c(tb_vector,rep(inp$`Value`[tb[i]],(f[i*2]-f[i*2-1])*20)) + travelban<-c(travelban,rep(1,(f[i*2]-f[i*2-1])*20)) + } + if(i==length(tb)&& f[i*2]=1){ + for (i in 1:length(mt)){ + + f<-c(f,as.numeric(inp$`Date Start`[mt[i]]-startdate),as.numeric(inp$`Date End`[mt[i]]-startdate)) + + if(i==1){ + if (inp$`Date Start`[mt[i]]>startdate){ + mt_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[mt[i]],(f[i+1]-f[i])*20)) + masstesting<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) + } + else{ + mt_vector<-c(rep(inp$`Value`[mt[i]],(f[i+1])*20)) + masstesting<-c(rep(1,(f[i+1])*20)) + } + } + else{ + if (f[(i-1)*2+1]-f[(i-1)*2]==1){ + mt_vector<-c(mt_vector,rep(inp$`Value`[mt[i]],20)) + masstesting<-c(masstesting,rep(1,20)) + }else{ + mt_vector<-c(mt_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) + masstesting<-c(masstesting,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) + } + mt_vector<-c(mt_vector,rep(inp$`Value`[mt[i]],(f[i*2]-f[i*2-1])*20)) + masstesting<-c(masstesting,rep(1,(f[i*2]-f[i*2-1])*20)) + } + if(i==length(mt)&& f[i*2]=1){ + for (i in 1:length(minas)){ + f<-c(f,as.numeric(inp$`Date Start`[minas[i]]-startdate),as.numeric(inp$`Date End`[minas[i]]-startdate)) + if(i==1){ + if (inp$`Date Start`[minas[i]]>startdate){ + minas_vector<-c(rep(age_testing_min,f[i]*20),rep(inp$`Value`[minas[i]],(f[i+1]-f[i])*20)) + } + else{ + minas_vector<-c(rep(inp$`Value`[minas[i]],(f[i+1])*20)) + } + } + else{ + if (f[(i-1)*2+1]-f[(i-1)*2]==1){ + minas_vector<-c(minas_vector,rep(inp$`Value`[minas[i]],20)) + }else{ + minas_vector<-c(minas_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) + } + minas_vector<-c(minas_vector,rep(inp$`Value`[minas[i]],(f[i*2]-f[i*2-1])*20)) + } + if(i==length(minas)&& f[i*2]=1){ + for (i in 1:length(maxas)){ + f<-c(f,as.numeric(inp$`Date Start`[maxas[i]]-startdate),as.numeric(inp$`Date End`[maxas[i]]-startdate)) + if(i==1){ + if (inp$`Date Start`[maxas[i]]>startdate){ + maxas_vector<-c(rep(age_testing_max,f[i]*20),rep(inp$`Value`[maxas[i]],(f[i+1]-f[i])*20)) + } + else{ + maxas_vector<-c(rep(inp$`Value`[maxas[i]],(f[i+1])*20)) + } + } + else{ + if (f[(i-1)*2+1]-f[(i-1)*2]==1){ + maxas_vector<-c(maxas_vector,rep(inp$`Value`[maxas[i]],20)) + }else{ + maxas_vector<-c(maxas_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) + } + maxas_vector<-c(maxas_vector,rep(inp$`Value`[maxas[i]],(f[i*2]-f[i*2-1])*20)) + } + if(i==length(maxas)&& f[i*2]=1){ + for (i in 1:length(vc)){ + f<-c(f,as.numeric(inp$`Date Start`[vc[i]]-startdate),as.numeric(inp$`Date End`[vc[i]]-startdate)) + + if(i==1){ + if (inp$`Date Start`[vc[i]]>startdate){ + vc_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[vc[i]],(f[i+1]-f[i])*20)) + vaccine<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) + } + else{ + vc_vector<-c(rep(inp$`Value`[vc[i]],(f[i+1])*20)) + vaccine<-c(rep(1,(f[i+1])*20)) + } + } + else{ + if (f[(i-1)*2+1]-f[(i-1)*2]==1){ + vc_vector<-c(vc_vector,rep(inp$`Value`[vc[i]],20)) + vaccine<-c(vaccine,rep(1,20)) + }else{ + vc_vector<-c(vc_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) + vaccine<-c(vaccine,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) + } + vc_vector<-c(vc_vector,rep(inp$`Value`[vc[i]],(f[i*2]-f[i*2-1])*20)) + vaccine<-c(vaccine,rep(1,(f[i*2]-f[i*2-1])*20)) + } + if(i==length(vc)&& f[i*2]=1){ + for (i in 1:length(minav)){ + f<-c(f,as.numeric(inp$`Date Start`[minav[i]]-startdate),as.numeric(inp$`Date End`[minav[i]]-startdate)) + if(i==1){ + if (inp$`Date Start`[minav[i]]>startdate){ + minav_vector<-c(rep(age_vaccine_min,f[i]*20),rep(inp$`Value`[minav[i]],(f[i+1]-f[i])*20)) + } + else{ + minav_vector<-c(rep(inp$`Value`[minav[i]],(f[i+1])*20)) + } + } + else{ + if (f[(i-1)*2+1]-f[(i-1)*2]==1){ + minav_vector<-c(minav_vector,rep(inp$`Value`[minav[i]],20)) + }else{ + minav_vector<-c(minav_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) + } + minav_vector<-c(minav_vector,rep(inp$`Value`[minav[i]],(f[i*2]-f[i*2-1])*20)) + } + if(i==length(minav)&& f[i*2]=1){ + for (i in 1:length(maxav)){ + f<-c(f,as.numeric(inp$`Date Start`[maxav[i]]-startdate),as.numeric(inp$`Date End`[maxav[i]]-startdate)) + if(i==1){ + if (inp$`Date Start`[maxav[i]]>startdate){ + maxav_vector<-c(rep(age_vaccine_max,f[i]*20),rep(inp$`Value`[maxav[i]],(f[i+1]-f[i])*20)) + } + else{ + maxav_vector<-c(rep(inp$`Value`[maxav[i]],(f[i+1])*20)) + } + } + else{ + if (f[(i-1)*2+1]-f[(i-1)*2]==1){ + maxav_vector<-c(maxav_vector,rep(inp$`Value`[maxav[i]],20)) + }else{ + maxav_vector<-c(maxav_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) + } + maxav_vector<-c(maxav_vector,rep(inp$`Value`[maxav[i]],(f[i*2]-f[i*2-1])*20)) + } + if(i==length(maxav)&& f[i*2]1){ + ratetestI<-mass_test_sens*testI/sum(I) + # print(paste('rateI: ',ratetestI)) + }else{ratetestI<-0} + if(sum(CL)>1){ + ratetestC<-mass_test_sens*testC/sum(CL) + # print(paste('rateC: ',ratetestC)) + }else{ratetestC<-0} + # print(sum(E)) + if(sum(E)>1){ + ratetestE<-mass_test_sens*testE/sum(E) + }else{ratetestE<-0} + if(sum(EV)>1){ + ratetestEV<-mass_test_sens*testEV/sum(EV) + # print(paste('rateEV: ',ratetestEV)) + }else{ratetestEV<-0} + if(sum(ER)>1){ + ratetestER<-mass_test_sens*testER/sum(ER) + # print(paste('rateER: ',ratetestER)) + }else{ratetestER<-0} + if(sum(EVR)>1){ + ratetestEVR<-mass_test_sens*testEVR/sum(EVR) + }else{ratetestEVR<-0} + if(sum(HC)>1){ + ratetestHC<-mass_test_sens*testHC/sum(HC) + }else{ratetestHC<-0} + if(sum(HCICU)>1){ + ratetestHCICU<-mass_test_sens*testHCICU/sum(HCICU) + }else{ratetestHCICU<-0} + if(sum(HCV)>1){ + ratetestHCV<-mass_test_sens*testHCV/sum(HCV) + }else{ratetestHCV<-0} + + # print(mass_test_sens) + # print(ratetestI*sum(I) + ratetestC*sum(CL) - (1/isolation_days)*sum(Z) ) + # print(propC) + # print(testI) + # print(testC) + # + # cocooning the elderly + cocoon_mat<-matrix((1-cocoon_eff),nrow = length(popstruc$pop),ncol = length(popstruc$pop)) + cocoon_mat[1:(age_cocoon-1),1:(age_cocoon-1)]<-1 + + # contact matrices + cts<-(contact_home+distancing*(1-dist)*contact_other+(1-distancing)*contact_other + +(1-schoolclose)*contact_school # school on + +schoolclose*(1-school)*contact_school # school close + +schoolclose*contact_home*school*s2h # inflating contacts at home when school closes + +(1-workhome)*contact_work # normal work + +workhome*(1-work)*contact_work # people not working from home when homework is active + +contact_home*workhome*work*w2h # inflating contacts at home when working from home + ) + + # Final transmission related parameters + contacts <- (1-cocoon)*cts+cocoon*cts*cocoon_mat+cocoon*(1+schoolclose*(1-school_eff)+workhome*(1-work_eff))*contact_home*(1-cocoon_mat) + seas <- 1+amp*cos(2*3.14*(t-(phi*365.25/12))/365.25) + importation <- mean_imports*(1-trvban_eff) + HH<-H+ICU+Vent+ICUC+ICUCV+VentC + HHC<-HC+HCICU+HCV + lam <- (1-max(hand,mask))*p*seas*(contacts%*%((rho*E+(I+CL+importation)+(1-selfis_eff)*(X+HHC)+rhos*(HH))/P))+ + (1-max(hand,mask))*p*seas*(1-quarantine*quarantine_eff_other)*(contact_other%*%((rho*QE+QI+QC+QEV+QEVR+QER)/P)) + # contacts under home quarantine + lamq<-(1-max(hand,mask))*p*seas*((1-quarantine_eff_home)*contact_home%*%(((1-selfis_eff)*(X+HHC+rho*QE+QI+QC++QEV+QEVR+QER))/P))+ + (1-max(hand,mask))*p*seas*(1-quarantine_eff_other)*(contact_other%*%((rho*E+(I+CL+importation)+(1-selfis_eff)*(X+HHC+rho*QE+QI+QC++QEV+QEVR+QER)+rhos*(HH))/P)) + # lamq<-0 + # print(paste("lamq",lamq)) + # print(paste("lamq",(1-vaccine_eff_r)*lamq*sum(QVR) )) + # print(paste("quarantine evr",quarantine_rate*sum(EVR) )) + + # birth/death + b1<-sum(popbirth[,2]*popstruc[,2]) + birth<-0*popbirth[,2] + birth[1]<-b1 + + # ODE system + dSdt <- -S*lam-vaccinate*age_vaccine_vector*S+omega*R+vac_dur*V- + quarantine_rate*S +(1/quarantine_days)*QS+ageing%*%S-mort*S+birth + dEdt <- S*lam-gamma*E+ageing%*%E- vaccinate*age_vaccine_vector*E - mort*E - + quarantine_rate*E+(1/quarantine_days)*QE + dIdt <- gamma*(1-pclin)*(1-age_testing_vector*ratetestE)*(1-screen_eff)*(1-ihr[,2])*E+ + gamma*(1-pclin_v)*(1-age_testing_vector*ratetestEV)*(1-screen_eff)*(1-sigmaEV*ihr[,2])*EV+ + gamma*(1-pclin_vr)*(1-age_testing_vector*ratetestEVR)*(1-screen_eff)*(1-sigmaEVR*ihr[,2])*EVR+ + gamma*(1-pclin_r)*(1-age_testing_vector*ratetestER)*(1-screen_eff)*(1-sigmaER*ihr[,2])*ER- + vaccinate*age_vaccine_vector*I - nui*I+ageing%*%I-mort*I + + (1/quarantine_days)*QI - quarantine_rate*I - ratetestI*age_testing_vector*I + dCLdt<- gamma*pclin*(1-age_testing_vector*ratetestE)*(1-selfis)*(1-ihr[,2])*(1-quarantine_rate)*E+ + gamma*pclin_v*(1-age_testing_vector*ratetestEV)*(1-selfis)*(1-sigmaEV*ihr[,2])*(1-quarantine_rate)*EV+ + gamma*pclin_vr*(1-age_testing_vector*ratetestEVR)*(1-selfis)*(1-sigmaEVR*ihr[,2])*(1-quarantine_rate)*EVR+ + gamma*pclin_r*(1-age_testing_vector*ratetestER)*(1-selfis)*(1-sigmaER*ihr[,2])*(1-quarantine_rate)*ER- + nui*CL+ageing%*%CL-mort*CL + (1/quarantine_days)*QC - ratetestC*age_testing_vector*CL + dRdt <- vac_dur_r*VR-omega*R-vaccinate*age_vaccine_vector*R-lam*sigmaR*R - quarantine_rate*R+ + nui*I+nui*X+nui*CL+ageing%*%R-mort*R + (1/isolation_days)*Z+(1/quarantine_days)*QR+ + nus*propo2*(1-dexo2*pdeath_ho)*ifr[,2]*H+nus*(1-propo2)*(1-pdeath_h)*ifr[,2]*H+ + nusc*propo2*(1-pdeath_hco)*ifr[,2]*HC+nusc*(1-propo2)*(1-pdeath_hc)*ifr[,2]*HC+ + nusc*propo2*(1-pdeath_icu_hco)*ifr[,2]*HCICU+nusc*(1-propo2)*(1-pdeath_icu_hc)*ifr[,2]*HCICU+ + nu_icu*propo2*(1-dexo2*pdeath_icuo)*ifr[,2]*ICU+nu_icu*(1-propo2)*(1-pdeath_icu)*ifr[,2]*ICU+ + nu_icuc*propo2*(1-dexo2c*pdeath_icuco)*ifr[,2]*ICUC+nu_icuc*(1-propo2)*(1-pdeath_icuc)*ifr[,2]*ICUC+ + nu_vent*(1-dexv*pdeath_vent)*ifr[,2]*Vent+ + nu_ventc*(1-pdeath_vent_hc)*ifr[,2]*HCV+ + nu_ventc*(1-dexvc*pdeath_ventc)*ifr[,2]*VentC+nu_ventc*(1-dexvc*pdeath_ventc)*ifr[,2]*ICUCV + dXdt <- gamma*selfis*(1-age_testing_vector*ratetestE)*pclin*(1-ihr[,2])*E+ + gamma*(1-pclin)*(1-age_testing_vector*ratetestE)*screen_eff*(1-ihr[,2])*E+ + gamma*selfis*(1-age_testing_vector*ratetestEV)*pclin_v*(1-sigmaEV*ihr[,2])*EV+ + gamma*(1-pclin_v)*(1-age_testing_vector*ratetestEV)*screen_eff*(1-sigmaEV*ihr[,2])*EV+ + gamma*selfis*(1-age_testing_vector*ratetestEVR)*pclin_v*(1-sigmaEVR*ihr[,2])*EVR+ + gamma*(1-pclin_vr)*(1-age_testing_vector*ratetestEVR)*screen_eff*(1-sigmaEVR*ihr[,2])*EVR+ + gamma*selfis*(1-age_testing_vector*ratetestER)*pclin_r*(1-sigmaER*ihr[,2])*ER+ + gamma*(1-pclin_r)*(1-age_testing_vector*ratetestER)*screen_eff*(1-sigmaER*ihr[,2])*ER+ + -nui*X+ageing%*%X-mort*X + dVdt <- vaccinate*age_vaccine_vector*S + omega*VR - (1-vaccine_eff)*lam*V - vac_dur*V + ageing%*%V-mort*V - quarantine_rate*V + dEVdt<- (1-vaccine_eff)*lam*V - gamma*EV + ageing%*%EV - mort*EV - quarantine_rate*EV +(1/quarantine_days)*QEV + dERdt<- lam*sigmaR*R - gamma*ER + ageing%*%ER - mort*ER - quarantine_rate*ER +(1/quarantine_days)*QER + dVRdt <- vaccinate*age_vaccine_vector*E + vaccinate*age_vaccine_vector*I + vaccinate*age_vaccine_vector*R - + (1-vaccine_eff_r)*lam*VR - vac_dur_r*VR + ageing%*%VR - mort*VR - omega*VR - quarantine_rate*VR + (1/quarantine_days)*QVR + dEVRdt<- (1-vaccine_eff_r)*lam*VR - gamma*EVR + ageing%*%EVR-mort*EVR - quarantine_rate*EVR + + (1/quarantine_days)*QEVR + + + dQSdt <- quarantine_rate*S + ageing%*%QS-mort*QS - (1/quarantine_days)*QS - lamq*QS + dQEdt <- quarantine_rate*E - gamma*QE + ageing%*%QE-mort*QE - (1/quarantine_days)*QE + lamq*QS + dQIdt <- quarantine_rate*I + gamma*(1-ihr[,2])*(1-pclin)*QE+ + gamma*(1-sigmaEV*ihr[,2])*(1-pclin_v)*QEV+ + gamma*(1-sigmaER*ihr[,2])*(1-pclin_r)*QER+ + gamma*(1-sigmaEVR*ihr[,2])*(1-pclin_vr)*QEVR- + nui*QI+ageing%*%QI-mort*QI - (1/quarantine_days)*QI + dQCdt <- gamma*pclin*(1-selfis)*(1-age_testing_vector*ratetestE)*(1-ihr[,2])*quarantine_rate*E+ + gamma*pclin_v*(1-age_testing_vector*ratetestEV)*(1-selfis)*(1-sigmaEV*ihr[,2])*quarantine_rate*EV+ + gamma*pclin_vr*(1-age_testing_vector*ratetestEVR)*(1-selfis)*(1-sigmaEVR*ihr[,2])*quarantine_rate*EVR+ + gamma*pclin_r*(1-age_testing_vector*ratetestER)*(1-selfis)*(1-sigmaER*ihr[,2])*quarantine_rate*ER+ + gamma*(1-ihr[,2])*pclin*QE + + gamma*(1-sigmaEV*ihr[,2])*pclin_v*QEV + + gamma*(1-sigmaER*ihr[,2])*pclin_r*QER + + gamma*(1-sigmaEVR*ihr[,2])*pclin_vr*QEVR - + nui*QC+ageing%*%QC-mort*QC - (1/quarantine_days)*QC + dQRdt <- quarantine_rate*R + nui*QI + nui*QC + ageing%*%QR-mort*QR - (1/quarantine_days)*QR + vac_dur_r*QVR + dQVdt <- quarantine_rate*V + ageing%*%QV-mort*QV - (1/quarantine_days)*QV - (1-vaccine_eff)*lamq*QV + omega*QVR + dQEVdt <- quarantine_rate*EV - gamma*QEV + ageing%*%QEV-mort*QEV - (1/quarantine_days)*QEV + (1-vaccine_eff)*lamq*QV + dQERdt <- quarantine_rate*ER - gamma*QER + ageing%*%QER-mort*QER - (1/quarantine_days)*QER + sigmaR*lamq*QR + dQVRdt <- quarantine_rate*VR - (1-vaccine_eff_r)*lam*QVR - vac_dur_r*QVR - omega*QVR + ageing%*%QVR - mort*QVR + dQEVRdt <- quarantine_rate*EVR - gamma*QEVR +ageing%*%QEVR-mort*QEVR - + (1/quarantine_days)*QEVR +(1-vaccine_eff_r)*lamq*QVR + + + dHdt <- gamma*ihr[,2]*(1-prob_icu)*(1-critH)*reporth*E+ + gamma*sigmaEV*ihr[,2]*(1-prob_icu_v)*(1-critH)*reporth*EV + + gamma*sigmaEVR*ihr[,2]*(1-prob_icu_vr)*(1-critH)*reporth*EVR + + gamma*sigmaER*ihr[,2]*(1-prob_icu_r)*(1-critH)*reporth*ER + + gamma*ihr[,2]*(1-prob_icu)*(1-critH)*reporth*QE + + gamma*sigmaEV*ihr[,2]*(1-prob_icu_v)*(1-critH)*reporth*QEV + + gamma*sigmaEVR*ihr[,2]*(1-prob_icu_vr)*(1-critH)*reporth*QEVR + + gamma*sigmaER*ihr[,2]*(1-prob_icu_r)*(1-critH)*reporth*QER - + nus*H + ageing%*%H-mort*H + dHCdt <- gamma*ihr[,2]*(1-prob_icu)*(1-reporth)*E+gamma*ihr[,2]*(1-prob_icu)*critH*reporth*E + + gamma*sigmaEV*ihr[,2]*(1-prob_icu_v)*(1-reporth)*EV+gamma*sigmaEV*ihr[,2]*(1-prob_icu_v)*critH*reporth*EV+ + gamma*sigmaEVR*ihr[,2]*(1-prob_icu_vr)*(1-reporth)*EVR+gamma*sigmaEVR*ihr[,2]*(1-prob_icu_vr)*critH*reporth*EVR+ + gamma*sigmaER*ihr[,2]*(1-prob_icu_r)*(1-reporth)*ER+gamma*sigmaER*ihr[,2]*(1-prob_icu_r)*critH*reporth*ER + + gamma*ihr[,2]*(1-prob_icu)*(1-reporth)*QE+gamma*ihr[,2]*(1-prob_icu)*critH*reporth*QE+ + gamma*sigmaEV*ihr[,2]*(1-prob_icu_v)*(1-reporth)*QEV+gamma*sigmaEV*ihr[,2]*(1-prob_icu_v)*critH*reporth*QEV+ + gamma*sigmaEVR*ihr[,2]*(1-prob_icu_vr)*(1-reporth)*QEVR+gamma*sigmaEVR*ihr[,2]*(1-prob_icu_vr)*critH*reporth*QEVR+ + gamma*sigmaER*ihr[,2]*(1-prob_icu_r)*(1-reporth)*QER+gamma*sigmaER*ihr[,2]*(1-prob_icu_r)*critH*reporth*QER - + nusc*HC + ageing%*%HC-mort*HC - ratetestHC*age_testing_vector*HC + dHCICUdt <- gamma*(1-reporth_ICU)*ihr[,2]*prob_icu*(1-prob_v)*E+ + gamma*(1-reporth_ICU)*sigmaEV*ihr[,2]*prob_icu_v*(1-prob_v_v)*EV+ + gamma*(1-reporth_ICU)*sigmaEVR*ihr[,2]*prob_icu_vr*(1-prob_v_vr)*EVR+ + gamma*(1-reporth_ICU)*sigmaER*ihr[,2]*prob_icu_r*(1-prob_v_r)*ER+ + gamma*(1-reporth_ICU)*ihr[,2]*prob_icu*(1-prob_v)*QE+ + gamma*(1-reporth_ICU)*sigmaEV*ihr[,2]*prob_icu_v*(1-prob_v_v)*QEV+ + gamma*(1-reporth_ICU)*sigmaEVR*ihr[,2]*prob_icu_vr*(1-prob_v_vr)*QEVR+ + gamma*(1-reporth_ICU)*sigmaER*ihr[,2]*prob_icu_r*(1-prob_v_r)*QER- + nusc*HCICU + ageing%*%HCICU-mort*HCICU - ratetestHCICU*age_testing_vector*HCICU + dHCVdt <- gamma*(1-reporth_ICU)*ihr[,2]*prob_icu*prob_v*E+ + gamma*(1-reporth_ICU)*sigmaEV*ihr[,2]*prob_icu_v*prob_v_v*EV+ + gamma*(1-reporth_ICU)*sigmaEVR*ihr[,2]*prob_icu_vr*prob_v_vr*EVR+ + gamma*(1-reporth_ICU)*sigmaER*ihr[,2]*prob_icu_r*prob_v_r*ER+ + gamma*(1-reporth_ICU)*ihr[,2]*prob_icu*prob_v*QE+ + gamma*(1-reporth_ICU)*sigmaEV*ihr[,2]*prob_icu_v*prob_v_v*QEV+ + gamma*(1-reporth_ICU)*sigmaEVR*ihr[,2]*prob_icu_vr*prob_v_vr*QEVR+ + gamma*(1-reporth_ICU)*sigmaER*ihr[,2]*prob_icu_r*prob_v_r*QER- + nu_ventc*HCV + ageing%*%HCV-mort*HCV - ratetestHCV*age_testing_vector*HCV + dICUdt <- gamma*reporth_ICU*ihr[,2]*prob_icu*(1-crit)*(1-prob_v)*E+ + gamma*reporth_ICU*sigmaEV*ihr[,2]*prob_icu_v*(1-crit)*(1-prob_v_v)*EV+ + gamma*reporth_ICU*sigmaEVR*ihr[,2]*prob_icu_vr*(1-crit)*(1-prob_v_vr)*EVR+ + gamma*reporth_ICU*sigmaER*ihr[,2]*prob_icu_r*(1-crit)*(1-prob_v_r)*ER+ + gamma*reporth_ICU*ihr[,2]*prob_icu*(1-crit)*(1-prob_v)*QE+ + gamma*reporth_ICU*sigmaEV*ihr[,2]*prob_icu_v*(1-crit)*(1-prob_v_v)*QEV+ + gamma*reporth_ICU*sigmaEVR*ihr[,2]*prob_icu_vr*(1-crit)*(1-prob_v_vr)*QEVR+ + gamma*reporth_ICU*sigmaER*ihr[,2]*prob_icu_r*(1-crit)*(1-prob_v_r)*QER - + nu_icu*ICU +ageing%*%ICU - mort*ICU + (1-crit)*ICUC*1/2 + dICUCdt <- gamma*reporth_ICU*ihr[,2]*prob_icu*crit*(1-prob_v)*E+ + gamma*reporth_ICU*sigmaEV*ihr[,2]*prob_icu_v*crit*(1-prob_v_v)*EV+ + gamma*reporth_ICU*sigmaEVR*ihr[,2]*prob_icu_vr*crit*(1-prob_v_vr)*EVR+ + gamma*reporth_ICU*sigmaER*ihr[,2]*prob_icu_r*crit*(1-prob_v_r)*ER+ + gamma*reporth_ICU*ihr[,2]*prob_icu*crit*(1-prob_v)*QE+ + gamma*reporth_ICU*sigmaEV*ihr[,2]*prob_icu_v*crit*(1-prob_v_v)*QEV+ + gamma*reporth_ICU*sigmaEVR*ihr[,2]*prob_icu_vr*crit*(1-prob_v_vr)*QEVR+ + gamma*reporth_ICU*sigmaER*ihr[,2]*prob_icu_r*crit*(1-prob_v_r)*QER - + nu_icuc*ICUC -(1-crit)*ICUC*1/2 +ageing%*%ICUC - mort*ICUC + dICUCVdt <- gamma*reporth_ICU*ihr[,2]*prob_icu*prob_v*crit*E+ + gamma*reporth_ICU*sigmaEV*ihr[,2]*prob_icu_v*prob_v_v*crit*EV+ + gamma*reporth_ICU*sigmaEVR*ihr[,2]*prob_icu_vr*prob_v_vr*crit*EVR+ + gamma*reporth_ICU*sigmaER*ihr[,2]*prob_icu_r*prob_v_r*crit*ER+ + gamma*reporth_ICU*ihr[,2]*prob_icu*prob_v*crit*QE+ + gamma*reporth_ICU*sigmaEV*ihr[,2]*prob_icu_v*prob_v_v*crit*QEV+ + gamma*reporth_ICU*sigmaEVR*ihr[,2]*prob_icu_vr*prob_v_vr*crit*QEVR+ + gamma*reporth_ICU*sigmaER*ihr[,2]*prob_icu_r*prob_v_r*crit*QER - + nu_ventc*ICUCV +ageing%*%ICUCV - mort*ICUCV - (1-critV)*ICUCV*1/2 + dVentdt <- gamma*reporth_ICU*ihr[,2]*prob_icu*(1-crit)*(1-critV)*prob_v*E+ + gamma*reporth_ICU*sigmaEV*ihr[,2]*prob_icu_v*(1-crit)*(1-critV)*prob_v_v*EV+ + gamma*reporth_ICU*sigmaEVR*ihr[,2]*prob_icu_vr*(1-crit)*(1-critV)*prob_v_vr*EVR+ + gamma*reporth_ICU*sigmaER*ihr[,2]*prob_icu_r*(1-crit)*(1-critV)*prob_v_r*ER+ + gamma*reporth_ICU*ihr[,2]*prob_icu*(1-crit)*(1-critV)*prob_v*QE+ + gamma*reporth_ICU*sigmaEV*ihr[,2]*prob_icu_v*(1-crit)*(1-critV)*prob_v_v*QEV+ + gamma*reporth_ICU*sigmaEVR*ihr[,2]*prob_icu_vr*(1-crit)*(1-critV)*prob_v_vr*QEVR+ + gamma*reporth_ICU*sigmaER*ihr[,2]*prob_icu_r*(1-crit)*(1-critV)*prob_v_r*QER + + (1-critV)*VentC*1/2 +(1-critV)*ICUCV*1/2 - nu_vent*Vent +ageing%*%Vent - mort*Vent + dVentCdt <- gamma*reporth_ICU*ihr[,2]*prob_icu*prob_v*(1-crit)*critV*E+ + gamma*reporth_ICU*sigmaEV*ihr[,2]*prob_icu_v*prob_v_v*(1-crit)*critV*EV+ + gamma*reporth_ICU*sigmaEVR*ihr[,2]*prob_icu_vr*prob_v_vr*(1-crit)*critV*EVR+ + gamma*reporth_ICU*sigmaER*ihr[,2]*prob_icu_r*prob_v_r*(1-crit)*critV*ER+ + gamma*reporth_ICU*ihr[,2]*prob_icu*prob_v*(1-crit)*critV*QE+ + gamma*reporth_ICU*sigmaEV*ihr[,2]*prob_icu_v*prob_v_v*(1-crit)*critV*QEV+ + gamma*reporth_ICU*sigmaEVR*ihr[,2]*prob_icu_vr*prob_v_vr*(1-crit)*critV*QEVR+ + gamma*reporth_ICU*sigmaER*ihr[,2]*prob_icu_r*prob_v_r*(1-crit)*critV*QER - + (1-critV)*VentC*1/2 -nu_ventc*VentC +ageing%*%VentC - mort*VentC + + # print(dexo2) + dCdt <- report*gamma*(1-age_testing_vector*ratetestE)*(1-pclin)*(1-ihr[,2])*(E+QE)+reportc*gamma*pclin*(1-age_testing_vector*ratetestE)*(1-ihr[,2])*(E+QE)+ + gamma*ihr[,2]*(1-critH)*(1-prob_icu)*(E+QE)+gamma*ihr[,2]*critH*reporth*(1-prob_icu)*(E+QE)+ + gamma*ihr[,2]*prob_icu*(E+QE)+ratetestI*age_testing_vector*I+ratetestC*age_testing_vector*CL+gamma*age_testing_vector*ratetestE*(1-ihr[,2])*E + dCMdt<- nus*propo2*dexo2*pdeath_ho*ifr[,2]*H+nus*(1-propo2)*pdeath_h*ifr[,2]*H+ + nusc*report_death_HC*propo2*pdeath_hco*ifr[,2]*HC+nusc*report_death_HC*(1-propo2)*pdeath_hc*ifr[,2]*HC+ + nu_icu*propo2*dexo2*pdeath_icuo*ifr[,2]*ICU+nu_icu*(1-propo2)*pdeath_icu*ifr[,2]*ICU+ + nu_icuc*propo2*dexo2c*pdeath_icuco*ifr[,2]*ICUC+nu_icuc*(1-propo2)*pdeath_icuc*ifr[,2]*ICUC+ + nu_vent*dexv*pdeath_vent*ifr[,2]*Vent+nu_ventc*dexvc*pdeath_ventc*ifr[,2]*VentC + + nu_ventc*dexvc*pdeath_ventc*ifr[,2]*ICUCV+ nu_ventc*report_death_HC*pdeath_vent_hc*ifr[,2]*HCV+ + nu_icuc*report_death_HC*propo2*pdeath_icu_hco*ifr[,2]*HCICU+nu_icuc*report_death_HC*(1-propo2)*pdeath_icu_hc*ifr[,2]*HCICU + + mort*H + mort*ICU + mort*ICUC + mort*ICUCV + mort*Vent + mort*VentC + mort*Z + + mort*report_death_HC*HC +mort*report_death_HC*HCICU + mort*report_death_HC*HCV + + report_natdeathI*mort*I + report_natdeathI*mort*QI+ report_natdeathI*mort*E+ + report_natdeathI*mort*QE + report_natdeathI*mort*EV+ report_natdeathI*mort*EVR+ + report_natdeathI*mort*ER + report_natdeathI*mort*QEV+ + report_natdeathI*mort*QEVR + report_natdeathI*mort*QER+ + report_natdeathCL*mort*CL + report_natdeathCL*mort*QC + report_natdeathCL*mort*X + dCMCdt <- nusc*propo2*pdeath_hco*ifr[,2]*HC+nusc*(1-propo2)*pdeath_hc*ifr[,2]*HC+ + nu_icuc*propo2*dexo2c*pdeath_icuco*ifr[,2]*ICUC+nu_icuc*(1-propo2)*pdeath_icuc*ifr[,2]*ICUC+ + nu_ventc*dexvc*pdeath_ventc*ifr[,2]*VentC+nu_ventc*dexvc*pdeath_ventc*ifr[,2]*ICUCV+ + mort*HC + mort*ICUC + mort*VentC + mort*ICUCV + + dZdt <- gamma*ratetestE*age_testing_vector*(1-ihr[,2])*E+ + ratetestI*age_testing_vector*I+ + ratetestC*age_testing_vector*CL+ + gamma*(1-ihr[,2])*ratetestEV*age_testing_vector*EV+ + gamma*(1-ihr[,2])*ratetestEVR*age_testing_vector*EVR+ + gamma*(1-ihr[,2])*ratetestER*age_testing_vector*ER+ + ratetestHC*age_testing_vector*HC+ + ratetestHCICU*age_testing_vector*HCICU+ + ratetestHCV*age_testing_vector*HCV- + (1/isolation_days)*Z-mort*Z + + dAbdt <- nui*I+nui*X+nui*CL+ + nus*propo2*(1-dexo2*pdeath_ho)*ifr[,2]*H+nus*(1-propo2)*(1-pdeath_h)*ifr[,2]*H+ + nusc*propo2*(1-pdeath_hco)*ifr[,2]*HC+nusc*(1-propo2)*(1-pdeath_hc)*ifr[,2]*HC+ + nusc*propo2*(1-pdeath_icu_hco)*ifr[,2]*HCICU+nusc*(1-propo2)*(1-pdeath_icu_hc)*ifr[,2]*HCICU+ + nu_ventc*(1-pdeath_vent_hc)*ifr[,2]*HCV+ + nu_icu*propo2*(1-dexo2*pdeath_icuo)*ifr[,2]*ICU+nu_icu*(1-propo2)*(1-pdeath_icu)*ifr[,2]*ICU+ + nu_icuc*propo2*(1-dexo2c*pdeath_icuco)*ifr[,2]*ICUC+nu_icuc*(1-propo2)*(1-pdeath_icuc)*ifr[,2]*ICUC+ + nu_vent*(1-dexv*pdeath_vent)*ifr[,2]*Vent+ + nu_ventc*(1-dexvc*pdeath_ventc)*ifr[,2]*VentC+ + nu_ventc*(1-dexvc*pdeath_ventc)*ifr[,2]*ICUCV - + seroneg*Ab - mort*Ab + ageing%*%Ab + + # print(paste("QEVR",sum(QEVR))) + + # return the rate of change + list(c(S=dSdt,dEdt,dIdt,dRdt,dXdt,dHdt,dHCdt,dCdt,dCMdt,dVdt,dQSdt,dQEdt,dQIdt,dQRdt,dCLdt,dQCdt,dICUdt,dICUCdt,dICUCVdt, + dVentdt,dVentCdt,dCMCdt,dZdt,dEVdt,dERdt,dEVRdt,dVRdt,dQVdt,dQEVdt,dQEVRdt,dQERdt,dQVRdt,dHCICUdt,dHCVdt,dAbdt)) + } + ) +} + +########### RUN BASELINE MODEL - start time for interventions is set to day 1e5, i.e. interventions are always off + +Y<-c(initS,initE,initI,initR,initX,initH,initHC,initC,initCM,initV, initQS, initQE, initQI, initQR, initCL, initQC, initICU, + initICUC, initICUCV, initVent, initVentC, initCMC,initZ, initEV, initER, initEVR, initVR, + initQV,initQEV,initQEVR,initQER,initQVR,initHCICU,initHCV,initAb) # initial conditions for the main solution vector +# times<-seq(0,120, by =1) +# out0 <- ode(y = Y, times = times, method = "euler", hini = 0.05, func = covid, parms = parameters, input=vectors0) +# tail(rowSums(out0[,(CMindex+1)]),1) # cumulative mortality +# tail(rowSums(out0[,(Sindex+1)]),1)/sum(popstruc[,2]) # cumulative mortality +# tail(rowSums(out0[,(Vindex+1)]),1)/sum(popstruc[,2]) # cumulative mortality +# tail(rowSums(out0[,(Rindex+1)]),1)/sum(popstruc[,2]) # cumulative mortality +# sum(rowSums(out0[,(Iindex+1)])) # cumulative mortality +# sum(rowSums(out0[,(Ventindex+1)])) # cumulative mortality +# sum(rowSums(out0[,(HCVindex+1)])) # cumulative mortality +# sum(rowSums(out0[,(HCICUindex+1)])) # cumulative mortality +# sum(rowSums(out0[,(HCindex+1)])) # cumulative mortality + +# parameters["vaccine_eff"]<-0 +# out0 <- ode(y = Y, times = times, method = "euler", hini = 0.05, func = covid, parms = parameters, input=vectors0) +# tail(rowSums(out0[,(CMindex+1)]),1) # cumulative mortality + + + +# +# dexo2_hist <- rep(0,length(times)) +# dexo2c_hist <- rep(0,length(times)) +# dexv_hist <- rep(0,length(times)) +# dexvc_hist <- rep(0,length(times)) +# for (tt in times) { +# if(tt < max(times)){ +# if(vectors$dex[tt*20+1]) { +# dexo2_hist[tt+1] <- parameters["dexo2"] +# dexo2c_hist[tt+1] <- parameters["dexo2c"] +# dexv_hist[tt+1] <- parameters["dexv"] +# dexvc_hist[tt+1] <- parameters["dexvc"] +# } else { +# dexo2_hist[tt+1] <- 1 +# dexo2c_hist[tt+1] <- 1 +# dexv_hist[tt+1] <- 1 +# dexvc_hist[tt+1] <- 1 +# } +# } else { +# dexo2_hist[tt+1] <- dexo2_hist[tt] +# dexo2c_hist[tt+1] <- dexo2c_hist[tt] +# dexv_hist[tt+1] <- dexv_hist[tt] +# dexvc_hist[tt+1] <- dexvc_hist[tt] +# } +# } + + +process_ode_outcome_mortality <- function(out_mean, intv_vector, param_used, print_death_summary = FALSE){ + + cmortality1<-rowSums(out_mean[,(CMindex+1)]) # cumulative mortality, CM compartment + + results <- list() + results$time <- startdate + times # dates + results$cum_mortality <- cmortality1 # cumulative mortality + + ########################## Time-varying parameters + + # critH_hist<-c() + # crit_hist<-c() + # critV_hist<-c() + + # for (i in 1:length(times)){ + # critH_hist[i]<-min(1-fH((sum(out_mean[i,(Hindex+1)]))+sum(out_mean[i,(ICUCindex+1)])+sum(out_mean[i,(ICUCVindex+1)])),1) + # crit_hist[i]<-min(1-fICU((sum(out_mean[i,(ICUindex+1)]))+(sum(out_mean[i,(Ventindex+1)]))+(sum(out_mean[i,(VentCindex+1)])))) + # critV_hist[i]<-min(1-fVent((sum(out_mean[i,(Ventindex+1)]))),1) + + # to_keep = 10000000 + # critH_hist[i] = round(critH_hist[i] * to_keep) / to_keep + # crit_hist[i] = round(crit_hist[i] * to_keep) / to_keep + # critV_hist[i] = round(critV_hist[i] * to_keep) / to_keep + + # } + + prob_v_hist <- rep(param_used["prob_vent"],length(times)) + dexo2_hist <- rep(0,length(times)) + dexo2c_hist <- rep(0,length(times)) + dexv_hist <- rep(0,length(times)) + dexvc_hist <- rep(0,length(times)) + for (tt in times) { + if(tt < max(times)){ + if(intv_vector$dex[tt*20+1]) { + prob_v_hist[tt+1] <- param_used["prob_vent"]*param_used["vent_dex"] + dexo2_hist[tt+1] <- param_used["dexo2"] + dexo2c_hist[tt+1] <- param_used["dexo2c"] + dexv_hist[tt+1] <- param_used["dexv"] + dexvc_hist[tt+1] <- param_used["dexvc"] + } else { + prob_v_hist[tt+1] <- param_used["prob_vent"] + dexo2_hist[tt+1] <- 1 + dexo2c_hist[tt+1] <- 1 + dexv_hist[tt+1] <- 1 + dexvc_hist[tt+1] <- 1 + } + } else { + prob_v_hist[tt+1] <- prob_v_hist[tt] + dexo2_hist[tt+1] <- dexo2_hist[tt] + dexo2c_hist[tt+1] <- dexo2c_hist[tt] + dexv_hist[tt+1] <- dexv_hist[tt] + dexvc_hist[tt+1] <- dexvc_hist[tt] + } + } + + ########################## Death compartments + + # Attributables + + cinc_mort_1 <- cumsum(rowSums(param_used["nus"]*param_used["propo2"]*param_used["pdeath_ho"]*dexo2_hist*(out_mean[,(Hindex+1)]%*%ifr[,2]))) + cinc_mort_2 <- cumsum(rowSums(param_used["nus"]*(1-param_used["propo2"])*param_used["pdeath_h"]*(out_mean[,(Hindex+1)]%*%ifr[,2]))) + + cinc_mort_3 <- cumsum(rowSums(param_used["nusc"]*param_used["report_death_HC"]*param_used["propo2"]*param_used["pdeath_hco"]*(out_mean[,(HCindex+1)]%*%ifr[,2]))) + cinc_mort_4 <- cumsum(rowSums(param_used["nusc"]*param_used["report_death_HC"]*(1-param_used["propo2"])*param_used["pdeath_hc"]*(out_mean[,(HCindex+1)]%*%ifr[,2]))) + + cinc_mort_5 <- cumsum(rowSums(param_used["nu_icu"]*param_used["propo2"]*param_used["pdeath_icuo"]*dexo2_hist*(out_mean[,(ICUindex+1)]%*%ifr[,2]))) + cinc_mort_6 <- cumsum(rowSums(param_used["nu_icu"]*(1-param_used["propo2"])*param_used["pdeath_icu"]*(out_mean[,(ICUindex+1)]%*%ifr[,2]))) + + cinc_mort_7 <- cumsum(rowSums(param_used["nu_icuc"]*param_used["propo2"]*param_used["pdeath_icuco"]*dexo2c_hist*(out_mean[,(ICUCindex+1)]%*%ifr[,2]))) + cinc_mort_8 <- cumsum(rowSums(param_used["nu_icuc"]*(1-param_used["propo2"])*param_used["pdeath_icuc"]*(out_mean[,(ICUCindex+1)]%*%ifr[,2]))) + + + cinc_mort_9 <- cumsum(rowSums(param_used["nu_vent"]*param_used["pdeath_vent"]*dexv_hist*(out_mean[,(Ventindex+1)]%*%ifr[,2]))) + cinc_mort_10 <- cumsum(rowSums(param_used["nu_ventc"]*param_used["pdeath_ventc"]*dexvc_hist*(out_mean[,(VentCindex+1)]%*%ifr[,2]))) + cinc_mort_11 <- cumsum(rowSums(param_used["nu_ventc"]*param_used["pdeath_ventc"]*dexvc_hist*(out_mean[,(ICUCVindex+1)]%*%ifr[,2]))) + + cinc_mort_14 <- cumsum(rowSums(param_used["nu_ventc"]*param_used["report_death_HC"]*param_used["pdeath_vent_hc"]*(out_mean[,(HCVindex+1)]%*%ifr[,2]))) + cinc_mort_12 <- cumsum(rowSums(param_used["nu_icuc"] *param_used["report_death_HC"]*param_used["propo2"]*param_used["pdeath_icu_hco"]*(out_mean[,(HCICUindex+1)]%*%ifr[,2]))) + cinc_mort_13 <- cumsum(rowSums(param_used["nu_icuc"] *param_used["report_death_HC"]*(1-param_used["propo2"])*param_used["pdeath_icu_hc"]*(out_mean[,(HCICUindex+1)]%*%ifr[,2]))) + + cinc_mort_H1 <- cinc_mort_1 + cinc_mort_2 + cinc_mort_HC1 <- cinc_mort_3 + cinc_mort_4 + cinc_mort_12 + cinc_mort_13 + cinc_mort_14 + cinc_mort_ICU1 <- cinc_mort_5 + cinc_mort_6 + cinc_mort_ICUC1 <- cinc_mort_7 + cinc_mort_8 + cinc_mort_Vent1 <- cinc_mort_9 + cinc_mort_VentC1 <- cinc_mort_10 + cinc_mort_ICUCV1 <- cinc_mort_11 + + results$death_treated_hospital <- round(cinc_mort_H1) + results$death_untreated_hospital <- round(cinc_mort_HC1) + results$death_treated_icu <- round(cinc_mort_ICU1) + results$death_untreated_icu <- round(cinc_mort_ICUC1) + results$death_treated_ventilator <- round(cinc_mort_Vent1) + results$death_untreated_ventilator <- round(cinc_mort_VentC1)+round(cinc_mort_ICUCV1) + + results$attributable_deaths <- + results$death_treated_hospital + + results$death_untreated_hospital + + results$death_treated_icu + + results$death_untreated_icu + + results$death_treated_ventilator + + results$death_untreated_ventilator + + results$attributable_deaths_end <- last(results$attributable_deaths) + + + # Natural deaths / exposed + + base_mort_H1 <- cumsum(rowSums(out_mean[,(Hindex+1)]%*%mort)) + base_mort_ICU1 <- cumsum(rowSums(out_mean[,(ICUindex+1)]%*%mort)) + base_mort_ICUC1 <- cumsum(rowSums(out_mean[,(ICUCindex+1)]%*%mort)) + base_mort_ICUCV1 <- cumsum(rowSums(out_mean[,(ICUCVindex+1)]%*%mort)) + base_mort_Vent1 <- cumsum(rowSums(out_mean[,(Ventindex+1)]%*%mort)) + base_mort_VentC1 <- cumsum(rowSums(out_mean[,(VentCindex+1)]%*%mort)) + base_mort_Z1 <- cumsum(rowSums(out_mean[,(Zindex+1)]%*%mort)) + + base_mort_HC1 <- cumsum(rowSums(param_used["report_death_HC"]*out_mean[,(HCindex+1)]%*%mort)) + base_mort_HCICU1<- cumsum(rowSums(param_used["report_death_HC"]*out_mean[,(HCICUindex+1)]%*%mort)) + base_mort_HCV1 <- cumsum(rowSums(param_used["report_death_HC"]*out_mean[,(HCVindex+1)]%*%mort)) + + base_mort_I1 <- cumsum(rowSums(param_used["report_natdeathI"]*out_mean[,(Iindex+1)]%*%mort)) + base_mort_QI1 <- cumsum(rowSums(param_used["report_natdeathI"] *out_mean[,(QIindex+1)] %*%mort)) + base_mort_E1 <- cumsum(rowSums(param_used["report_natdeathI"] *out_mean[,(Eindex+1)] %*%mort)) + base_mort_QE1 <- cumsum(rowSums(param_used["report_natdeathI"] *out_mean[,(QEindex+1)] %*%mort)) + base_mort_EV1 <- cumsum(rowSums(param_used["report_natdeathI"] *out_mean[,(EVindex+1)] %*%mort)) + base_mort_EVR1 <- cumsum(rowSums(param_used["report_natdeathI"] *out_mean[,(EVRindex+1)] %*%mort)) + base_mort_ER1 <- cumsum(rowSums(param_used["report_natdeathI"] *out_mean[,(ERindex+1)] %*%mort)) + base_mort_QEV1 <- cumsum(rowSums(param_used["report_natdeathI"] *out_mean[,(QEVindex+1)] %*%mort)) + base_mort_QEVR1 <- cumsum(rowSums(param_used["report_natdeathI"] *out_mean[,(QEVRindex+1)]%*%mort)) + base_mort_QER1 <- cumsum(rowSums(param_used["report_natdeathI"] *out_mean[,(QERindex+1)] %*%mort)) + base_mort_CL1 <- cumsum(rowSums(param_used["report_natdeathCL"]*out_mean[,(CLindex+1)] %*%mort)) + base_mort_QC1 <- cumsum(rowSums(param_used["report_natdeathCL"]*out_mean[,(QCindex+1)] %*%mort)) + base_mort_X1 <- cumsum(rowSums(param_used["report_natdeathCL"]*out_mean[,(Xindex+1)] %*%mort)) + + + + results$death_natural_exposed <- round( + base_mort_H1+ + base_mort_HC1+ + base_mort_ICU1+ + base_mort_ICUC1+ + base_mort_ICUCV1+ + base_mort_Vent1+ + base_mort_VentC1+ + base_mort_Z1+ + base_mort_HCICU1+ + base_mort_HCV1+ + + base_mort_I1 + + base_mort_QI1 + + base_mort_E1 + + base_mort_QE1 + + base_mort_EV1+ + base_mort_EVR1+ + base_mort_ER1 + + base_mort_QEV1 + + base_mort_QEVR1 + + base_mort_QER1 + + base_mort_CL1 + + base_mort_QC1 + + base_mort_X1 + + ) + + # Natural deaths / non-exposed + + base_mort_S1 <- cumsum(rowSums(out_mean[,(Sindex+1)]%*%mort)) + base_mort_V1 <- cumsum(rowSums(out_mean[,(Vindex+1)]%*%mort)) + base_mort_QS1 <- cumsum(rowSums(out_mean[,(QSindex+1)]%*%mort)) + + base_mort_VR1 <- cumsum(rowSums(out_mean[,(VRindex+1)]%*%mort)) + base_mort_QV1 <- cumsum(rowSums(out_mean[,(QVindex+1)]%*%mort)) + + base_mort_R1 <- cumsum(rowSums(out_mean[,(Rindex+1)]%*%mort)) + base_mort_QR1 <- cumsum(rowSums(out_mean[,(QRindex+1)]%*%mort)) + base_mort_QVR1 <- cumsum(rowSums(out_mean[,(QVRindex+1)]%*%mort)) + + results$death_natural_non_exposed <- round( + base_mort_S1+ + base_mort_V1+ + base_mort_QS1+ + base_mort_VR1+ + base_mort_QV1+ + + base_mort_R1+ + base_mort_QR1 + + base_mort_QVR1 + ) + + ########################## Summary + + results$total_reportable_deaths <- + results$attributable_deaths + + results$death_natural_exposed + + results$total_reportable_deaths_end <- + last(results$total_reportable_deaths) + + results$total_deaths <- + results$total_reportable_deaths + + results$death_natural_non_exposed + + results$total_deaths_end <- last(results$total_deaths) + + results$total_cm_deaths_end <- round(last(results$cum_mortality)) + + if (print_death_summary) { + cat(paste("\nDeath count\n\tTotal:", results$total_deaths_end, "\n")) + cat(paste("\t- Attributable:", results$attributable_deaths_end, "(reportable)\n")) + cat(paste("\t- Natural Exposed:", last(results$death_natural_exposed), "(reportable)\n")) + cat(paste("\t- Natural Non-Exposed:", last(results$death_natural_non_exposed), "(non-reportable)\n")) + cat(paste("\tTotal Reportable:", results$total_reportable_deaths_end, "\n")) + cat("Death count (via CM for sum of all reportables):\n") + cat(paste("\tCM:", results$total_cm_deaths_end, "\n")) + } + + return(results) +} + + +# process_ode_outcome <- function(out, iterations,intv_vector){ + +# out_min<-out$min +# out_max<-out$max +# out_mean<-out$mean + +# critH<-c() +# crit<-c() +# critV<-c() + +# for (i in 1:length(times)){ +# critH[i]<-min(1-fH((sum(out_mean[i,(Hindex+1)]))+sum(out_mean[i,(ICUCindex+1)])+sum(out_mean[i,(ICUCVindex+1)])),1) +# crit[i]<-min(1-fICU((sum(out_mean[i,(ICUindex+1)]))+(sum(out_mean[i,(Ventindex+1)]))+(sum(out_mean[i,(VentCindex+1)])))) +# critV[i]<-min(1-fVent((sum(out_mean[i,(Ventindex+1)]))),1) +# } + +# # total population +# pop1<-out_mean[,(Sindex+1)]+out_mean[,(Eindex+1)]+out_mean[,(Iindex+1)]+out_mean[,(CLindex+1)]+out_mean[,(Rindex+1)]+ +# out_mean[,(Xindex+1)]+out_mean[,(Vindex+1)]+out_mean[,(Zindex+1)]+out_mean[,(EVindex+1)]+out_mean[,(ERindex+1)]+out_mean[,(EVRindex+1)]+ +# out_mean[,(QSindex+1)]+out_mean[,(QEindex+1)]+out_mean[,(QIindex+1)]+out_mean[,(QCindex+1)]+out_mean[,(QRindex+1)]+ +# out_mean[,(QVindex+1)]+out_mean[,(QEVindex+1)]+out_mean[,(QERindex+1)]+out_mean[,(QVRindex+1)]+out_mean[,(QEVRindex+1)]+ +# out_mean[,(Hindex+1)]+out_mean[,(HCindex+1)]+out_mean[,(ICUindex+1)]+out_mean[,(ICUCindex+1)]+out_mean[,(ICUCVindex+1)]+ +# out_mean[,(Ventindex+1)]+out_mean[,(VentCindex+1)]+out_mean[,(HCICUindex+1)]++out_mean[,(HCVindex+1)] +# tpop1<-rowSums(pop1) +# time<-as.Date(out_mean[,1]+startdate) + +# dailyinc1<-out$mean_cases # daily incidence +# cuminc1<-out$mean_cum_cases # cumulative incidence +# previcureq1<-rowSums(out_mean[,(Hindex+1)])+ rowSums(out_mean[,(ICUCindex+1)])+rowSums(out_mean[,(ICUCVindex+1)]) # surge beds occupancy +# previcureq21<-rowSums(out_mean[,(ICUindex+1)])+rowSums(out_mean[,(VentCindex+1)]) # icu beds occupancy +# previcureq31<-rowSums(out_mean[,(Ventindex+1)]) # ventilator occupancy +# cmortality1<-rowSums(out_mean[,(CMindex+1)]) # cumulative mortality +# overloadH1<-rowSums(out_mean[,(HCindex+1)]) # requirement for beds +# overloadICU1<-rowSums(out_mean[,(ICUCindex+1)])+rowSums(out_mean[,(HCICUindex+1)]) # requirement for icu beds +# overloadICUV1<-rowSums(out_mean[,(ICUCVindex+1)]) # requirement for ventilators +# overloadVent1<-rowSums(out_mean[,(VentCindex+1)])+rowSums(out_mean[,(HCVindex+1)]) # requirement for ventilators +# ccases1<-rowSums(out_mean[,(Cindex+1)]) # cumulative cases +# reqsurge1<-rowSums(out_mean[,(Hindex+1)])+overloadH1 +# reqicu1<-rowSums(out_mean[,(ICUindex+1)])+overloadICU1 +# reqvent1<-rowSums(out_mean[,(Ventindex+1)])+overloadICUV1+overloadVent1 + + +# ########################## CALCULATE MORTALITY +# dexo2_hist <- rep(0,length(times)) +# dexo2c_hist <- rep(0,length(times)) +# dexv_hist <- rep(0,length(times)) +# dexvc_hist <- rep(0,length(times)) +# for (tt in times) { +# if(tt < max(times)){ +# if(intv_vector$dex[tt*20+1]) { +# dexo2_hist[tt+1] <- parameters["dexo2"] +# dexo2c_hist[tt+1] <- parameters["dexo2c"] +# dexv_hist[tt+1] <- parameters["dexv"] +# dexvc_hist[tt+1] <- parameters["dexvc"] +# } else { +# dexo2_hist[tt+1] <- 1 +# dexo2c_hist[tt+1] <- 1 +# dexv_hist[tt+1] <- 1 +# dexvc_hist[tt+1] <- 1 +# } +# } else { +# dexo2_hist[tt+1] <- dexo2_hist[tt] +# dexo2c_hist[tt+1] <- dexo2c_hist[tt] +# dexv_hist[tt+1] <- dexv_hist[tt] +# dexvc_hist[tt+1] <- dexvc_hist[tt] +# } +# } + +# cinc_mort_1 <- cumsum(rowSums(parameters["nus"]*parameters["propo2"]*parameters["pdeath_ho"]*dexo2_hist*(out_mean[,(Hindex+1)]%*%ifr[,2]))) +# cinc_mort_2 <- cumsum(rowSums(parameters["nus"]*(1-parameters["propo2"])*parameters["pdeath_h"]*(out_mean[,(Hindex+1)]%*%ifr[,2]))) + +# cinc_mort_3 <- cumsum(rowSums(parameters["nusc"]*parameters["report_death_HC"]*parameters["propo2"]*parameters["pdeath_hco"]*(out_mean[,(HCindex+1)]%*%ifr[,2]))) +# cinc_mort_4 <- cumsum(rowSums(parameters["nusc"]*parameters["report_death_HC"]*(1-parameters["propo2"])*parameters["pdeath_hc"]*(out_mean[,(HCindex+1)]%*%ifr[,2]))) + +# cinc_mort_5 <- cumsum(rowSums(parameters["nu_icu"]*parameters["propo2"]*parameters["pdeath_icuo"]*dexo2_hist*(out_mean[,(ICUindex+1)]%*%ifr[,2]))) +# cinc_mort_6 <- cumsum(rowSums(parameters["nu_icu"]*(1-parameters["propo2"])*parameters["pdeath_icu"]*(out_mean[,(ICUindex+1)]%*%ifr[,2]))) +# cinc_mort_7 <- cumsum(rowSums(parameters["nu_icuc"]*parameters["propo2"]*parameters["pdeath_icuco"]*dexo2c_hist*(out_mean[,(ICUCindex+1)]%*%ifr[,2]))) +# cinc_mort_8 <- cumsum(rowSums(parameters["nu_icuc"]*(1-parameters["propo2"])*parameters["pdeath_icuc"]*(out_mean[,(ICUCindex+1)]%*%ifr[,2]))) + +# cinc_mort_9 <- cumsum(rowSums(parameters["nu_vent"]*parameters["pdeath_vent"]*dexv_hist*(out_mean[,(Ventindex+1)]%*%ifr[,2]))) +# cinc_mort_10 <- cumsum(rowSums(parameters["nu_ventc"]*parameters["pdeath_ventc"]*dexvc_hist*(out_mean[,(VentCindex+1)]%*%ifr[,2]))) +# cinc_mort_11 <- cumsum(rowSums(parameters["nu_ventc"]*parameters["pdeath_ventc"]*dexvc_hist*(out_mean[,(ICUCVindex+1)]%*%ifr[,2]))) + +# cinc_mort_12 <- cumsum(rowSums(parameters["nusc"]*parameters["report_death_HC"]*parameters["propo2"]*parameters["pdeath_icu_hco"]*(out_mean[,(HCICUindex+1)]%*%ifr[,2]))) +# cinc_mort_13 <- cumsum(rowSums(parameters["nusc"]*parameters["report_death_HC"]*(1-parameters["propo2"])*parameters["pdeath_icu_hc"]*(out_mean[,(HCICUindex+1)]%*%ifr[,2]))) +# cinc_mort_14 <- cumsum(rowSums(parameters["nu_ventc"]*parameters["report_death_HC"]*parameters["pdeath_vent_hc"]*(out_mean[,(HCVindex+1)]%*%ifr[,2]))) + +# cinc_mort_H1 <- cinc_mort_1 + cinc_mort_2 +# cinc_mort_HC1 <- cinc_mort_3 + cinc_mort_4 + cinc_mort_12 + cinc_mort_13 + cinc_mort_14 +# cinc_mort_ICU1 <- cinc_mort_5 + cinc_mort_6 +# cinc_mort_ICUC1 <- cinc_mort_7 + cinc_mort_8 +# cinc_mort_Vent1 <- cinc_mort_9 +# cinc_mort_VentC1 <- cinc_mort_10 +# cinc_mort_ICUCV1 <- cinc_mort_11 + +# base_mort_H1 <- cumsum(rowSums(out_mean[,(Hindex+1)]%*%mort)) +# base_mort_HC1 <- cumsum(rowSums(parameters["report_death_HC"]*out_mean[,(HCindex+1)]%*%mort)) +# base_mort_ICU1 <- cumsum(rowSums(out_mean[,(ICUindex+1)]%*%mort)) +# base_mort_ICUC1 <- cumsum(rowSums(out_mean[,(ICUCindex+1)]%*%mort)) +# base_mort_ICUCV1 <- cumsum(rowSums(out_mean[,(ICUCVindex+1)]%*%mort)) +# base_mort_Vent1 <- cumsum(rowSums(out_mean[,(Ventindex+1)]%*%mort)) +# base_mort_VentC1 <- cumsum(rowSums(out_mean[,(VentCindex+1)]%*%mort)) +# base_mort_Z1 <- cumsum(rowSums(out_mean[,(Zindex+1)]%*%mort)) +# base_mort_HCICU1 <- cumsum(rowSums(parameters["report_death_HC"]*out_mean[,(HCICUindex+1)]%*%mort)) +# base_mort_HCV1 <- cumsum(rowSums(parameters["report_death_HC"]*out_mean[,(HCVindex+1)]%*%mort)) + +# base_mort_V1 <- cumsum(rowSums(out_mean[,(Vindex+1)]%*%mort)) +# base_mort_S1 <- cumsum(rowSums(out_mean[,(Sindex+1)]%*%mort)) +# base_mort_QS1 <- cumsum(rowSums(out_mean[,(QSindex+1)]%*%mort)) +# base_mort_QR1 <- cumsum(rowSums(out_mean[,(QRindex+1)]%*%mort)) +# base_mort_R1 <- cumsum(rowSums(out_mean[,(Rindex+1)]%*%mort)) +# base_mort_QVR1 <- cumsum(rowSums(out_mean[,(QVRindex+1)]%*%mort)) +# base_mort_VR1 <- cumsum(rowSums(out_mean[,(VRindex+1)]%*%mort)) +# base_mort_QV1 <- cumsum(rowSums(out_mean[,(QVindex+1)]%*%mort)) + +# base_mort_E1 <- cumsum(rowSums(parameters["report_natdeathI"]*out_mean[,(Eindex+1)]%*%mort)) +# base_mort_I1 <- cumsum(rowSums(parameters["report_natdeathI"]*out_mean[,(Iindex+1)]%*%mort)) +# base_mort_CL1 <- cumsum(rowSums(parameters["report_natdeathCL"]*out_mean[,(CLindex+1)]%*%mort)) +# base_mort_X1 <- cumsum(rowSums(parameters["report_natdeathCL"]*out_mean[,(Xindex+1)]%*%mort)) +# base_mort_QE1 <- cumsum(rowSums(parameters["report_natdeathI"]*out_mean[,(QEindex+1)]%*%mort)) +# base_mort_QI1 <- cumsum(rowSums(parameters["report_natdeathI"]*out_mean[,(QIindex+1)]%*%mort)) +# base_mort_QC1 <- cumsum(rowSums(parameters["report_natdeathCL"]*out_mean[,(QCindex+1)]%*%mort)) +# base_mort_ER1 <- cumsum(rowSums(parameters["report_natdeathI"]*out_mean[,(ERindex+1)]%*%mort)) +# base_mort_EV1 <- cumsum(rowSums(parameters["report_natdeathI"]*out_mean[,(EVindex+1)]%*%mort)) +# base_mort_EVR1 <- cumsum(rowSums(parameters["report_natdeathI"]*out_mean[,(EVRindex+1)]%*%mort)) +# base_mort_QEV1 <- cumsum(rowSums(parameters["report_natdeathI"]*out_mean[,(QEVindex+1)]%*%mort)) +# base_mort_QER1 <- cumsum(rowSums(parameters["report_natdeathI"]*out_mean[,(QERindex+1)]%*%mort)) +# base_mort_QEVR1 <- cumsum(rowSums(parameters["report_natdeathI"]*out_mean[,(QEVRindex+1)]%*%mort)) + + +# # Export in a cohesive format ---- +# results <- list() +# results$time <- startdate + times # dates +# results$Rt <- out$mean_Rt +# results$cum_mortality <- round(cmortality1) # cumulative mortality +# results$pct_total_pop_infected <- out$mean_infections +# results$doubling_time <- round(log(2)*7 / (log(dailyinc1[2+7] / dailyinc1[2])), 2) # (Baseline only) to double the number of infections at inception +# results$required_beds <- round(previcureq1) # required beds +# results$saturation <- parameters["beds_available"] # saturation +# results$daily_incidence <- round(dailyinc1) # daily incidence (Reported) +# results$daily_total_cases <- round(out$mean_daily_infection) # daily incidence (Reported + Unreported) # daily incidence (Reported + Unreported) +# results$hospital_surge_beds <- round(previcureq1) +# results$icu_beds <- round(previcureq21) +# results$ventilators <- round(previcureq31) +# results$normal_bed_requirement <- round(reqsurge1) #real required beds. previcureq1 above is the occupancy +# results$icu_bed_requirement <- round(reqicu1) +# results$icu_ventilator_requirement <- round(reqvent1) + +# results$death_natural_non_exposed <- round(base_mort_S1+base_mort_V1+base_mort_QS1) +# results$death_natural_exposed <- round(base_mort_E1 + base_mort_I1 + base_mort_CL1 + base_mort_X1 + +# base_mort_R1+ base_mort_ER1 + base_mort_EV1+ base_mort_EVR1+ +# base_mort_QE1 + base_mort_QI1 + base_mort_QC1 + base_mort_QR1 + +# base_mort_QEV1 + base_mort_QER1 + base_mort_QEVR1 + base_mort_QVR1 + +# base_mort_H1+base_mort_HC1+base_mort_ICU1+base_mort_ICUC1+base_mort_ICUCV1+ +# base_mort_Vent1+base_mort_VentC1+base_mort_HCICU1+base_mort_HCV1) +# results$death_treated_hospital <- round(cinc_mort_H1) +# results$death_treated_icu <- round(cinc_mort_ICU1) +# results$death_treated_ventilator <- round(cinc_mort_Vent1) +# results$death_untreated_hospital <- round(cinc_mort_HC1) +# results$death_untreated_icu <- round(cinc_mort_ICUC1) +# results$death_untreated_ventilator <- round(cinc_mort_VentC1)+round(cinc_mort_ICUCV1) +# results$attributable_deaths <- results$death_treated_hospital + results$death_treated_icu + results$death_treated_ventilator + +# results$death_untreated_hospital + results$death_untreated_icu + results$death_untreated_ventilator +# results$attributable_deaths_end <- last(results$attributable_deaths) +# results$total_deaths <- results$attributable_deaths + results$death_natural_non_exposed + results$death_natural_exposed +# results$total_deaths_end <- last(results$total_deaths) +# results$total_reported_deaths_end <- last(results$cum_mortality) +# results$base_mort_H <- base_mort_H1 +# results$base_mort_HC <- base_mort_HC1 +# results$base_mort_ICU <- base_mort_ICU1 +# results$base_mort_ICUC <- base_mort_ICUC1 +# results$base_mort_ICUCV <- base_mort_ICUCV1 +# results$base_mort_Vent <- base_mort_Vent1 +# results$base_mort_VentC <- base_mort_VentC1 +# results$base_mort_S <- base_mort_S1 +# results$base_mort_E <- base_mort_E1 +# results$base_mort_I <- base_mort_I1 +# results$base_mort_CL <- base_mort_CL1 +# results$base_mort_X <- base_mort_X1 +# results$base_mort_QS <- base_mort_QS1 +# results$base_mort_QE <- base_mort_QE1 +# results$base_mort_QI <- base_mort_QI1 +# results$base_mort_QC <- base_mort_QC1 +# results$base_mort_QR <- base_mort_QR1 +# results$base_mort_R <- base_mort_R1 +# results$base_mort_V <- base_mort_V1 +# results$base_mort_EV <- base_mort_EV1 +# results$base_mort_ER <- base_mort_ER1 +# results$base_mort_EVR <- base_mort_EVR1 +# results$base_mort_QV <- base_mort_QV1 +# results$base_mort_QEV <- base_mort_QEV1 +# results$base_mort_QER <- base_mort_QER1 +# results$base_mort_QEVR <- base_mort_QEVR1 +# results$base_mort_QVR <- base_mort_QVR1 +# results$base_mort_QVR <- base_mort_QVR1 +# results$base_mort_HCICU <- base_mort_HCICU1 +# results$base_mort_HCV <- base_mort_HCV1 + +# ## AGE DEPENDENT MORTALITY +# cinc_mort_H1 <- parameters["nus"]*parameters["pdeath_h"]*(out_mean[,(Hindex+1)]) +# cinc_mort_HC1 <- parameters["nusc"]*parameters["pdeath_hc"]*(out_mean[,(HCindex+1)]) +# cinc_mort_ICU1 <- parameters["nu_icu"]*parameters["pdeath_icu"]*out_mean[,(ICUindex+1)] +# cinc_mort_ICUC1 <- parameters["nu_icuc"]*parameters["pdeath_icuc"]*out_mean[,(ICUCindex+1)] +# cinc_mort_ICUCV1 <- parameters["nu_ventc"]*parameters["pdeath_ventc"]*out_mean[,(ICUCVindex+1)] +# cinc_mort_Vent1 <- parameters["nu_vent"]*parameters["pdeath_vent"]*out_mean[,(Ventindex+1)] +# cinc_mort_VentC1 <- parameters["nu_ventc"]*parameters["pdeath_ventc"]*out_mean[,(VentCindex+1)] +# totage1<-as.data.frame(cinc_mort_H1+cinc_mort_HC1+cinc_mort_ICU1+cinc_mort_ICUC1+cinc_mort_ICUCV1+cinc_mort_Vent1+cinc_mort_VentC1) +# basemort_H1<-(out_mean[,(Hindex+1)]) +# basemort_HC1<-(out_mean[,(HCindex+1)]) +# basemort_ICU1<-(out_mean[,(ICUindex+1)]) +# basemort_ICUC1<-(out_mean[,(ICUCindex+1)]) +# basemort_ICUCV1<-(out_mean[,(ICUCVindex+1)]) +# basemort_Vent1<-(out_mean[,(Ventindex+1)]) +# basemort_VentC1<-(out_mean[,(VentCindex+1)]) +# totbase1<-as.data.frame(basemort_H1+basemort_HC1+basemort_ICU1+basemort_ICUC1+basemort_ICUCV1+basemort_Vent1+basemort_VentC1) +# tc<-c() + +# for (i in 1:dim(cinc_mort_H1)[1]) { +# for (j in 1:dim(cinc_mort_H1)[2]) { +# tc<-rbind(tc,c(i, j, totage1[i,j]*ifr[j,2]+totbase1[i,j]*mort[j])) +# } +# } +# tc<-as.data.frame(tc) +# colnames(tc)<-c("Day","Age","value") + +# results$tc <- tc %>% +# mutate(Date = startdate + Day, +# age_cat = case_when( +# Age >= 1 & Age <= 6 ~ "≤ 30 y.o.", +# Age > 6 & Age <= 8 ~ "30-40 y.o.", +# Age > 8 & Age <= 10 ~ "40-50 y.o.", +# Age > 10 & Age <= 12 ~ "50-60 y.o.", +# Age > 12 & Age <= 14 ~ "60-70 y.o.", +# Age >= 15 ~ "≥ 70 y.o.")) %>% +# mutate(age_cat = factor(age_cat, levels = rev(c("≤ 30 y.o.", "30-40 y.o.", +# "40-50 y.o.", "50-60 y.o.", "60-70 y.o.", "≥ 70 y.o.")))) + +# mortality_lag <- data.frame(Age = popstruc$agefloor) +# if(nrow(out_mean) >= 30) mortality_lag <- bind_cols(mortality_lag, +# data.frame(day30 = out_mean[30,CMindex+1]/out_mean[30,Cindex+1]) %>% +# mutate(day30 = ifelse(is.infinite(day30), 0, day30)) %>% +# rename(`Day 30` = day30)) +# if(nrow(out_mean) >= 60) mortality_lag <- bind_cols(mortality_lag, +# data.frame(day60 = out_mean[60,CMindex+1]/out_mean[60,Cindex+1]) %>% +# mutate(day60 = ifelse(is.infinite(day60), 0, day60)) %>% +# rename(`Day 60` = day60)) +# if(nrow(out_mean) >= 90) mortality_lag <- bind_cols(mortality_lag, +# data.frame(day90 = out_mean[90,CMindex+1]/out_mean[90,Cindex+1]) %>% +# mutate(day90 = ifelse(is.infinite(day90), 0, day90)) %>% +# rename(`Day 90` = day90)) +# if(nrow(out_mean) >= 120) mortality_lag <- bind_cols(mortality_lag, +# data.frame(day120 = out_mean[120,CMindex+1]/out_mean[120,Cindex+1]) %>% +# mutate(day120 = ifelse(is.infinite(day120), 0, day120)) %>% +# rename(`Day 120` = day120)) + +# results$mortality_lag <- mortality_lag + + +# if(iterations>1){ + +# previcureq1_max<-rowSums(out_max[,(Hindex+1)])+ rowSums(out_max[,(ICUCindex+1)])+rowSums(out_max[,(ICUCVindex+1)]) # surge beds occupancy +# previcureq21_max<-rowSums(out_max[,(ICUindex+1)])+rowSums(out_max[,(VentCindex+1)]) # icu beds occupancy +# previcureq31_max<-rowSums(out_max[,(Ventindex+1)]) # ventilator occupancy +# cmortality1_max<-rowSums(out_max[,(CMindex+1)]) # cumulative mortality +# overloadH1_max<-rowSums(out_max[,(HCindex+1)]) # requirement for beds +# overloadICU1_max<-rowSums(out_max[,(ICUCindex+1)])+ rowSums(out_max[,(HCICUindex+1)]) # requirement for icu beds +# overloadICUV1_max<-rowSums(out_max[,(ICUCVindex+1)])+ rowSums(out_max[,(HCVindex+1)]) # requirement for ventilators +# overloadVent1_max<-rowSums(out_max[,(VentCindex+1)]) # requirement for ventilators +# ccases1_max<-rowSums(out_max[,(Cindex+1)]) # cumulative cases +# reqsurge1_max<-rowSums(out_max[,(Hindex+1)])+overloadH1 # surge beds total requirements +# reqicu1_max<-rowSums(out_max[,(ICUindex+1)])+overloadICU1 # ICU beds total requirements +# reqvent1_max<-rowSums(out_max[,(Ventindex+1)])+overloadICUV1+overloadVent1 # ventilator beds total requirements + +# previcureq1_min<-rowSums(out_min[,(Hindex+1)])+rowSums(out_min[,(ICUCindex+1)])+rowSums(out_min[,(ICUCVindex+1)]) # surge beds occupancy +# previcureq21_min<-rowSums(out_min[,(ICUindex+1)])+rowSums(out_min[,(VentCindex+1)]) # icu beds occupancy +# previcureq31_min<-rowSums(out_min[,(Ventindex+1)]) # ventilator occupancy +# cmortality1_min<-rowSums(out_min[,(CMindex+1)]) # cumulative mortality +# overloadH1_min<-rowSums(out_min[,(HCindex+1)]) # requirement for beds +# overloadICU1_min<-rowSums(out_min[,(ICUCindex+1)]) # requirement for icu beds +# overloadICUV1_min<-rowSums(out_min[,(ICUCVindex+1)]) # requirement for ventilators +# overloadVent1_min<-rowSums(out_min[,(VentCindex+1)]) # requirement for ventilators +# ccases1_min<-rowSums(out_min[,(Cindex+1)]) # cumulative cases +# reqsurge1_min<-rowSums(out_min[,(Hindex+1)])+overloadH1 # surge beds total requirements +# reqicu1_min<-rowSums(out_min[,(ICUindex+1)])+overloadICU1 # ICU beds total requirements +# reqvent1_min<-rowSums(out_min[,(Ventindex+1)])+overloadICUV1+overloadVent1 # ventilator beds total requirements + +# results$Rt_max <- out$max_Rt +# results$Rt_min <- out$min_Rt + +# results$daily_incidence_max <- out$max_cases +# results$daily_incidence_min <- out$min_cases + +# results$daily_total_cases_max <- out$max_daily_infection +# results$daily_total_cases_min <- out$min_daily_infection + +# results$total_reported_deaths_end_min <- last(cmortality1_min) +# results$total_reported_deaths_end_max <- last(cmortality1_max) + +# results$pct_total_pop_infected_min <- out$min_infections # proportion of the population that has been infected at the end of the simulation +# results$pct_total_pop_infected_max <- out$max_infections # proportion of the population that has been infected at the end of the simulation +# } +# return(results) +# } + diff --git a/r_versions/covidage_v13.13.R b/r_versions/covidage_v13.13.R deleted file mode 100644 index a8c3a99..0000000 --- a/r_versions/covidage_v13.13.R +++ /dev/null @@ -1,1386 +0,0 @@ -rm(list = ls()) - -library("deSolve") -library("ggplot2") -library("dplyr") -library("reshape2") -require("gridExtra") -# library(ggpubr) -# library(bsplus) -# library(deSolve) -# library(DT) -# library(highcharter) -# library(lubridate) -# library(pushbar) -library(readxl) -# library(reshape2) -# library(scales) -# library(shiny) -# library(shinyBS) -# library(shinycssloaders) -# library(shinyhelper) -# library(shinythemes) -# library(shinyWidgets) -# library(tidyverse) -# library(XLConnect) -library("comoOdeCpp") - -#read data from excel file -setwd("/home/bogao/Projects/como/comoOdeCpp") -load("./data/data_CoMo.RData") -file_path <- paste0(getwd(),"/data/Template_CoMoCOVID-19App_new.xlsx") -# file_path <- paste0(getwd(),"/data/Template_CoMoCOVID-19App_new_1.xlsx") -country_name<-"Cambodia" - -# Cases -dta <- read_excel(file_path, sheet = "Cases") -names(dta) <- c("date", "cases", "deaths") - -cases_rv <- dta %>% - mutate(date = as.Date(date), cumulative_death = cumsum(deaths)) %>% - as.data.frame() - -# Severity/Mortality -dta <- read_excel(file_path, sheet = "Severity-Mortality") -names(dta) <- c("age_category", "ifr", "ihr") - -mort_sever_rv <- dta %>% - mutate(ihr = ihr/100) %>% # starting unit should be % - scaling to a value between 0 and 1 - mutate(ifr = ifr/max(ifr)) # starting unit should be % - scaling to a value between 0 and 1 - -# Population -dta <- read_excel(file_path, sheet = "Population") -names(dta) <- c("age_category", "pop", "birth", "death") - -population_rv <- dta %>% - transmute(country = NA, age_category, pop, birth, death) - -# Parameters -param <- bind_rows(read_excel(file_path, sheet = "Parameters"), - read_excel(file_path, sheet = "Country Area Param"), - read_excel(file_path, sheet = "Virus Param"), - read_excel(file_path, sheet = "Hospitalisation Param"), - read_excel(file_path, sheet = "Interventions Param"), - read_excel(file_path, sheet = "Interventions")) %>% - mutate(Value_Date = as.Date(Value_Date)) - -# START Bridge ---- -popstruc <- population_rv %>% - select(age_category, pop) %>% - rename(agefloor = age_category) %>% - as.data.frame() - -popbirth <- population_rv %>% - select(age_category, birth) %>% - as.data.frame() # unit should be per person per day - -mort <- population_rv %>% - pull(death) # unit should be per person per day - -ihr <- mort_sever_rv %>% - select(age_category, ihr) %>% - as.data.frame() - -ifr <- mort_sever_rv %>% - select(age_category, ifr) %>% - as.data.frame() - - -######### POP AGEING -# per year ageing matrix -A<-length(popstruc[,2]) -dd<-seq(1:A)/seq(1:A) -ageing <- t(diff(diag(dd),lag=1)/(5*365.25)) -ageing<-cbind(ageing,0*seq(1:A)) # no ageing from last compartment - -# -pop<-population$country==country_name -pp<-population$pop[pop] -### CONTACT MATRICES -c_home <- contact_home[[country_name]] %>% as.matrix() -c_school <- contact_school[[country_name]] %>% as.matrix() -c_work <- contact_work[[country_name]] %>% as.matrix() -c_other <- contact_other[[country_name]] %>% as.matrix() -nce <-A-length(c_home[1,]) - -contact_home<-matrix(0,nrow=A,ncol=A) -contact_school<-matrix(0,nrow=A,ncol=A) -contact_work<-matrix(0,nrow=A,ncol=A) -contact_other<-matrix(0,nrow=A,ncol=A) - -for (i in 1:(A-nce)){ - for (j in 1:(A-nce)){ - contact_home[i,j]<-c_home[i,j] - contact_school[i,j]<-c_school[i,j] - contact_work[i,j]<-c_work[i,j] - contact_other[i,j]<-c_other[i,j] - } -} - -for (i in (A+1-nce):A){ - for (j in 1:(A-nce)){ - contact_home[i,j]<-c_home[(A-nce),j] - contact_school[i,j]<-c_school[(A-nce),j] - contact_work[i,j]<-c_work[(A-nce),j] - contact_other[i,j]<-c_other[(A-nce),j] - } -} -for (i in 1:(A-nce)){ - for (j in (A+1-nce):A){ - contact_home[i,j]<-c_home[i,(A-nce)] - contact_school[i,j]<-c_school[i,(A-nce)] - contact_work[i,j]<-c_work[i,(A-nce)] - contact_other[i,j]<-c_other[i,(A-nce)] - } -} -for (i in (A+1-nce):A){ - for (j in (A+1-nce):A){ - contact_home[i,j]<-c_home[(A-nce),(A-nce)] - contact_school[i,j]<-c_school[(A-nce),(A-nce)] - contact_work[i,j]<-c_work[(A-nce),(A-nce)] - contact_other[i,j]<-c_other[(A-nce),(A-nce)] - } -} - - - -######### INITIALISE SIMULATION/INTERVENTION START TIMES -startdate <- param$Value_Date[param$Parameter == "date_range_simul_start"] -stopdate <- param$Value_Date[param$Parameter == "date_range_simul_end"] -startdate <- startdate[1] -stopdate <- stopdate[1] - - -day_start <- as.numeric(startdate-startdate) -day_stop <- as.numeric(stopdate-startdate) -times <- seq(day_start, day_stop) - -tin<-as.numeric(startdate-as.Date("2020-01-01"))/365.25 -initP<-sum(popstruc[,2]) # population size -ageindcase<-20 # age of index case (years) -aci <- floor((ageindcase/5)+1) # age class of index case - - -############# DEFINE PARAMETERS -parameters <- c( - ### Transmission instrinsic - p = param$Value[param$Parameter=="p"][1], - rho = param$Value[param$Parameter=="rho"][1], - omega = param$Value[param$Parameter=="omega"][1], - gamma = param$Value[param$Parameter=="gamma"][1], - nui = param$Value[param$Parameter=="nui"][1], - report = param$Value[param$Parameter=="report"][1], - reportc = param$Value[param$Parameter=="reportc"][1], - reporth = param$Value[param$Parameter=="reporth"][1], - beds_available = param$Value[param$Parameter=="beds_available"][1], - icu_beds_available = param$Value[param$Parameter=="icu_beds_available"][1], - ventilators_available = param$Value[param$Parameter=="ventilators_available"][1], - give = 95, - pdeath_h = param$Value[param$Parameter=="pdeath_h"][1], - pdeath_hc = param$Value[param$Parameter=="pdeath_hc"][1], - pdeath_icu = param$Value[param$Parameter=="pdeath_icu"][1], - pdeath_icuc = param$Value[param$Parameter=="pdeath_icuc"][1], - pdeath_vent = param$Value[param$Parameter=="pdeath_vent"][1], - pdeath_ventc = param$Value[param$Parameter=="pdeath_ventc"][1], - ihr_scaling = param$Value[param$Parameter=="ihr_scaling"][1], - nus = param$Value[param$Parameter=="nus"][1], - nusc = param$Value[param$Parameter=="nus"][1], # nusc = nus - nu_icu = param$Value[param$Parameter=="nu_icu"][1], - nu_icuc = param$Value[param$Parameter=="nu_icu"][1], # nu_icuc = nu_icu - nu_vent = param$Value[param$Parameter=="nu_vent"][1], - nu_ventc = param$Value[param$Parameter=="nu_vent"][1], # nu_ventc = nu_vent - rhos = param$Value[param$Parameter=="rhos"][1], - amp = param$Value[param$Parameter=="amp"][1], - phi = param$Value[param$Parameter=="phi"][1], - pclin = param$Value[param$Parameter=="pclin"][1], - prob_icu = param$Value[param$Parameter=="prob_icu"][1], - prob_vent = param$Value[param$Parameter=="prob_vent"][1], - - ### INTERVENTIONS - # self isolation - selfis_eff = mean(param$Value[param$Parameter=="selfis_eff"],na.rm=T), - # social distancing - dist_eff = mean(param$Value[param$Parameter=="dist_eff"],na.rm=T), - # hand washing - hand_eff = mean(param$Value[param$Parameter=="hand_eff"],na.rm=T), - # working at home - work_eff = mean(param$Value[param$Parameter=="work_eff"],na.rm=T), - w2h = mean(param$Value[param$Parameter=="w2h"],na.rm=T), - # school closures - school_eff = mean(param$Value[param$Parameter=="school_eff"],na.rm=T), - s2h = mean(param$Value[param$Parameter=="s2h"],na.rm=T), - # cocooning the elderly - cocoon_eff = mean(param$Value[param$Parameter=="cocoon_eff"],na.rm=T), - age_cocoon = mean(param$Value[param$Parameter=="age_cocoon"],na.rm=T), - # vaccination campaign - # vaccine_on = as.numeric(param$Value_Date[param$Parameter=="date_vaccine_on"] - startdate), - vaccine_eff = mean(param$Value[param$Parameter=="vaccine_eff"],na.rm=T), - # vaccine_cov = param$Value[param$Parameter=="vaccine_cov"], - vac_campaign = mean(param$Value[param$Parameter=="vac_campaign"],na.rm=T), - # travel ban - mean_imports = mean(param$Value[param$Parameter=="mean_imports"],na.rm=T), - # screening - screen_test_sens = mean(param$Value[param$Parameter=="screen_test_sens"],na.rm=T), - # screen_contacts = mean(param$Value[param$Parameter=="screen_contacts"],na.rm=T), - screen_overdispersion = mean(param$Value[param$Parameter=="screen_overdispersion"],na.rm=T), - # voluntary home quarantine - quarantine_days = mean(param$Value[param$Parameter=="quarantine_days"],na.rm=T), - quarantine_effort = mean(param$Value[param$Parameter=="quarantine_effort"],na.rm=T), - quarantine_eff_home = mean(param$Value[param$Parameter=="quarantine_eff_home"],na.rm=T), - quarantine_eff_other = mean(param$Value[param$Parameter=="quarantine_eff_other"],na.rm=T), - - household_size = param$Value[param$Parameter=="household_size"][1] -) -ihr[,2]<- parameters["ihr_scaling"]*ihr[,2] - -# Scale parameters to percentages/ rates -parameters["rho"]<-parameters["rho"]/100 -parameters["omega"]<-(1/(parameters["omega"]*365)) -parameters["gamma"]<-1/parameters["gamma"] -parameters["nui"]<-1/parameters["nui"] -parameters["report"]<-parameters["report"]/100 -parameters["reportc"]<-parameters["reportc"]/100 -parameters["reporth"]<-parameters["reporth"]/100 -parameters["nus"]<-1/parameters["nus"] -parameters["rhos"]<-parameters["rhos"]/100 -parameters["amp"]<-parameters["amp"]/100 -parameters["selfis_eff"]<-parameters["selfis_eff"]/100 -parameters["dist_eff"]<-parameters["dist_eff"]/100 -parameters["hand_eff"]<-parameters["hand_eff"]/100 -parameters["work_eff"]<-parameters["work_eff"]/100 -parameters["w2h"]<-parameters["w2h"]/100 -parameters["school_eff"]<-parameters["school_eff"]/100 -parameters["s2h"]<-parameters["s2h"]/100 -parameters["cocoon_eff"]<-parameters["cocoon_eff"]/100 -parameters["age_cocoon"]<-floor((parameters["age_cocoon"]/5)+1) -parameters["vaccine_eff"]<-parameters["vaccine_eff"]/100 -# parameters["vaccine_cov"]<-parameters["vaccine_cov"]/100 -# parameters["vac_campaign"]<-parameters["vac_campaign"]*7 -parameters["screen_test_sens"]<-parameters["screen_test_sens"]/100 -parameters["quarantine_days"]<-parameters["quarantine_days"] -parameters["quarantine_effort"]<-1/parameters["quarantine_effort"] -parameters["quarantine_eff_home"]<-parameters["quarantine_eff_home"]/-100 -parameters["quarantine_eff_other"]<-parameters["quarantine_eff_other"]/100 -parameters["give"]<-parameters["give"]/100 -parameters["pdeath_h"]<-parameters["pdeath_h"]/100 -parameters["pdeath_hc"]<-parameters["pdeath_hc"]/100 -parameters["pdeath_icu"]<-parameters["pdeath_icu"]/100 -parameters["pdeath_icuc"]<-parameters["pdeath_icuc"]/100 -parameters["pdeath_vent"]<-parameters["pdeath_vent"]/100 -parameters["pdeath_ventc"]<-parameters["pdeath_ventc"]/100 -parameters["nusc"]<-1/parameters["nusc"] -parameters["nu_icu"]<-1/parameters["nu_icu"] -parameters["nu_icuc"]<-1/parameters["nu_icuc"] -parameters["nu_vent"]<-1/parameters["nu_vent"] -parameters["nu_ventc"]<-1/parameters["nu_ventc"] -parameters["pclin"]<-parameters["pclin"]/100 -parameters["prob_icu"]<-parameters["prob_icu"]/100 -parameters["prob_vent"]<-parameters["prob_vent"]/100 -parameters2<-parameters - -########################################################################### -# Define the indices for each variable -Sindex<-1:A -Eindex<-(A+1):(2*A) -Iindex<-(2*A+1):(3*A) -Rindex<-(3*A+1):(4*A) -Xindex<-(4*A+1):(5*A) -Hindex<-(5*A+1):(6*A) -HCindex<-(6*A+1):(7*A) -Cindex<-(7*A+1):(8*A) -CMindex<-(8*A+1):(9*A) -Vindex<-(9*A+1):(10*A) -QSindex<-(10*A+1):(11*A) -QEindex<-(11*A+1):(12*A) -QIindex<-(12*A+1):(13*A) -QRindex<-(13*A+1):(14*A) -CLindex<-(14*A+1):(15*A) -QCindex<-(15*A+1):(16*A) -ICUindex<-(16*A+1):(17*A) -ICUCindex<-(17*A+1):(18*A) -ICUCVindex<-(18*A+1):(19*A) -Ventindex<-(19*A+1):(20*A) -VentCindex<-(20*A+1):(21*A) -CMCindex<-(21*A+1):(22*A) - -########################################################################### -# MODEL INITIAL CONDITIONS -initI<-0*popstruc[,2] # Infected and symptomatic -initE<-0*popstruc[,2] # Incubating -initE[aci]<-1 # place random index case in E compartment -initR<-0*popstruc[,2] # Immune -initX<-0*popstruc[,2] # Isolated -initV<-0*popstruc[,2] # Vaccinated -initQS<-0*popstruc[,2] # quarantined S -initQE<-0*popstruc[,2] # quarantined E -initQI<-0*popstruc[,2] # quarantined I -initQR<-0*popstruc[,2] # quarantined R -initH<-0*popstruc[,2] # hospitalised -initHC<-0*popstruc[,2] # hospital critical -initC<-0*popstruc[,2] # Cumulative cases (true) -initCM<-0*popstruc[,2] # Cumulative deaths (true) -initCL<-0*popstruc[,2] # symptomatic cases -initQC<-0*popstruc[,2] # quarantined C -initICU<-0*popstruc[,2] # icu -initICUC<-0*popstruc[,2] # icu critical -initICUCV<-0*popstruc[,2] # icu critical -initVent<-0*popstruc[,2] # icu vent -initVentC<-0*popstruc[,2] # icu vent crit -initCMC<-0*popstruc[,2] # Cumulative deaths (true) -initS<-popstruc[,2]-initE-initI-initR-initX-initV-initH-initHC-initQS-initQE-initQI-initQR-initCL-initQC-initICU-initICUC-initICUCV-initVent-initVentC # Susceptible (non-immune) - - -inp <- read_excel(file_path, sheet = "Interventions") -inputs<-function(inp, run){ - # cap intervention end dates with simulation end date - # inp$`Date End` = pmin(stopdate, inp$`Date End`) - inp$`Date End` = pmin(stopdate, as.Date(inp$`Date End`)) - - tb<-which(inp$`Apply to`==run) - - si<-intersect(which(inp$Intervention=="Self-isolation if Symptomatic"),tb) - scr<-intersect(which(inp$Intervention=="Screening (when S.I.)"),tb) - sd<-intersect(which(inp$Intervention=="Social Distancing"),tb) - hw<-intersect(which(inp$Intervention=="Handwashing"),tb) - wah<-intersect(which(inp$Intervention=="Working at Home"),tb) - sc<-intersect(which(inp$Intervention=="School Closures"),tb) - cte<-intersect(which(inp$Intervention=="Shielding the Elderly"),tb) - q<-intersect(which(inp$Intervention=="Household Isolation (when S.I.)"),tb) - tb<-intersect(which(inp$Intervention=="International Travel Ban"),tb) - vc<-intersect(which(inp$Intervention=="Vaccination"),tb) - - v<-(format(as.POSIXct(inp$`Date Start`,format='%Y/%m/%d %H:%M:%S'),format="%d/%m/%y")) - v2<-as.Date(v,format="%d/%m/%y") - inp$`Date Start`<-v2 - - v<-(format(as.POSIXct(inp$`Date End`,format='%Y/%m/%d %H:%M:%S'),format="%d/%m/%y")) - v2<-as.Date(v,format="%d/%m/%y") - inp$`Date End`<-v2 - - ## self isolation - f<-c() - si_vector<-c() - isolation<-c() - if (length(si)>=1){ - for (i in 1:length(si)){ - f<-c(f,as.numeric(inp$`Date Start`[si[i]]-startdate),as.numeric(inp$`Date End`[si[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[si[i]]>startdate){ - si_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[si[i]],(f[i+1]-f[i])*20)) - isolation<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - si_vector<-c(rep(inp$`Value`[si[i]],(f[i+1])*20)) - isolation<-c(rep(1,(f[i+1])*20)) - } - } - else{ - si_vector<-c(si_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - si_vector<-c(si_vector,rep(inp$`Value`[si[i]],(f[i*2]-f[i*2-1])*20)) - isolation<-c(isolation,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - isolation<-c(isolation,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(si) && f[i*2]=1){ - for (i in 1:length(sd)){ - - f<-c(f,as.numeric(inp$`Date Start`[sd[i]]-startdate),as.numeric(inp$`Date End`[sd[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[sd[i]]>startdate){ - sd_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[sd[i]],(f[i+1]-f[i])*20)) - distancing<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - sd_vector<-c(rep(inp$`Value`[sd[i]],(f[i+1])*20)) - distancing<-c(rep(1,(f[i+1])*20)) - } - } - else{ - sd_vector<-c(sd_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - sd_vector<-c(sd_vector,rep(inp$`Value`[sd[i]],(f[i*2]-f[i*2-1])*20)) - distancing<-c(distancing,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - distancing<-c(distancing,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(sd)&& f[i*2]=1){ - for (i in 1:length(scr)){ - - f<-c(f,as.numeric(inp$`Date Start`[scr[i]]-startdate),as.numeric(inp$`Date End`[scr[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[scr[i]]>startdate){ - scr_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[scr[i]],(f[i+1]-f[i])*20)) - screen<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - scr_vector<-c(rep(inp$`Value`[scr[i]],(f[i+1])*20)) - screen<-c(rep(1,(f[i+1])*20)) - } - } - else{ - scr_vector<-c(scr_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - scr_vector<-c(scr_vector,rep(inp$`Value`[scr[i]],(f[i*2]-f[i*2-1])*20)) - screen<-c(screen,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - screen<-c(screen,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(scr)&& f[i*2]=1){ - for (i in 1:length(hw)){ - - f<-c(f,as.numeric(inp$`Date Start`[hw[i]]-startdate),as.numeric(inp$`Date End`[hw[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[hw[i]]>startdate){ - hw_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[hw[i]],(f[i+1]-f[i])*20)) - handwash<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - hw_vector<-c(rep(inp$`Value`[hw[i]],(f[i+1])*20)) - handwash<-c(rep(1,(f[i+1])*20)) - } - } - else{ - hw_vector<-c(hw_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - hw_vector<-c(hw_vector,rep(inp$`Value`[hw[i]],(f[i*2]-f[i*2-1])*20)) - handwash<-c(handwash,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - handwash<-c(handwash,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(hw)&& f[i*2]=1){ - for (i in 1:length(wah)){ - - f<-c(f,as.numeric(inp$`Date Start`[wah[i]]-startdate),as.numeric(inp$`Date End`[wah[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[wah[i]]>startdate){ - wah_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[wah[i]],(f[i+1]-f[i])*20)) - workhome<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - wah_vector<-c(rep(inp$`Value`[wah[i]],(f[i+1])*20)) - workhome<-c(rep(1,(f[i+1])*20)) - } - } - else{ - wah_vector<-c(wah_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - wah_vector<-c(wah_vector,rep(inp$`Value`[wah[i]],(f[i*2]-f[i*2-1])*20)) - workhome<-c(workhome,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - workhome<-c(workhome,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(wah)&& f[i*2]=1){ - for (i in 1:length(sc)){ - - f<-c(f,as.numeric(inp$`Date Start`[sc[i]]-startdate),as.numeric(inp$`Date End`[sc[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[sc[i]]>startdate){ - sc_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[sc[i]],(f[i+1]-f[i])*20)) - schoolclose<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - sc_vector<-c(rep(inp$`Value`[sc[i]],(f[i+1])*20)) - schoolclose<-c(rep(1,(f[i+1])*20)) - } - } - else{ - sc_vector<-c(sc_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - sc_vector<-c(sc_vector,rep(inp$`Value`[sc[i]],(f[i*2]-f[i*2-1])*20)) - schoolclose<-c(schoolclose,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - schoolclose<-c(schoolclose,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(sc)&& f[i*2]=1){ - for (i in 1:length(cte)){ - - f<-c(f,as.numeric(inp$`Date Start`[cte[i]]-startdate),as.numeric(inp$`Date End`[cte[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[cte[i]]>startdate){ - cte_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[cte[i]],(f[i+1]-f[i])*20)) - cocoon<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - cte_vector<-c(rep(inp$`Value`[cte[i]],(f[i+1])*20)) - cocoon<-c(rep(1,(f[i+1])*20)) - } - } - else{ - cte_vector<-c(cte_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - cte_vector<-c(cte_vector,rep(inp$`Value`[cte[i]],(f[i*2]-f[i*2-1])*20)) - cocoon<-c(cocoon,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - cocoon<-c(cocoon,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(cte)&& f[i*2]=1){ - for (i in 1:length(q)){ - - f<-c(f,as.numeric(inp$`Date Start`[q[i]]-startdate),as.numeric(inp$`Date End`[q[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[q[i]]>startdate){ - q_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[q[i]],(f[i+1]-f[i])*20)) - quarantine<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - q_vector<-c(rep(inp$`Value`[q[i]],(f[i+1])*20)) - quarantine<-c(rep(1,(f[i+1])*20)) - } - } - else{ - q_vector<-c(q_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - q_vector<-c(q_vector,rep(inp$`Value`[q[i]],(f[i*2]-f[i*2-1])*20)) - quarantine<-c(quarantine,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - quarantine<-c(quarantine,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(q)&& f[i*2]=1){ - for (i in 1:length(tb)){ - - f<-c(f,as.numeric(inp$`Date Start`[tb[i]]-startdate),as.numeric(inp$`Date End`[tb[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[tb[i]]>startdate){ - tb_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[tb[i]],(f[i+1]-f[i])*20)) - travelban<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - tb_vector<-c(rep(inp$`Value`[tb[i]],(f[i+1])*20)) - travelban<-c(rep(1,(f[i+1])*20)) - } - } - else{ - tb_vector<-c(tb_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - tb_vector<-c(tb_vector,rep(inp$`Value`[tb[i]],(f[i*2]-f[i*2-1])*20)) - travelban<-c(travelban,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - travelban<-c(travelban,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(tb)&& f[i*2]=1){ - for (i in 1:length(vc)){ - - f<-c(f,as.numeric(inp$`Date Start`[vc[i]]-startdate),as.numeric(inp$`Date End`[vc[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[vc[i]]>startdate){ - vc_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[vc[i]],(f[i+1]-f[i])*20)) - vaccine<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - vc_vector<-c(rep(inp$`Value`[vc[i]],(f[i+1])*20)) - vaccine<-c(rep(1,(f[i+1])*20)) - } - } - else{ - vc_vector<-c(vc_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - vc_vector<-c(vc_vector,rep(inp$`Value`[vc[i]],(f[i*2]-f[i*2-1])*20)) - vaccine<-c(vaccine,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - vaccine<-c(vaccine,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(vc)&& f[i*2]% - mutate(date = as.Date(date), cumulative_death = cumsum(deaths)) %>% - as.data.frame() - -# Severity/Mortality -dta <- read_excel(file_path, sheet = "Severity-Mortality") -names(dta) <- c("age_category", "ifr", "ihr") - -mort_sever_rv <- dta %>% - mutate(ihr = ihr/100) %>% # starting unit should be % - scaling to a value between 0 and 1 - mutate(ifr = ifr/max(ifr)) # starting unit should be % - scaling to a value between 0 and 1 - -# Population -dta <- read_excel(file_path, sheet = "Population") -names(dta) <- c("age_category", "pop", "birth", "death") - -population_rv <- dta %>% - transmute(country = NA, age_category, pop, birth, death) - -# Parameters -param <- bind_rows(read_excel(file_path, sheet = "Parameters"), - read_excel(file_path, sheet = "Country Area Param"), - read_excel(file_path, sheet = "Virus Param"), - read_excel(file_path, sheet = "Hospitalisation Param"), - read_excel(file_path, sheet = "Interventions Param"), - read_excel(file_path, sheet = "Interventions")) %>% - mutate(Value_Date = as.Date(Value_Date)) - -# START Bridge ---- -popstruc <- population_rv %>% - select(age_category, pop) %>% - rename(agefloor = age_category) %>% - as.data.frame() - -popbirth <- population_rv %>% - select(age_category, birth) %>% - as.data.frame() # unit should be per person per day - -mort <- population_rv %>% - pull(death) # unit should be per person per day - -ihr <- mort_sever_rv %>% - select(age_category, ihr) %>% - as.data.frame() - -ifr <- mort_sever_rv %>% - select(age_category, ifr) %>% - as.data.frame() - - -######### POP AGEING -# per year ageing matrix -A<-length(popstruc[,2]) -dd<-seq(1:A)/seq(1:A) -ageing <- t(diff(diag(dd),lag=1)/(5*365.25)) -ageing<-cbind(ageing,0*seq(1:A)) # no ageing from last compartment - -# -pop<-population$country==country_name -pp<-population$pop[pop] -### CONTACT MATRICES -c_home <- contact_home[[country_name]] %>% as.matrix() -c_school <- contact_school[[country_name]] %>% as.matrix() -c_work <- contact_work[[country_name]] %>% as.matrix() -c_other <- contact_other[[country_name]] %>% as.matrix() -nce <-A-length(c_home[1,]) - -contact_home<-matrix(0,nrow=A,ncol=A) -contact_school<-matrix(0,nrow=A,ncol=A) -contact_work<-matrix(0,nrow=A,ncol=A) -contact_other<-matrix(0,nrow=A,ncol=A) - -for (i in 1:(A-nce)){ - for (j in 1:(A-nce)){ - contact_home[i,j]<-c_home[i,j] - contact_school[i,j]<-c_school[i,j] - contact_work[i,j]<-c_work[i,j] - contact_other[i,j]<-c_other[i,j] - } -} - -for (i in (A+1-nce):A){ - for (j in 1:(A-nce)){ - contact_home[i,j]<-c_home[(A-nce),j] - contact_school[i,j]<-c_school[(A-nce),j] - contact_work[i,j]<-c_work[(A-nce),j] - contact_other[i,j]<-c_other[(A-nce),j] - } -} -for (i in 1:(A-nce)){ - for (j in (A+1-nce):A){ - contact_home[i,j]<-c_home[i,(A-nce)] - contact_school[i,j]<-c_school[i,(A-nce)] - contact_work[i,j]<-c_work[i,(A-nce)] - contact_other[i,j]<-c_other[i,(A-nce)] - } -} -for (i in (A+1-nce):A){ - for (j in (A+1-nce):A){ - contact_home[i,j]<-c_home[(A-nce),(A-nce)] - contact_school[i,j]<-c_school[(A-nce),(A-nce)] - contact_work[i,j]<-c_work[(A-nce),(A-nce)] - contact_other[i,j]<-c_other[(A-nce),(A-nce)] - } -} - - - -######### INITIALISE SIMULATION/INTERVENTION START TIMES -startdate <- param$Value_Date[param$Parameter == "date_range_simul_start"] -stopdate <- param$Value_Date[param$Parameter == "date_range_simul_end"] -startdate <- startdate[1] -stopdate <- stopdate[1] - - -day_start <- as.numeric(startdate-startdate) -day_stop <- as.numeric(stopdate-startdate) -times <- seq(day_start, day_stop) - -tin<-as.numeric(startdate-as.Date("2020-01-01"))/365.25 -initP<-sum(popstruc[,2]) # population size -ageindcase<-20 # age of index case (years) -aci <- floor((ageindcase/5)+1) # age class of index case - - -############# DEFINE PARAMETERS -parameters <- c( - ### Transmission instrinsic - p = param$Value[param$Parameter=="p"][1], - rho = param$Value[param$Parameter=="rho"][1], - omega = param$Value[param$Parameter=="omega"][1], - gamma = param$Value[param$Parameter=="gamma"][1], - nui = param$Value[param$Parameter=="nui"][1], - report = param$Value[param$Parameter=="report"][1], - reportc = param$Value[param$Parameter=="reportc"][1], - reporth = param$Value[param$Parameter=="reporth"][1], - beds_available = param$Value[param$Parameter=="beds_available"][1], - icu_beds_available = param$Value[param$Parameter=="icu_beds_available"][1], - ventilators_available = param$Value[param$Parameter=="ventilators_available"][1], - give = 95, - pdeath_h = param$Value[param$Parameter=="pdeath_h"][1], - pdeath_hc = param$Value[param$Parameter=="pdeath_hc"][1], - pdeath_icu = param$Value[param$Parameter=="pdeath_icu"][1], - pdeath_icuc = param$Value[param$Parameter=="pdeath_icuc"][1], - pdeath_vent = param$Value[param$Parameter=="pdeath_vent"][1], - pdeath_ventc = param$Value[param$Parameter=="pdeath_ventc"][1], - ihr_scaling = param$Value[param$Parameter=="ihr_scaling"][1], - nus = param$Value[param$Parameter=="nus"][1], - nusc = param$Value[param$Parameter=="nus"][1], # nusc = nus - nu_icu = param$Value[param$Parameter=="nu_icu"][1], - nu_icuc = param$Value[param$Parameter=="nu_icu"][1], # nu_icuc = nu_icu - nu_vent = param$Value[param$Parameter=="nu_vent"][1], - nu_ventc = param$Value[param$Parameter=="nu_vent"][1], # nu_ventc = nu_vent - rhos = param$Value[param$Parameter=="rhos"][1], - amp = param$Value[param$Parameter=="amp"][1], - phi = param$Value[param$Parameter=="phi"][1], - pclin = param$Value[param$Parameter=="pclin"][1], - prob_icu = param$Value[param$Parameter=="prob_icu"][1], - prob_vent = param$Value[param$Parameter=="prob_vent"][1], - - ### INTERVENTIONS - # self isolation - selfis_eff = mean(param$Value[param$Parameter=="selfis_eff"],na.rm=T), - # social distancing - dist_eff = mean(param$Value[param$Parameter=="dist_eff"],na.rm=T), - # hand washing - hand_eff = mean(param$Value[param$Parameter=="hand_eff"],na.rm=T), - # working at home - work_eff = mean(param$Value[param$Parameter=="work_eff"],na.rm=T), - w2h = mean(param$Value[param$Parameter=="w2h"],na.rm=T), - # school closures - school_eff = mean(param$Value[param$Parameter=="school_eff"],na.rm=T), - s2h = mean(param$Value[param$Parameter=="s2h"],na.rm=T), - # cocooning the elderly - cocoon_eff = mean(param$Value[param$Parameter=="cocoon_eff"],na.rm=T), - age_cocoon = mean(param$Value[param$Parameter=="age_cocoon"],na.rm=T), - # vaccination campaign - # vaccine_on = as.numeric(param$Value_Date[param$Parameter=="date_vaccine_on"] - startdate), - vaccine_eff = mean(param$Value[param$Parameter=="vaccine_eff"],na.rm=T), - # vaccine_cov = param$Value[param$Parameter=="vaccine_cov"], - vac_campaign = mean(param$Value[param$Parameter=="vac_campaign"],na.rm=T), - # travel ban - mean_imports = mean(param$Value[param$Parameter=="mean_imports"],na.rm=T), - # screening - screen_test_sens = mean(param$Value[param$Parameter=="screen_test_sens"],na.rm=T), - # screen_contacts = mean(param$Value[param$Parameter=="screen_contacts"],na.rm=T), - screen_overdispersion = mean(param$Value[param$Parameter=="screen_overdispersion"],na.rm=T), - # voluntary home quarantine - quarantine_days = mean(param$Value[param$Parameter=="quarantine_days"],na.rm=T), - quarantine_effort = mean(param$Value[param$Parameter=="quarantine_effort"],na.rm=T), - quarantine_eff_home = mean(param$Value[param$Parameter=="quarantine_eff_home"],na.rm=T), - quarantine_eff_other = mean(param$Value[param$Parameter=="quarantine_eff_other"],na.rm=T), - - household_size = param$Value[param$Parameter=="household_size"][1] -) -ihr[,2]<- parameters["ihr_scaling"]*ihr[,2] - -# Scale parameters to percentages/ rates -parameters["rho"]<-parameters["rho"]/100 -parameters["omega"]<-(1/(parameters["omega"]*365)) -parameters["gamma"]<-1/parameters["gamma"] -parameters["nui"]<-1/parameters["nui"] -parameters["report"]<-parameters["report"]/100 -parameters["reportc"]<-parameters["reportc"]/100 -parameters["reporth"]<-parameters["reporth"]/100 -parameters["nus"]<-1/parameters["nus"] -parameters["rhos"]<-parameters["rhos"]/100 -parameters["amp"]<-parameters["amp"]/100 -parameters["selfis_eff"]<-parameters["selfis_eff"]/100 -parameters["dist_eff"]<-parameters["dist_eff"]/100 -parameters["hand_eff"]<-parameters["hand_eff"]/100 -parameters["work_eff"]<-parameters["work_eff"]/100 -parameters["w2h"]<-parameters["w2h"]/100 -parameters["school_eff"]<-parameters["school_eff"]/100 -parameters["s2h"]<-parameters["s2h"]/100 -parameters["cocoon_eff"]<-parameters["cocoon_eff"]/100 -parameters["age_cocoon"]<-floor((parameters["age_cocoon"]/5)+1) -parameters["vaccine_eff"]<-parameters["vaccine_eff"]/100 -# parameters["vaccine_cov"]<-parameters["vaccine_cov"]/100 -# parameters["vac_campaign"]<-parameters["vac_campaign"]*7 -parameters["screen_test_sens"]<-parameters["screen_test_sens"]/100 -parameters["quarantine_days"]<-parameters["quarantine_days"] -parameters["quarantine_effort"]<-1/parameters["quarantine_effort"] -parameters["quarantine_eff_home"]<-parameters["quarantine_eff_home"]/-100 -parameters["quarantine_eff_other"]<-parameters["quarantine_eff_other"]/100 -parameters["give"]<-parameters["give"]/100 -parameters["pdeath_h"]<-parameters["pdeath_h"]/100 -parameters["pdeath_hc"]<-parameters["pdeath_hc"]/100 -parameters["pdeath_icu"]<-parameters["pdeath_icu"]/100 -parameters["pdeath_icuc"]<-parameters["pdeath_icuc"]/100 -parameters["pdeath_vent"]<-parameters["pdeath_vent"]/100 -parameters["pdeath_ventc"]<-parameters["pdeath_ventc"]/100 -parameters["nusc"]<-1/parameters["nusc"] -parameters["nu_icu"]<-1/parameters["nu_icu"] -parameters["nu_icuc"]<-1/parameters["nu_icuc"] -parameters["nu_vent"]<-1/parameters["nu_vent"] -parameters["nu_ventc"]<-1/parameters["nu_ventc"] -parameters["pclin"]<-parameters["pclin"]/100 -parameters["prob_icu"]<-parameters["prob_icu"]/100 -parameters["prob_vent"]<-parameters["prob_vent"]/100 -parameters2<-parameters - -########################################################################### -# Define the indices for each variable -Sindex<-1:A -Eindex<-(A+1):(2*A) -Iindex<-(2*A+1):(3*A) -Rindex<-(3*A+1):(4*A) -Xindex<-(4*A+1):(5*A) -Hindex<-(5*A+1):(6*A) -HCindex<-(6*A+1):(7*A) -Cindex<-(7*A+1):(8*A) -CMindex<-(8*A+1):(9*A) -Vindex<-(9*A+1):(10*A) -QSindex<-(10*A+1):(11*A) -QEindex<-(11*A+1):(12*A) -QIindex<-(12*A+1):(13*A) -QRindex<-(13*A+1):(14*A) -CLindex<-(14*A+1):(15*A) -QCindex<-(15*A+1):(16*A) -ICUindex<-(16*A+1):(17*A) -ICUCindex<-(17*A+1):(18*A) -ICUCVindex<-(18*A+1):(19*A) -Ventindex<-(19*A+1):(20*A) -VentCindex<-(20*A+1):(21*A) -CMCindex<-(21*A+1):(22*A) - -########################################################################### -# MODEL INITIAL CONDITIONS -initI<-0*popstruc[,2] # Infected and symptomatic -initE<-0*popstruc[,2] # Incubating -initE[aci]<-1 # place random index case in E compartment -initR<-0*popstruc[,2] # Immune -initX<-0*popstruc[,2] # Isolated -initV<-0*popstruc[,2] # Vaccinated -initQS<-0*popstruc[,2] # quarantined S -initQE<-0*popstruc[,2] # quarantined E -initQI<-0*popstruc[,2] # quarantined I -initQR<-0*popstruc[,2] # quarantined R -initH<-0*popstruc[,2] # hospitalised -initHC<-0*popstruc[,2] # hospital critical -initC<-0*popstruc[,2] # Cumulative cases (true) -initCM<-0*popstruc[,2] # Cumulative deaths (true) -initCL<-0*popstruc[,2] # symptomatic cases -initQC<-0*popstruc[,2] # quarantined C -initICU<-0*popstruc[,2] # icu -initICUC<-0*popstruc[,2] # icu critical -initICUCV<-0*popstruc[,2] # icu critical -initVent<-0*popstruc[,2] # icu vent -initVentC<-0*popstruc[,2] # icu vent crit -initCMC<-0*popstruc[,2] # Cumulative deaths (true) -initS<-popstruc[,2]-initE-initI-initR-initX-initV-initH-initHC-initQS-initQE-initQI-initQR-initCL-initQC-initICU-initICUC-initICUCV-initVent-initVentC # Susceptible (non-immune) - - -inp <- read_excel(file_path, sheet = "Interventions") -inputs<-function(inp, run){ - # cap intervention end dates with simulation end date - inp$`Date End` = pmin(stopdate, inp$`Date End`) - - tb<-which(inp$`Apply to`==run) - - si<-intersect(which(inp$Intervention=="Self-isolation if Symptomatic"),tb) - scr<-intersect(which(inp$Intervention=="Screening (when S.I.)"),tb) - sd<-intersect(which(inp$Intervention=="Social Distancing"),tb) - hw<-intersect(which(inp$Intervention=="Handwashing"),tb) - wah<-intersect(which(inp$Intervention=="Working at Home"),tb) - sc<-intersect(which(inp$Intervention=="School Closures"),tb) - cte<-intersect(which(inp$Intervention=="Shielding the Elderly"),tb) - q<-intersect(which(inp$Intervention=="Household Isolation (when S.I.)"),tb) - tb<-intersect(which(inp$Intervention=="International Travel Ban"),tb) - vc<-intersect(which(inp$Intervention=="Vaccination"),tb) - - v<-(format(as.POSIXct(inp$`Date Start`,format='%Y/%m/%d %H:%M:%S'),format="%d/%m/%y")) - v2<-as.Date(v,format="%d/%m/%y") - inp$`Date Start`<-v2 - - v<-(format(as.POSIXct(inp$`Date End`,format='%Y/%m/%d %H:%M:%S'),format="%d/%m/%y")) - v2<-as.Date(v,format="%d/%m/%y") - inp$`Date End`<-v2 - - ## self isolation - f<-c() - si_vector<-c() - isolation<-c() - if (length(si)>=1){ - for (i in 1:length(si)){ - f<-c(f,as.numeric(inp$`Date Start`[si[i]]-startdate),as.numeric(inp$`Date End`[si[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[si[i]]>startdate){ - si_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[si[i]],(f[i+1]-f[i])*20)) - isolation<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - si_vector<-c(rep(inp$`Value`[si[i]],(f[i+1])*20)) - isolation<-c(rep(1,(f[i+1])*20)) - } - } - else{ - si_vector<-c(si_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - si_vector<-c(si_vector,rep(inp$`Value`[si[i]],(f[i*2]-f[i*2-1])*20)) - isolation<-c(isolation,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - isolation<-c(isolation,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(si) && f[i*2]=1){ - for (i in 1:length(sd)){ - - f<-c(f,as.numeric(inp$`Date Start`[sd[i]]-startdate),as.numeric(inp$`Date End`[sd[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[sd[i]]>startdate){ - sd_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[sd[i]],(f[i+1]-f[i])*20)) - distancing<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - sd_vector<-c(rep(inp$`Value`[sd[i]],(f[i+1])*20)) - distancing<-c(rep(1,(f[i+1])*20)) - } - } - else{ - sd_vector<-c(sd_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - sd_vector<-c(sd_vector,rep(inp$`Value`[sd[i]],(f[i*2]-f[i*2-1])*20)) - distancing<-c(distancing,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - distancing<-c(distancing,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(sd)&& f[i*2]=1){ - for (i in 1:length(scr)){ - - f<-c(f,as.numeric(inp$`Date Start`[scr[i]]-startdate),as.numeric(inp$`Date End`[scr[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[scr[i]]>startdate){ - scr_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[scr[i]],(f[i+1]-f[i])*20)) - screen<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - scr_vector<-c(rep(inp$`Value`[scr[i]],(f[i+1])*20)) - screen<-c(rep(1,(f[i+1])*20)) - } - } - else{ - scr_vector<-c(scr_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - scr_vector<-c(scr_vector,rep(inp$`Value`[scr[i]],(f[i*2]-f[i*2-1])*20)) - screen<-c(screen,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - screen<-c(screen,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(scr)&& f[i*2]=1){ - for (i in 1:length(hw)){ - - f<-c(f,as.numeric(inp$`Date Start`[hw[i]]-startdate),as.numeric(inp$`Date End`[hw[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[hw[i]]>startdate){ - hw_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[hw[i]],(f[i+1]-f[i])*20)) - handwash<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - hw_vector<-c(rep(inp$`Value`[hw[i]],(f[i+1])*20)) - handwash<-c(rep(1,(f[i+1])*20)) - } - } - else{ - hw_vector<-c(hw_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - hw_vector<-c(hw_vector,rep(inp$`Value`[hw[i]],(f[i*2]-f[i*2-1])*20)) - handwash<-c(handwash,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - handwash<-c(handwash,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(hw)&& f[i*2]=1){ - for (i in 1:length(wah)){ - - f<-c(f,as.numeric(inp$`Date Start`[wah[i]]-startdate),as.numeric(inp$`Date End`[wah[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[wah[i]]>startdate){ - wah_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[wah[i]],(f[i+1]-f[i])*20)) - workhome<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - wah_vector<-c(rep(inp$`Value`[wah[i]],(f[i+1])*20)) - workhome<-c(rep(1,(f[i+1])*20)) - } - } - else{ - wah_vector<-c(wah_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - wah_vector<-c(wah_vector,rep(inp$`Value`[wah[i]],(f[i*2]-f[i*2-1])*20)) - workhome<-c(workhome,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - workhome<-c(workhome,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(wah)&& f[i*2]=1){ - for (i in 1:length(sc)){ - - f<-c(f,as.numeric(inp$`Date Start`[sc[i]]-startdate),as.numeric(inp$`Date End`[sc[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[sc[i]]>startdate){ - sc_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[sc[i]],(f[i+1]-f[i])*20)) - schoolclose<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - sc_vector<-c(rep(inp$`Value`[sc[i]],(f[i+1])*20)) - schoolclose<-c(rep(1,(f[i+1])*20)) - } - } - else{ - sc_vector<-c(sc_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - sc_vector<-c(sc_vector,rep(inp$`Value`[sc[i]],(f[i*2]-f[i*2-1])*20)) - schoolclose<-c(schoolclose,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - schoolclose<-c(schoolclose,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(sc)&& f[i*2]=1){ - for (i in 1:length(cte)){ - - f<-c(f,as.numeric(inp$`Date Start`[cte[i]]-startdate),as.numeric(inp$`Date End`[cte[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[cte[i]]>startdate){ - cte_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[cte[i]],(f[i+1]-f[i])*20)) - cocoon<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - cte_vector<-c(rep(inp$`Value`[cte[i]],(f[i+1])*20)) - cocoon<-c(rep(1,(f[i+1])*20)) - } - } - else{ - cte_vector<-c(cte_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - cte_vector<-c(cte_vector,rep(inp$`Value`[cte[i]],(f[i*2]-f[i*2-1])*20)) - cocoon<-c(cocoon,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - cocoon<-c(cocoon,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(cte)&& f[i*2]=1){ - for (i in 1:length(q)){ - - f<-c(f,as.numeric(inp$`Date Start`[q[i]]-startdate),as.numeric(inp$`Date End`[q[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[q[i]]>startdate){ - q_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[q[i]],(f[i+1]-f[i])*20)) - quarantine<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - q_vector<-c(rep(inp$`Value`[q[i]],(f[i+1])*20)) - quarantine<-c(rep(1,(f[i+1])*20)) - } - } - else{ - q_vector<-c(q_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - q_vector<-c(q_vector,rep(inp$`Value`[q[i]],(f[i*2]-f[i*2-1])*20)) - quarantine<-c(quarantine,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - quarantine<-c(quarantine,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(q)&& f[i*2]=1){ - for (i in 1:length(tb)){ - - f<-c(f,as.numeric(inp$`Date Start`[tb[i]]-startdate),as.numeric(inp$`Date End`[tb[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[tb[i]]>startdate){ - tb_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[tb[i]],(f[i+1]-f[i])*20)) - travelban<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - tb_vector<-c(rep(inp$`Value`[tb[i]],(f[i+1])*20)) - travelban<-c(rep(1,(f[i+1])*20)) - } - } - else{ - tb_vector<-c(tb_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - tb_vector<-c(tb_vector,rep(inp$`Value`[tb[i]],(f[i*2]-f[i*2-1])*20)) - travelban<-c(travelban,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - travelban<-c(travelban,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(tb)&& f[i*2]=1){ - for (i in 1:length(vc)){ - - f<-c(f,as.numeric(inp$`Date Start`[vc[i]]-startdate),as.numeric(inp$`Date End`[vc[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[vc[i]]>startdate){ - vc_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[vc[i]],(f[i+1]-f[i])*20)) - vaccine<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - vc_vector<-c(rep(inp$`Value`[vc[i]],(f[i+1])*20)) - vaccine<-c(rep(1,(f[i+1])*20)) - } - } - else{ - vc_vector<-c(vc_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - vc_vector<-c(vc_vector,rep(inp$`Value`[vc[i]],(f[i*2]-f[i*2-1])*20)) - vaccine<-c(vaccine,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - vaccine<-c(vaccine,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(vc)&& f[i*2]= 7) {Rt[i] <- NA} - } - - # Export in a cohesive format ---- - results <- list() - results$time <- startdate + times # dates - results$Rt <- Rt - results$cum_mortality <- round(cmortality1) # cumulative mortality - results$pct_total_pop_infected <- round(100 * tail(cumsum(rowSums(parameters["gamma"]*out[,(Eindex+1)])),1)/sum(popstruc[,2]), 1) # proportion of the population that has been infected at the end of the simulation - results$doubling_time <- round(log(2)*7 / (log(dailyinc1[2+7] / dailyinc1[2])), 2) # (Baseline only) to double the number of infections at inception - results$required_beds <- round(previcureq1) # required beds - results$saturation <- parameters["beds_available"] # saturation - results$daily_incidence <- round(dailyinc1) # daily incidence (Reported) - results$daily_total_cases <- round(rowSums(parameters["gamma"]*out[,(Eindex+1)]+parameters["gamma"]*out[,(QEindex+1)])) # daily incidence (Reported + Unreported) # daily incidence (Reported + Unreported) - results$hospital_surge_beds <- round(previcureq1) - results$icu_beds <- round(previcureq21) - results$ventilators <- round(previcureq31) - results$normal_bed_requirement <- round(reqsurge1) #real required beds. previcureq1 above is the occupancy - results$icu_bed_requirement <- round(reqicu1) - results$icu_ventilator_requirement <- round(reqvent1) - - results$death_natural_non_exposed <- round(base_mort_S1) - results$death_natural_exposed <- round(base_mort_E1 + base_mort_I1 + base_mort_CL1 + base_mort_X1 + base_mort_QS1 + - base_mort_QE1 + base_mort_QI1 + base_mort_QC1 + base_mort_QR1 + base_mort_R1+ - base_mort_H1+base_mort_HC1+base_mort_ICU1+base_mort_ICUC1+base_mort_ICUCV1+ - base_mort_Vent1+base_mort_VentC1) - results$death_treated_hospital <- round(cinc_mort_H1) - results$death_treated_icu <- round(cinc_mort_ICU1) - results$death_treated_ventilator <- round(cinc_mort_Vent1) - results$death_untreated_hospital <- round(cinc_mort_HC1) - results$death_untreated_icu <- round(cinc_mort_ICUC1) - results$death_untreated_ventilator <- round(cinc_mort_VentC1)+round(cinc_mort_ICUCV1) - results$attributable_deaths <- results$death_treated_hospital + results$death_treated_icu + results$death_treated_ventilator + - results$death_untreated_hospital + results$death_untreated_icu + results$death_untreated_ventilator - results$attributable_deaths_end <- last(results$attributable_deaths) - results$total_deaths <- results$attributable_deaths + results$death_natural_non_exposed + results$death_natural_exposed - results$total_deaths_end <- last(results$total_deaths) - results$total_reported_deaths_end <- last(results$cum_mortality) - results$base_mort_H <- base_mort_H1 - results$base_mort_HC <- base_mort_HC1 - results$base_mort_ICU <- base_mort_ICU1 - results$base_mort_ICUC <- base_mort_ICUC1 - results$base_mort_ICUCV <- base_mort_ICUCV1 - results$base_mort_Vent <- base_mort_Vent1 - results$base_mort_VentC <- base_mort_VentC1 - results$base_mort_S <- base_mort_S1 - results$base_mort_E <- base_mort_E1 - results$base_mort_I <- base_mort_I1 - results$base_mort_CL <- base_mort_CL1 - results$base_mort_X <- base_mort_X1 - results$base_mort_QS <- base_mort_QS1 - results$base_mort_QE <- base_mort_QE1 - results$base_mort_QI <- base_mort_QI1 - results$base_mort_QC <- base_mort_QC1 - results$base_mort_QR <- base_mort_QR1 - results$base_mort_R <- base_mort_R1 - - ## AGE DEPENDENT MORTALITY - cinc_mort_H1 <- parameters["nus"]*parameters["pdeath_h"]*(out[,(Hindex+1)]) - cinc_mort_HC1 <- parameters["nusc"]*parameters["pdeath_hc"]*(out[,(HCindex+1)]) - cinc_mort_ICU1 <- parameters["nu_icu"]*parameters["pdeath_icu"]*out[,(ICUindex+1)] - cinc_mort_ICUC1 <- parameters["nu_icuc"]*parameters["pdeath_icuc"]*out[,(ICUCindex+1)] - cinc_mort_ICUCV1 <- parameters["nu_ventc"]*parameters["pdeath_ventc"]*out[,(ICUCVindex+1)] - cinc_mort_Vent1 <- parameters["nu_vent"]*parameters["pdeath_vent"]*out[,(Ventindex+1)] - cinc_mort_VentC1 <- parameters["nu_ventc"]*parameters["pdeath_ventc"]*out[,(VentCindex+1)] - totage1<-as.data.frame(cinc_mort_H1+cinc_mort_HC1+cinc_mort_ICU1+cinc_mort_ICUC1+cinc_mort_ICUCV1+cinc_mort_Vent1+cinc_mort_VentC1) - basemort_H1<-(out[,(Hindex+1)]) - basemort_HC1<-(out[,(HCindex+1)]) - basemort_ICU1<-(out[,(ICUindex+1)]) - basemort_ICUC1<-(out[,(ICUCindex+1)]) - basemort_ICUCV1<-(out[,(ICUCVindex+1)]) - basemort_Vent1<-(out[,(Ventindex+1)]) - basemort_VentC1<-(out[,(VentCindex+1)]) - totbase1<-as.data.frame(basemort_H1+basemort_HC1+basemort_ICU1+basemort_ICUC1+basemort_ICUCV1+basemort_Vent1+basemort_VentC1) - tc<-c() - - for (i in 1:dim(cinc_mort_H1)[1]) { - for (j in 1:dim(cinc_mort_H1)[2]) { - tc<-rbind(tc,c(i, j, totage1[i,j]*ifr[j,2]+totbase1[i,j]*mort[j])) - } - } - tc<-as.data.frame(tc) - colnames(tc)<-c("Day","Age","value") - - results$tc <- tc %>% - mutate(Date = startdate + Day, - age_cat = case_when( - Age >= 1 & Age <= 6 ~ "≤ 30 y.o.", - Age > 6 & Age <= 8 ~ "30-40 y.o.", - Age > 8 & Age <= 10 ~ "40-50 y.o.", - Age > 10 & Age <= 12 ~ "50-60 y.o.", - Age > 12 & Age <= 14 ~ "60-70 y.o.", - Age >= 15 ~ "≥ 70 y.o.")) %>% - mutate(age_cat = factor(age_cat, levels = rev(c("≤ 30 y.o.", "30-40 y.o.", - "40-50 y.o.", "50-60 y.o.", "60-70 y.o.", "≥ 70 y.o.")))) - - mortality_lag <- data.frame(Age = popstruc$agefloor) - if(nrow(out) >= 30) mortality_lag <- bind_cols(mortality_lag, - data.frame(day30 = out[30,CMindex+1]/out[30,Cindex+1]) %>% - mutate(day30 = ifelse(is.infinite(day30), 0, day30)) %>% - rename(`Day 30` = day30)) - if(nrow(out) >= 60) mortality_lag <- bind_cols(mortality_lag, - data.frame(day60 = out[60,CMindex+1]/out[60,Cindex+1]) %>% - mutate(day60 = ifelse(is.infinite(day60), 0, day60)) %>% - rename(`Day 60` = day60)) - if(nrow(out) >= 90) mortality_lag <- bind_cols(mortality_lag, - data.frame(day90 = out[90,CMindex+1]/out[90,Cindex+1]) %>% - mutate(day90 = ifelse(is.infinite(day90), 0, day90)) %>% - rename(`Day 90` = day90)) - if(nrow(out) >= 120) mortality_lag <- bind_cols(mortality_lag, - data.frame(day120 = out[120,CMindex+1]/out[120,Cindex+1]) %>% - mutate(day120 = ifelse(is.infinite(day120), 0, day120)) %>% - rename(`Day 120` = day120)) - - results$mortality_lag <- mortality_lag - - return(results) -} - -# covidOdeCpp_reset() -# out <- ode(y = Y, times = times, func = covidOdeCpp, parms = parameters2, -# input=vectors, A=A, -# contact_home=contact_home, contact_school=contact_school, -# contact_work=contact_work, contact_other=contact_other, -# popbirth_col2=popbirth[,2], popstruc_col2=popstruc[,2], -# ageing=ageing, -# ifr_col2=ifr[,2], ihr_col2=ihr[,2], mort_col=mort) - -out0 <- ode(y = Y, times = times, method = "euler", hini = 0.05, func = covid, parms = parameters, input=vectors0) -simul_baseline <- process_ode_outcome(out0) -# # write.csv(simul_baseline, paste0(hilo,"_baseline_",gsub(":|-","",Sys.time()),".csv")) - -#future interventions -#extend travel ban, quarantine, hand washing, cocooning the elderly until 1st July -parameters2 <- parameters -out <- ode(y = Y, times = times, method = "euler", hini = 0.05, func = covid, parms = parameters2,input=vectors) -simul_interventions <- process_ode_outcome(out) -# write.csv(simul_interventions, paste0(hilo,"_futureIntv_",gsub(":|-","",Sys.time()),".csv")) - -pop1<-out[,(Sindex+1)]+out[,(Eindex+1)]+out[,(Iindex+1)]+out[,(CLindex+1)]+out[,(Rindex+1)]+out[,(Xindex+1)]+out[,(Vindex+1)]+ - out[,(QSindex+1)]+out[,(QEindex+1)]+out[,(QIindex+1)]+out[,(QCindex+1)]+out[,(QRindex+1)]+ - out[,(Hindex+1)]+out[,(HCindex+1)]+out[,(ICUindex+1)]+out[,(ICUCindex+1)]+out[,(ICUCVindex+1)]+out[,(Ventindex+1)]+out[,(VentCindex+1)] -tpop1<-rowSums(pop1) - -############# PLOTTING -# Fitting tab -# fitting the intervention lines to the data to account for any historical interventions -time<-as.Date(out0[,1]+startdate) -par(mfrow=c(1,2)) -# set up the axis limits -xmin<-min(as.Date(cases_rv[,1])) -xmax<-max(as.Date(cases_rv[,1])) -ymax<-max(cases_rv[,2],na.rm = T) -xtick<-seq(xmin, xmax, by=7) -plot(time,simul_interventions$daily_incidence,type='l',lwd=3, - main="New Reported Cases", xlab="Date", ylab="Cases per day", - xlim=c(xmin,xmax), ylim=c(0,ymax), col='blue',xaxt="n") -axis(side=1, labels = FALSE) -text(x=xtick, y=-250, labels = format(xtick,"%b-%d"), srt = 0, xpd = TRUE) -points(as.Date(cases_rv[,1]),cases_rv[,2],pch=19,col='red') - -# reset the maximum to the cumulative mortality -ymax<-max(cases_rv[,3],na.rm = T) -plot(time,simul_interventions$cum_mortality,type='l',lwd=3, - main="Cumulative Mortality", xlab="Date", ylab="Total deaths", - xlim=c(xmin,xmax), ylim=c(0,ymax), col='blue',xaxt="n") -text(x=xtick, y=-100, labels = format(xtick,"%b-%d"), srt = 0, xpd = TRUE) -points(as.Date(cases_rv[,1]),cases_rv[,3],pch=19,col='red') - - -### Predictions tab -par(mfrow=c(1,2)) -### Cases at baseline and intervention -ymax<-max(c(cases_rv[,2],simul_baseline$daily_incidence,simul_interventions$daily_incidence),na.rm=T) -plot(time,simul_baseline$daily_incidence,type='l',lwd=3,col='blue', - main="Baseline", xlab="Date", ylab="New cases per day",ylim=c(0,ymax)) -points(as.Date(cases_rv[,1]),cases_rv[,2],pch=19,col='red') -plot(time,simul_interventions$daily_incidence,type='l',lwd=3,col='blue', - main="Intervention", xlab="Date", ylab="New cases per day",ylim=c(0,ymax)) -points(as.Date(cases_rv[,1]),cases_rv[,2],pch=19,col='red') - - - -# # Hospital prevalences stratified by H,ICU and Vent -ymax<-max(c((simul_baseline$hospital_surge_beds+simul_baseline$icu_beds+simul_baseline$ventilators),(simul_interventions$hospital_surge_beds+simul_interventions$icu_beds+simul_interventions$ventilators))) -time<-as.Date(out[,"time"]+startdate) -coul=c("#047883", "#24A9E2","#051A46") -DM<-as.data.frame(cbind(time,simul_baseline$hospital_surge_beds,simul_baseline$icu_beds,simul_baseline$ventilators)) -colnames(DM)<-c("Time","Hospital surge beds","ICU beds","Ventilators") -DM$Time<-as.Date(DM$Time,origin = "1970-01-01") -DMF<-melt(DM, id.vars="Time",measure.vars = c("Hospital surge beds","ICU beds","Ventilators")) -d0<-ggplot(DMF, aes(x = Time, y = value,fill=variable)) + - geom_area()+ - scale_fill_manual(values=coul) - -DM<-as.data.frame(cbind(time,simul_interventions$hospital_surge_beds,simul_interventions$icu_beds,simul_interventions$ventilators)) -colnames(DM)<-c("Time","Hospital surge beds","ICU beds","Ventilators") -DM$Time<-as.Date(DM$Time, origin = "1970-01-01") -DMF<-melt(DM, id.vars="Time",measure.vars = c("Hospital surge beds","ICU beds","Ventilators")) -d1<-ggplot(DMF, aes(x = Time, y = value,fill=variable)) + - geom_area()+ - scale_fill_manual(values=coul) - -grid.arrange(d0+ylab("Number of Patients")+ - ggtitle("Baseline")+ - ylim(0, ymax)+ - geom_hline(yintercept=(parameters["beds_available"]+parameters["icu_beds_available"]+parameters["ventilators_available"]), linetype="dashed", color = "#047883")+ - geom_hline(yintercept=(parameters["icu_beds_available"]+parameters["ventilators_available"]), linetype="dashed", color = "#24A9E2")+ - geom_hline(yintercept=parameters["ventilators_available"], linetype="dashed", color = "#051A46")+ - theme_bw(), - d1+ylab("Number of Patients")+ - ggtitle("Intervention")+ - ylim(0, ymax)+ - geom_hline(yintercept=(parameters["beds_available"]+parameters["icu_beds_available"]+parameters["ventilators_available"]), linetype="dashed", color = "#047883")+ - geom_hline(yintercept=(parameters["icu_beds_available"]+parameters["ventilators_available"]), linetype="dashed", color = "#24A9E2")+ - geom_hline(yintercept=parameters["ventilators_available"], linetype="dashed", color = "#051A46")+ - theme_bw(), - nrow = 1) - - -# # Cumulative mortality at baseline and intervention stratified by hospital status -ymax<-max(c((simul_baseline$total_deaths),(simul_interventions$total_deaths))) -time<-as.Date(out[,"time"]+startdate) -coul=c("#047883", "#24A9E2","#051A46","#E68029", "#D63304","#D1D604") -DM0<-as.data.frame(cbind(time,simul_baseline$base_mort_I+simul_baseline$base_mort_QI, - simul_baseline$base_mort_CL+simul_baseline$base_mort_QC, - simul_baseline$base_mort_X, - simul_baseline$base_mort_S+simul_baseline$base_mort_QS, - simul_baseline$base_mort_E+simul_baseline$base_mort_QE, - simul_baseline$base_mort_QR+simul_baseline$base_mort_R, - simul_baseline$death_treated_hospital, - simul_baseline$death_treated_icu, - simul_baseline$death_treated_ventilator, - simul_baseline$death_untreated_hospital, - simul_baseline$death_untreated_icu, - simul_baseline$death_untreated_ventilator)) -colnames(DM0)<-c("Time","Asymptomatic","Clnical","Self-Isolating","Susceptible","Exposed","Recovered", - "Treated: Hospital","Treated: ICU","Treated: Ventilator","Untreated: Hospital","Untreated: ICU","Untreated: Ventilator") -DM0$Time<-as.Date(DM0$Time, origin = "1970-01-01") -DMF0<-melt(DM0, id.vars="Time",measure.vars = c("Asymptomatic","Clnical","Self-Isolating","Susceptible","Exposed","Recovered", - "Treated: Hospital","Treated: ICU","Treated: Ventilator","Untreated: Hospital","Untreated: ICU","Untreated: Ventilator")) -m0<-ggplot(DMF0, aes(x = Time, y = value,fill=variable)) + - geom_area() - -DM<-as.data.frame(cbind(time,simul_interventions$base_mort_I+simul_interventions$base_mort_QI,simul_interventions$base_mort_CL+simul_interventions$base_mort_QC,simul_interventions$base_mort_X,simul_interventions$base_mort_S+ - simul_interventions$base_mort_QS,simul_interventions$base_mort_E+simul_interventions$base_mort_QE,simul_interventions$base_mort_QR+simul_interventions$base_mort_R, - simul_interventions$death_treated_hospital,simul_interventions$death_treated_icu,simul_interventions$death_treated_ventilator,simul_interventions$death_untreated_hospital,simul_interventions$death_untreated_icu,simul_interventions$death_untreated_ventilator)) -colnames(DM)<-c("Time","Asymptomatic","Clnical","Self-Isolating","Susceptible","Exposed","Recovered", - "Treated: Hospital","Treated: ICU","Treated: Ventilator","Untreated: Hospital","Untreated: ICU","Untreated: Ventilator") -DM$Time<-as.Date(DM$Time, origin = "1970-01-01") -DMF<-melt(DM, id.vars="Time",measure.vars = c("Asymptomatic","Clnical","Self-Isolating","Susceptible","Exposed","Recovered", - "Treated: Hospital","Treated: ICU","Treated: Ventilator","Untreated: Hospital","Untreated: ICU","Untreated: Ventilator")) -m1<-ggplot(DMF, aes(x = Time, y = value,fill=variable)) + - geom_area() -grid.arrange(m0+ylab("Cumulatice mortality")+ - ggtitle("Baseline")+ - ylim(0, ymax), - m1+ylab("Cumulatice mortality")+ - ggtitle("Intervention")+ - ylim(0, ymax), - nrow = 1) - - - -# # Estimated basic reproduction number, R_t -# par(mfrow=c(1,2)) -# ymax<-max(c(simul_baseline$Rt[!is.na(simul_baseline$Rt)],simul_interventions$Rt[!is.na(simul_interventions$Rt)])) -# plot(time,simul_baseline$Rt,type='l',lwd=3,col='black', -# main="Baseline", xlab="Date", ylab="Reproduction number",ylim=c(0,ymax)) -# lines(time,simul_baseline$Rt/simul_baseline$Rt,lwd=2,col='grey') -# plot(time,simul_interventions$Rt,type='l',lwd=3,col='black', -# main="Intervention", xlab="Date", ylab="Reproduction number",ylim=c(0,ymax)) -# lines(time,simul_interventions$Rt/simul_interventions$Rt,lwd=2,col='grey') -# - -## Predicted ifr -# ymax=max(c(simul_baseline$MORT1$value,simul_interventions$MORT1$value)) -# gm<-ggplot(data=simul_interventions$MORT1,aes(x=Age,y=value,fill=variable))+ -# geom_line(data=simul_interventions$MORT1,aes(x=Age,y=value,colour=variable),lwd=1.5)+ylim(0,ymax)+ylab("Mortality") -# gm0<-ggplot(data=simul_baseline$MORT1,aes(x=Age,y=value,fill=variable))+ -# geom_line(data=simul_baseline$MORT1,aes(x=Age,y=value,colour=variable),lwd=1.5)+ylim(0,ymax)+ylab("Mortality") - -# grid.arrange(gm+theme_classic(), -# gm0+theme_classic(), -# nrow=1) - - -# ## AGE DEPENDENT MORTALITY -# cinc_mort_H1 <- parameters["nus"]*parameters["pdeath_h"]*(out[,(Hindex+1)]) -# cinc_mort_HC1 <- parameters["nusc"]*parameters["pdeath_hc"]*(out[,(HCindex+1)]) -# cinc_mort_ICU1 <- parameters["nu_icu"]*parameters["pdeath_icu"]*out[,(ICUindex+1)] -# cinc_mort_ICUC1 <- parameters["nu_icuc"]*parameters["pdeath_icuc"]*out[,(ICUCindex+1)] -# cinc_mort_Vent1 <- parameters["nu_vent"]*parameters["pdeath_vent"]*out[,(Ventindex+1)] -# cinc_mort_VentC1 <- parameters["nu_ventc"]*parameters["pdeath_ventc"]*out[,(VentCindex+1)] -# totage1<-as.data.frame(cinc_mort_H1+cinc_mort_HC1+cinc_mort_ICU1+cinc_mort_ICUC1+cinc_mort_Vent1+cinc_mort_VentC1) -# basemort_H1<-(out[,(Hindex+1)]) -# basemort_HC1<-(out[,(HCindex+1)]) -# basemort_ICU1<-(out[,(ICUindex+1)]) -# basemort_ICUC1<-(out[,(ICUCindex+1)]) -# basemort_Vent1<-(out[,(Ventindex+1)]) -# basemort_VentC1<-(out[,(VentCindex+1)]) -# totbase1<-as.data.frame(basemort_H1+basemort_HC1+basemort_ICU1+basemort_ICUC1+basemort_Vent1+basemort_VentC1) -# tc<-c() -# ages<-seq(0,100,by=5) -# for (i in 1:dim(cinc_mort_H1)[1]) { -# for (j in 1:dim(cinc_mort_H1)[2]) { -# tc<-rbind(tc,c(i,ages[j],totage1[i,j]*ifr[j,2]+totbase1[i,j]*mort[j])) -# } -# } -# tc<-as.data.frame(tc) -# colnames(tc)<-c("Day","Age","value") -# tc$Age<-as.factor(tc$Age) -# p6<-ggplot(data=tc, aes(x=Day,y=value,fill=Age))+ -# geom_bar(stat = "identity",position="fill", width=1)+ -# ylab("Proportion of deaths") -# -# inc_mort_H0 <- parameters["nus"]*parameters["pdeath_h"]*(out0[,(Hindex+1)]) -# inc_mort_HC0 <- parameters["nusc"]*parameters["pdeath_hc"]*(out0[,(HCindex+1)]) -# inc_mort_ICU0 <- parameters["nu_icu"]*parameters["pdeath_icu"]*out0[,(ICUindex+1)] -# inc_mort_ICUC0 <- parameters["nu_icuc"]*parameters["pdeath_icuc"]*out0[,(ICUCindex+1)] -# inc_mort_Vent0 <- parameters["nu_vent"]*parameters["pdeath_vent"]*out0[,(Ventindex+1)] -# inc_mort_VentC0 <- parameters["nu_ventc"]*parameters["pdeath_ventc"]*out0[,(VentCindex+1)] -# totage0<-as.data.frame(inc_mort_H0+inc_mort_HC0+inc_mort_ICU0+inc_mort_ICUC0+inc_mort_Vent0+inc_mort_VentC0) -# basemort_H0<-(out0[,(Hindex+1)]) -# basemort_HC0<-(out0[,(HCindex+1)]) -# basemort_ICU0<-(out0[,(ICUindex+1)]) -# basemort_ICUC0<-(out0[,(ICUCindex+1)]) -# basemort_Vent0<-(out0[,(Ventindex+1)]) -# basemort_VentC0<-(out0[,(VentCindex+1)]) -# totbase0<-as.data.frame(basemort_H0+basemort_HC0+basemort_ICU0+basemort_ICUC0+basemort_Vent0+basemort_VentC0) -# tc0<-c() -# for (i in 1:dim(cinc_mort_H1)[1]) { -# for (j in 1:dim(cinc_mort_H1)[2]) { -# tc0<-rbind(tc0,c(i,ages[j],totage0[i,j]*ifr[j,2]+totbase0[i,j]*mort[j])) -# } -# } -# tc0<-as.data.frame(tc0) -# colnames(tc0)<-c("Day","Age","value") -# tc0$Age<-as.factor(tc0$Age) -# p16<-ggplot(data=tc0, aes(x=Day,y=value,fill=Age))+ -# geom_bar(stat = "identity",position="fill", width=1)+ylab("Proportion of deaths") - -# grid.arrange(p16+theme_minimal(), -# p6+theme_minimal(), -# nrow=1) -# - - -# -# -# -# ######################################################################################################################### -# ##### SUMMARY METRICS ################################################################################################ -# ####################################################################################################################### -# -# infected0<-tail((rowSums(out0[,(Rindex+1)])),1)/sum(popstruc[,2]) -# infected0 -# infected1<-tail((rowSums(out[,(Rindex+1)])),1)/sum(popstruc[,2]) -# infected1 -# -# # #Population size checks -# # tpop1 -# # tpop0 -# -# # PCR -# time_of_measurement<-40:49 -# # general population -# (rowSums(out[time_of_measurement,Iindex+1])+rowSums(out[time_of_measurement,CLindex+1])+rowSums(out[time_of_measurement,QIindex+1])+ -# rowSums(out[time_of_measurement,QCindex+1]))/sum(popstruc[,2]) -# # every infection including hospital infections -# (rowSums(out[time_of_measurement,Iindex+1])+rowSums(out[time_of_measurement,CLindex+1])+rowSums(out[time_of_measurement,Hindex+1])+ -# rowSums(out[time_of_measurement,ICUindex+1])+rowSums(out[time_of_measurement,Ventindex+1])+rowSums(out[time_of_measurement,HCindex+1])+ -# rowSums(out[time_of_measurement,ICUCindex+1])+rowSums(out[time_of_measurement,VentCindex+1])+rowSums(out[time_of_measurement,QIindex+1])+ -# rowSums(out[time_of_measurement,QCindex+1]))/sum(popstruc[,2]) -# -# # SEROLOGY -# tail((rowSums(out[,(Rindex+1)])),1)/sum(popstruc[,2]) -# -# # IHR -# sum(ihr$severe*popstruc[,2]/sum(popstruc[,2])) -# -# -# # PORPORTIONAL MORTALITY IN THE ELDEST -# m30<-out0[30,CMindex+1]/(out0[30,Cindex+1]) -# m30[is.infinite(m30)]<-0 -# m60<-out0[60,CMindex+1]/out0[60,Cindex+1] -# m60[is.infinite(m60)]<-0 -# m90<-out0[90,CMindex+1]/out0[90,Cindex+1] -# m90[is.infinite(m90)]<-0 -# m120<-out0[120,CMindex+1]/out0[120,Cindex+1] -# m120[is.infinite(m120)]<-0 -# -# ifr30<-sum(m30*popstruc[,2]/sum(popstruc[,2]),na.rm = T) -# ifr60<-sum(m60*popstruc[,2]/sum(popstruc[,2]),na.rm = T) -# ifr90<-sum(m90*popstruc[,2]/sum(popstruc[,2]),na.rm = T) -# ifr120<-sum(m120*popstruc[,2]/sum(popstruc[,2]),na.rm = T) -# cbind(ifr30,ifr60,ifr90,ifr120)*100 -# -# PMORTDF0<-as.data.frame(cbind(out0[30,CMindex+1]/sum(out0[30,CMindex+1]),out0[60,CMindex+1]/sum(out0[60,CMindex+1]), -# out0[90,CMindex+1]/sum(out0[90,CMindex+1]),out0[120,CMindex+1]/sum(out0[120,CMindex+1]))) -# PMORTDF<-as.data.frame(cbind(out[30,CMindex+1]/sum(out[30,CMindex+1]),out[60,CMindex+1]/sum(out[60,CMindex+1]), -# out[90,CMindex+1]/sum(out[90,CMindex+1]),out[120,CMindex+1]/sum(out[120,CMindex+1]))) -# sum(PMORTDF0$V2[15:21]) -# sum(PMORTDF$V2[15:21]) -# -# -# # output doubling time over time first 7 days -# dd<-7 -# doub0<-log(2)*dd/(log(dailyinc0[2+dd]/dailyinc0[2])) -# doub0 - -# -# - - diff --git a/r_versions/covidage_v13.8.R b/r_versions/covidage_v13.8.R deleted file mode 100644 index 7397e7a..0000000 --- a/r_versions/covidage_v13.8.R +++ /dev/null @@ -1,1448 +0,0 @@ -rm(list = ls()) - -require("deSolve") -library("ggplot2") -library("dplyr") -library("reshape2") -require("gridExtra") -# library(ggpubr) -# library(bsplus) -# library(deSolve) -# library(DT) -# library(highcharter) -# library(lubridate) -# library(pushbar) -library("readxl") -# library(reshape2) -# library(scales) -# library(shiny) -# library(shinyBS) -# library(shinycssloaders) -# library(shinyhelper) -# library(shinythemes) -# library(shinyWidgets) -# library(tidyverse) -# library(XLConnect) - -# library("Rcpp") -# Rcpp.package.skeleton("foobar") - -#read data from excel file -setwd("/home/bogao/Projects/ATOME-MORU/comoOdeCpp") -load("./data/data_CoMo.RData") -file_path <- paste0(getwd(),"/data/Template_CoMoCOVID-19App_new.xlsx") -country_name<-"Cambodia" - -# Cases -dta <- read_excel(file_path, sheet = "Cases") -names(dta) <- c("date", "cases", "deaths") - -cases_rv <- dta %>% - mutate(date = as.Date(date), cumulative_death = cumsum(deaths)) %>% - as.data.frame() - -# Severity/Mortality -dta <- read_excel(file_path, sheet = "Severity-Mortality") -names(dta) <- c("age_category", "ifr", "ihr") - -mort_sever_rv <- dta %>% - mutate(ihr = ihr/100) %>% # starting unit should be % - scaling to a value between 0 and 1 - mutate(ifr = ifr/max(ifr)) # starting unit should be % - scaling to a value between 0 and 1 - -# Population -dta <- read_excel(file_path, sheet = "Population") -names(dta) <- c("age_category", "pop", "birth", "death") - -population_rv <- dta %>% - transmute(country = NA, age_category, pop, birth, death) - -# Parameters -param <- bind_rows(read_excel(file_path, sheet = "Parameters"), - read_excel(file_path, sheet = "Country Area Param"), - read_excel(file_path, sheet = "Virus Param"), - read_excel(file_path, sheet = "Hospitalisation Param"), - read_excel(file_path, sheet = "Interventions Param"), - read_excel(file_path, sheet = "Interventions")) %>% - mutate(Value_Date = as.Date(Value_Date)) - -# START Bridge ---- -popstruc <- population_rv %>% - select(age_category, pop) %>% - rename(agefloor = age_category) %>% - as.data.frame() - -popbirth <- population_rv %>% - select(age_category, birth) %>% - as.data.frame() # unit should be per person per day - -mort <- population_rv %>% - pull(death) # unit should be per person per day - -ihr <- mort_sever_rv %>% - select(age_category, ihr) %>% - as.data.frame() - -ifr <- mort_sever_rv %>% - select(age_category, ifr) %>% - as.data.frame() - - -######### POP AGEING -# per year ageing matrix -A<-length(popstruc[,2]) -dd<-seq(1:A)/seq(1:A) -ageing <- t(diff(diag(dd),lag=1)/(5*365.25)) -ageing<-cbind(ageing,0*seq(1:A)) # no ageing from last compartment - -# -pop<-population$country==country_name -pp<-population$pop[pop] -### CONTACT MATRICES -c_home <- contact_home[[country_name]] %>% as.matrix() -c_school <- contact_school[[country_name]] %>% as.matrix() -c_work <- contact_work[[country_name]] %>% as.matrix() -c_other <- contact_other[[country_name]] %>% as.matrix() -nce <-A-length(c_home[1,]) - -contact_home<-matrix(0,nrow=A,ncol=A) -contact_school<-matrix(0,nrow=A,ncol=A) -contact_work<-matrix(0,nrow=A,ncol=A) -contact_other<-matrix(0,nrow=A,ncol=A) - -for (i in 1:(A-nce)){ - for (j in 1:(A-nce)){ - contact_home[i,j]<-c_home[i,j] - contact_school[i,j]<-c_school[i,j] - contact_work[i,j]<-c_work[i,j] - contact_other[i,j]<-c_other[i,j] - } -} - -for (i in (A+1-nce):A){ - for (j in 1:(A-nce)){ - contact_home[i,j]<-c_home[(A-nce),j] - contact_school[i,j]<-c_school[(A-nce),j] - contact_work[i,j]<-c_work[(A-nce),j] - contact_other[i,j]<-c_other[(A-nce),j] - } -} -for (i in 1:(A-nce)){ - for (j in (A+1-nce):A){ - contact_home[i,j]<-c_home[i,(A-nce)] - contact_school[i,j]<-c_school[i,(A-nce)] - contact_work[i,j]<-c_work[i,(A-nce)] - contact_other[i,j]<-c_other[i,(A-nce)] - } -} -for (i in (A+1-nce):A){ - for (j in (A+1-nce):A){ - contact_home[i,j]<-c_home[(A-nce),(A-nce)] - contact_school[i,j]<-c_school[(A-nce),(A-nce)] - contact_work[i,j]<-c_work[(A-nce),(A-nce)] - contact_other[i,j]<-c_other[(A-nce),(A-nce)] - } -} - - - -######### INITIALISE SIMULATION/INTERVENTION START TIMES -startdate <- param$Value_Date[param$Parameter == "date_range_simul_start"] -stopdate <- param$Value_Date[param$Parameter == "date_range_simul_end"] -startdate <- startdate[1] -stopdate <- stopdate[1] - - -day_start <- as.numeric(startdate-startdate) -day_stop <- as.numeric(stopdate-startdate) -times <- seq(day_start, day_stop) - -tin<-as.numeric(startdate-as.Date("2020-01-01"))/365.25 -initP<-sum(popstruc[,2]) # population size -ageindcase<-20 # age of index case (years) -aci <- floor((ageindcase/5)+1) # age class of index case - - -############# DEFINE PARAMETERS -parameters <- c( - ### Transmission instrinsic - p = param$Value[param$Parameter=="p"][1], - rho = param$Value[param$Parameter=="rho"][1], - omega = param$Value[param$Parameter=="omega"][1], - gamma = param$Value[param$Parameter=="gamma"][1], - nui = param$Value[param$Parameter=="nui"][1], - report = param$Value[param$Parameter=="report"][1], - reportc = param$Value[param$Parameter=="reportc"][1], - reporth = param$Value[param$Parameter=="reporth"][1], - beds_available = param$Value[param$Parameter=="beds_available"][1], - icu_beds_available = param$Value[param$Parameter=="icu_beds_available"][1], - ventilators_available = param$Value[param$Parameter=="ventilators_available"][1], - give = 95, - pdeath_h = param$Value[param$Parameter=="pdeath_h"][1], - pdeath_hc = param$Value[param$Parameter=="pdeath_hc"][1], - pdeath_icu = param$Value[param$Parameter=="pdeath_icu"][1], - pdeath_icuc = param$Value[param$Parameter=="pdeath_icuc"][1], - pdeath_vent = param$Value[param$Parameter=="pdeath_vent"][1], - pdeath_ventc = param$Value[param$Parameter=="pdeath_ventc"][1], - ihr_scaling = param$Value[param$Parameter=="ihr_scaling"][1], - nus = param$Value[param$Parameter=="nus"][1], - nusc = param$Value[param$Parameter=="nus"][1], # nusc = nus - nu_icu = param$Value[param$Parameter=="nu_icu"][1], - nu_icuc = param$Value[param$Parameter=="nu_icu"][1], # nu_icuc = nu_icu - nu_vent = param$Value[param$Parameter=="nu_vent"][1], - nu_ventc = param$Value[param$Parameter=="nu_vent"][1], # nu_ventc = nu_vent - rhos = param$Value[param$Parameter=="rhos"][1], - amp = param$Value[param$Parameter=="amp"][1], - phi = param$Value[param$Parameter=="phi"][1], - pclin = param$Value[param$Parameter=="pclin"][1], - prob_icu = param$Value[param$Parameter=="prob_icu"][1], - prob_vent = param$Value[param$Parameter=="prob_vent"][1], - - ### INTERVENTIONS - # self isolation - selfis_eff = mean(param$Value[param$Parameter=="selfis_eff"],na.rm=T), - # social distancing - dist_eff = mean(param$Value[param$Parameter=="dist_eff"],na.rm=T), - # hand washing - hand_eff = mean(param$Value[param$Parameter=="hand_eff"],na.rm=T), - # working at home - work_eff = mean(param$Value[param$Parameter=="work_eff"],na.rm=T), - w2h = mean(param$Value[param$Parameter=="w2h"],na.rm=T), - # school closures - school_eff = mean(param$Value[param$Parameter=="school_eff"],na.rm=T), - s2h = mean(param$Value[param$Parameter=="s2h"],na.rm=T), - # cocooning the elderly - cocoon_eff = mean(param$Value[param$Parameter=="cocoon_eff"],na.rm=T), - age_cocoon = mean(param$Value[param$Parameter=="age_cocoon"],na.rm=T), - # vaccination campaign - # vaccine_on = as.numeric(param$Value_Date[param$Parameter=="date_vaccine_on"] - startdate), - vaccine_eff = mean(param$Value[param$Parameter=="vaccine_eff"],na.rm=T), - # vaccine_cov = param$Value[param$Parameter=="vaccine_cov"], - vac_campaign = mean(param$Value[param$Parameter=="vac_campaign"],na.rm=T), - # travel ban - mean_imports = mean(param$Value[param$Parameter=="mean_imports"],na.rm=T), - # screening - screen_test_sens = mean(param$Value[param$Parameter=="screen_test_sens"],na.rm=T), - # screen_contacts = mean(param$Value[param$Parameter=="screen_contacts"],na.rm=T), - screen_overdispersion = mean(param$Value[param$Parameter=="screen_overdispersion"],na.rm=T), - # voluntary home quarantine - quarantine_days = mean(param$Value[param$Parameter=="quarantine_days"],na.rm=T), - quarantine_effort = mean(param$Value[param$Parameter=="quarantine_effort"],na.rm=T), - quarantine_eff_home = mean(param$Value[param$Parameter=="quarantine_eff_home"],na.rm=T), - quarantine_eff_other = mean(param$Value[param$Parameter=="quarantine_eff_other"],na.rm=T), - - household_size = param$Value[param$Parameter=="household_size"][1] -) -ihr[,2]<- parameters["ihr_scaling"]*ihr[,2] - -# Scale parameters to percentages/ rates -parameters["rho"]<-parameters["rho"]/100 -parameters["omega"]<-(1/(parameters["omega"]*365)) -parameters["gamma"]<-1/parameters["gamma"] -parameters["nui"]<-1/parameters["nui"] -parameters["report"]<-parameters["report"]/100 -parameters["reportc"]<-parameters["reportc"]/100 -parameters["reporth"]<-parameters["reporth"]/100 -parameters["nus"]<-1/parameters["nus"] -parameters["rhos"]<-parameters["rhos"]/100 -parameters["amp"]<-parameters["amp"]/100 -parameters["selfis_eff"]<-parameters["selfis_eff"]/100 -parameters["dist_eff"]<-parameters["dist_eff"]/100 -parameters["hand_eff"]<-parameters["hand_eff"]/100 -parameters["work_eff"]<-parameters["work_eff"]/100 -parameters["w2h"]<-parameters["w2h"]/100 -parameters["school_eff"]<-parameters["school_eff"]/100 -parameters["s2h"]<-parameters["s2h"]/100 -parameters["cocoon_eff"]<-parameters["cocoon_eff"]/100 -parameters["age_cocoon"]<-floor((parameters["age_cocoon"]/5)+1) -parameters["vaccine_eff"]<-parameters["vaccine_eff"]/100 -# parameters["vaccine_cov"]<-parameters["vaccine_cov"]/100 -# parameters["vac_campaign"]<-parameters["vac_campaign"]*7 -parameters["screen_test_sens"]<-parameters["screen_test_sens"]/100 -parameters["quarantine_days"]<-parameters["quarantine_days"] -parameters["quarantine_effort"]<-1/parameters["quarantine_effort"] -parameters["quarantine_eff_home"]<-parameters["quarantine_eff_home"]/-100 -parameters["quarantine_eff_other"]<-parameters["quarantine_eff_other"]/100 -parameters["give"]<-parameters["give"]/100 -parameters["pdeath_h"]<-parameters["pdeath_h"]/100 -parameters["pdeath_hc"]<-parameters["pdeath_hc"]/100 -parameters["pdeath_icu"]<-parameters["pdeath_icu"]/100 -parameters["pdeath_icuc"]<-parameters["pdeath_icuc"]/100 -parameters["pdeath_vent"]<-parameters["pdeath_vent"]/100 -parameters["pdeath_ventc"]<-parameters["pdeath_ventc"]/100 -parameters["nusc"]<-1/parameters["nusc"] -parameters["nu_icu"]<-1/parameters["nu_icu"] -parameters["nu_icuc"]<-1/parameters["nu_icuc"] -parameters["nu_vent"]<-1/parameters["nu_vent"] -parameters["nu_ventc"]<-1/parameters["nu_ventc"] -parameters["pclin"]<-parameters["pclin"]/100 -parameters["prob_icu"]<-parameters["prob_icu"]/100 -parameters["prob_vent"]<-parameters["prob_vent"]/100 -parameters2<-parameters - -########################################################################### -# Define the indices for each variable -Sindex<-1:A -Eindex<-(A+1):(2*A) -Iindex<-(2*A+1):(3*A) -Rindex<-(3*A+1):(4*A) -Xindex<-(4*A+1):(5*A) -Hindex<-(5*A+1):(6*A) -HCindex<-(6*A+1):(7*A) -Cindex<-(7*A+1):(8*A) -CMindex<-(8*A+1):(9*A) -Vindex<-(9*A+1):(10*A) -QSindex<-(10*A+1):(11*A) -QEindex<-(11*A+1):(12*A) -QIindex<-(12*A+1):(13*A) -QRindex<-(13*A+1):(14*A) -CLindex<-(14*A+1):(15*A) -QCindex<-(15*A+1):(16*A) -ICUindex<-(16*A+1):(17*A) -ICUCindex<-(17*A+1):(18*A) -ICUCVindex<-(18*A+1):(19*A) -Ventindex<-(19*A+1):(20*A) -VentCindex<-(20*A+1):(21*A) -CMCindex<-(21*A+1):(22*A) - -########################################################################### -# MODEL INITIAL CONDITIONS -initI<-0*popstruc[,2] # Infected and symptomatic -initE<-0*popstruc[,2] # Incubating -initE[aci]<-1 # place random index case in E compartment -initR<-0*popstruc[,2] # Immune -initX<-0*popstruc[,2] # Isolated -initV<-0*popstruc[,2] # Vaccinated -initQS<-0*popstruc[,2] # quarantined S -initQE<-0*popstruc[,2] # quarantined E -initQI<-0*popstruc[,2] # quarantined I -initQR<-0*popstruc[,2] # quarantined R -initH<-0*popstruc[,2] # hospitalised -initHC<-0*popstruc[,2] # hospital critical -initC<-0*popstruc[,2] # Cumulative cases (true) -initCM<-0*popstruc[,2] # Cumulative deaths (true) -initCL<-0*popstruc[,2] # symptomatic cases -initQC<-0*popstruc[,2] # quarantined C -initICU<-0*popstruc[,2] # icu -initICUC<-0*popstruc[,2] # icu critical -initICUCV<-0*popstruc[,2] # icu critical -initVent<-0*popstruc[,2] # icu vent -initVentC<-0*popstruc[,2] # icu vent crit -initCMC<-0*popstruc[,2] # Cumulative deaths (true) -initS<-popstruc[,2]-initE-initI-initR-initX-initV-initH-initHC-initQS-initQE-initQI-initQR-initCL-initQC-initICU-initICUC-initICUCV-initVent-initVentC # Susceptible (non-immune) - - -inp <- read_excel(file_path, sheet = "Interventions") -inputs<-function(inp, run){ - tb<-which(inp$`Apply to`==run) - - si<-intersect(which(inp$Intervention=="Self-isolation if Symptomatic"),tb) - scr<-intersect(which(inp$Intervention=="Screening (when S.I.)"),tb) - sd<-intersect(which(inp$Intervention=="Social Distancing"),tb) - hw<-intersect(which(inp$Intervention=="Handwashing"),tb) - wah<-intersect(which(inp$Intervention=="Working at Home"),tb) - sc<-intersect(which(inp$Intervention=="School Closures"),tb) - cte<-intersect(which(inp$Intervention=="Shielding the Elderly"),tb) - q<-intersect(which(inp$Intervention=="Household Isolation (when S.I.)"),tb) - tb<-intersect(which(inp$Intervention=="International Travel Ban"),tb) - vc<-intersect(which(inp$Intervention=="Vaccination"),tb) - - v<-(format(as.POSIXct(inp$`Date Start`,format='%Y/%m/%d %H:%M:%S'),format="%d/%m/%y")) - v2<-as.Date(v,format="%d/%m/%y") - inp$`Date Start`<-v2 - - v<-(format(as.POSIXct(inp$`Date End`,format='%Y/%m/%d %H:%M:%S'),format="%d/%m/%y")) - v2<-as.Date(v,format="%d/%m/%y") - ll<-length(v[!is.na(v)]) - for (gg in 1:ll) { - v2[gg]<-min(v2[gg],stopdate) - } - inp$`Date End`<-v2 - - - ## self isolation - f<-c() - si_vector<-c() - isolation<-c() - if (length(si)>=1){ - for (i in 1:length(si)){ - f<-c(f,as.numeric(inp$`Date Start`[si[i]]-startdate),as.numeric(inp$`Date End`[si[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[si[i]]>startdate){ - si_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[si[i]],(f[i+1]-f[i])*20)) - isolation<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - si_vector<-c(rep(inp$`Value`[si[i]],(f[i+1])*20)) - isolation<-c(rep(1,(f[i+1])*20)) - } - } - else{ - si_vector<-c(si_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - si_vector<-c(si_vector,rep(inp$`Value`[si[i]],(f[i*2]-f[i*2-1])*20)) - isolation<-c(isolation,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - isolation<-c(isolation,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(si) && f[i*2]=1){ - for (i in 1:length(sd)){ - - f<-c(f,as.numeric(inp$`Date Start`[sd[i]]-startdate),as.numeric(inp$`Date End`[sd[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[sd[i]]>startdate){ - sd_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[sd[i]],(f[i+1]-f[i])*20)) - distancing<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - sd_vector<-c(rep(inp$`Value`[sd[i]],(f[i+1])*20)) - distancing<-c(rep(1,(f[i+1])*20)) - } - } - else{ - sd_vector<-c(sd_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - sd_vector<-c(sd_vector,rep(inp$`Value`[sd[i]],(f[i*2]-f[i*2-1])*20)) - distancing<-c(distancing,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - distancing<-c(distancing,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(sd)&& f[i*2]=1){ - for (i in 1:length(scr)){ - - f<-c(f,as.numeric(inp$`Date Start`[scr[i]]-startdate),as.numeric(inp$`Date End`[scr[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[scr[i]]>startdate){ - scr_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[scr[i]],(f[i+1]-f[i])*20)) - screen<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - scr_vector<-c(rep(inp$`Value`[scr[i]],(f[i+1])*20)) - screen<-c(rep(1,(f[i+1])*20)) - } - } - else{ - scr_vector<-c(scr_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - scr_vector<-c(scr_vector,rep(inp$`Value`[scr[i]],(f[i*2]-f[i*2-1])*20)) - screen<-c(screen,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - screen<-c(screen,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(scr)&& f[i*2]=1){ - for (i in 1:length(hw)){ - - f<-c(f,as.numeric(inp$`Date Start`[hw[i]]-startdate),as.numeric(inp$`Date End`[hw[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[hw[i]]>startdate){ - hw_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[hw[i]],(f[i+1]-f[i])*20)) - handwash<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - hw_vector<-c(rep(inp$`Value`[hw[i]],(f[i+1])*20)) - handwash<-c(rep(1,(f[i+1])*20)) - } - } - else{ - hw_vector<-c(hw_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - hw_vector<-c(hw_vector,rep(inp$`Value`[hw[i]],(f[i*2]-f[i*2-1])*20)) - handwash<-c(handwash,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - handwash<-c(handwash,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(hw)&& f[i*2]=1){ - for (i in 1:length(wah)){ - - f<-c(f,as.numeric(inp$`Date Start`[wah[i]]-startdate),as.numeric(inp$`Date End`[wah[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[wah[i]]>startdate){ - wah_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[wah[i]],(f[i+1]-f[i])*20)) - workhome<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - wah_vector<-c(rep(inp$`Value`[wah[i]],(f[i+1])*20)) - workhome<-c(rep(1,(f[i+1])*20)) - } - } - else{ - wah_vector<-c(wah_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - wah_vector<-c(wah_vector,rep(inp$`Value`[wah[i]],(f[i*2]-f[i*2-1])*20)) - workhome<-c(workhome,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - workhome<-c(workhome,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(wah)&& f[i*2]=1){ - for (i in 1:length(sc)){ - - f<-c(f,as.numeric(inp$`Date Start`[sc[i]]-startdate),as.numeric(inp$`Date End`[sc[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[sc[i]]>startdate){ - sc_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[sc[i]],(f[i+1]-f[i])*20)) - schoolclose<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - sc_vector<-c(rep(inp$`Value`[sc[i]],(f[i+1])*20)) - schoolclose<-c(rep(1,(f[i+1])*20)) - } - } - else{ - sc_vector<-c(sc_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - sc_vector<-c(sc_vector,rep(inp$`Value`[sc[i]],(f[i*2]-f[i*2-1])*20)) - schoolclose<-c(schoolclose,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - schoolclose<-c(schoolclose,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(sc)&& f[i*2]=1){ - for (i in 1:length(cte)){ - - f<-c(f,as.numeric(inp$`Date Start`[cte[i]]-startdate),as.numeric(inp$`Date End`[cte[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[cte[i]]>startdate){ - cte_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[cte[i]],(f[i+1]-f[i])*20)) - cocoon<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - cte_vector<-c(rep(inp$`Value`[cte[i]],(f[i+1])*20)) - cocoon<-c(rep(1,(f[i+1])*20)) - } - } - else{ - cte_vector<-c(cte_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - cte_vector<-c(cte_vector,rep(inp$`Value`[cte[i]],(f[i*2]-f[i*2-1])*20)) - cocoon<-c(cocoon,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - cocoon<-c(cocoon,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(cte)&& f[i*2]=1){ - for (i in 1:length(q)){ - - f<-c(f,as.numeric(inp$`Date Start`[q[i]]-startdate),as.numeric(inp$`Date End`[q[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[q[i]]>startdate){ - q_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[q[i]],(f[i+1]-f[i])*20)) - quarantine<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - q_vector<-c(rep(inp$`Value`[q[i]],(f[i+1])*20)) - quarantine<-c(rep(1,(f[i+1])*20)) - } - } - else{ - q_vector<-c(q_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - q_vector<-c(q_vector,rep(inp$`Value`[q[i]],(f[i*2]-f[i*2-1])*20)) - quarantine<-c(quarantine,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - quarantine<-c(quarantine,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(q)&& f[i*2]=1){ - for (i in 1:length(tb)){ - - f<-c(f,as.numeric(inp$`Date Start`[tb[i]]-startdate),as.numeric(inp$`Date End`[tb[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[tb[i]]>startdate){ - tb_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[tb[i]],(f[i+1]-f[i])*20)) - travelban<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - tb_vector<-c(rep(inp$`Value`[tb[i]],(f[i+1])*20)) - travelban<-c(rep(1,(f[i+1])*20)) - } - } - else{ - tb_vector<-c(tb_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - tb_vector<-c(tb_vector,rep(inp$`Value`[tb[i]],(f[i*2]-f[i*2-1])*20)) - travelban<-c(travelban,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - travelban<-c(travelban,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(tb)&& f[i*2]=1){ - for (i in 1:length(vc)){ - - f<-c(f,as.numeric(inp$`Date Start`[vc[i]]-startdate),as.numeric(inp$`Date End`[vc[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[vc[i]]>startdate){ - vc_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[vc[i]],(f[i+1]-f[i])*20)) - vaccine<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - vc_vector<-c(rep(inp$`Value`[vc[i]],(f[i+1])*20)) - vaccine<-c(rep(1,(f[i+1])*20)) - } - } - else{ - vc_vector<-c(vc_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - vc_vector<-c(vc_vector,rep(inp$`Value`[vc[i]],(f[i*2]-f[i*2-1])*20)) - vaccine<-c(vaccine,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - vaccine<-c(vaccine,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(vc)&& f[i*2]= 7) {Rt[i] <- NA} - } - - # Export in a cohesive format ---- - results <- list() - results$time <- startdate + times # dates - results$Rt <- Rt - results$cum_mortality <- round(cmortality1) # cumulative mortality - results$pct_total_pop_infected <- round(100 * tail(cumsum(rowSums(parameters["gamma"]*out[,(Eindex+1)])),1)/sum(popstruc[,2]), 1) # proportion of the population that has been infected at the end of the simulation - results$doubling_time <- round(log(2)*7 / (log(dailyinc1[2+7] / dailyinc1[2])), 2) # (Baseline only) to double the number of infections at inception - results$required_beds <- round(previcureq1) # required beds - results$saturation <- parameters["beds_available"] # saturation - results$daily_incidence <- round(dailyinc1) # daily incidence (Reported) - results$daily_total_cases <- round(rowSums(parameters["gamma"]*out[,(Eindex+1)]+parameters["gamma"]*out[,(QEindex+1)])) # daily incidence (Reported + Unreported) # daily incidence (Reported + Unreported) - results$hospital_surge_beds <- round(previcureq1) - results$icu_beds <- round(previcureq21) - results$ventilators <- round(previcureq31) - - results$death_natural_non_exposed <- round(base_mort_S1) - results$death_natural_exposed <- round(base_mort_E1 + base_mort_I1 + base_mort_CL1 + base_mort_X1 + base_mort_QS1 + - base_mort_QE1 + base_mort_QI1 + base_mort_QC1 + base_mort_QR1 + base_mort_R1+ - base_mort_H1+base_mort_HC1+base_mort_ICU1+base_mort_ICUC1+base_mort_ICUCV1+ - base_mort_Vent1+base_mort_VentC1) - results$death_treated_hospital <- round(cinc_mort_H1) - results$death_treated_icu <- round(cinc_mort_ICU1) - results$death_treated_ventilator <- round(cinc_mort_Vent1) - results$death_untreated_hospital <- round(cinc_mort_HC1) - results$death_untreated_icu <- round(cinc_mort_ICUC1) - results$death_untreated_ventilator <- round(cinc_mort_VentC1)+round(cinc_mort_ICUCV1) - results$total_deaths <- results$death_treated_hospital + results$death_treated_icu + results$death_treated_ventilator + - results$death_untreated_hospital + results$death_untreated_icu + results$death_untreated_ventilator+results$death_natural_non_exposed+results$death_natural_exposed - results$total_deaths_end <- last(results$total_deaths) - results$total_reported_deaths_end <- last(results$cum_mortality) - results$base_mort_H <- base_mort_H1 - results$base_mort_HC <- base_mort_HC1 - results$base_mort_ICU <- base_mort_ICU1 - results$base_mort_ICUC <- base_mort_ICUC1 - results$base_mort_ICUCV <- base_mort_ICUCV1 - results$base_mort_Vent <- base_mort_Vent1 - results$base_mort_VentC <- base_mort_VentC1 - results$base_mort_S <- base_mort_S1 - results$base_mort_E <- base_mort_E1 - results$base_mort_I <- base_mort_I1 - results$base_mort_CL <- base_mort_CL1 - results$base_mort_X <- base_mort_X1 - results$base_mort_QS <- base_mort_QS1 - results$base_mort_QE <- base_mort_QE1 - results$base_mort_QI <- base_mort_QI1 - results$base_mort_QC <- base_mort_QC1 - results$base_mort_QR <- base_mort_QR1 - results$base_mort_R <- base_mort_R1 - - ## AGE DEPENDENT MORTALITY - cinc_mort_H1 <- parameters["nus"]*parameters["pdeath_h"]*(out[,(Hindex+1)]) - cinc_mort_HC1 <- parameters["nusc"]*parameters["pdeath_hc"]*(out[,(HCindex+1)]) - cinc_mort_ICU1 <- parameters["nu_icu"]*parameters["pdeath_icu"]*out[,(ICUindex+1)] - cinc_mort_ICUC1 <- parameters["nu_icuc"]*parameters["pdeath_icuc"]*out[,(ICUCindex+1)] - cinc_mort_ICUCV1 <- parameters["nu_ventc"]*parameters["pdeath_ventc"]*out[,(ICUCVindex+1)] - cinc_mort_Vent1 <- parameters["nu_vent"]*parameters["pdeath_vent"]*out[,(Ventindex+1)] - cinc_mort_VentC1 <- parameters["nu_ventc"]*parameters["pdeath_ventc"]*out[,(VentCindex+1)] - totage1<-as.data.frame(cinc_mort_H1+cinc_mort_HC1+cinc_mort_ICU1+cinc_mort_ICUC1+cinc_mort_ICUCV1+cinc_mort_Vent1+cinc_mort_VentC1) - basemort_H1<-(out[,(Hindex+1)]) - basemort_HC1<-(out[,(HCindex+1)]) - basemort_ICU1<-(out[,(ICUindex+1)]) - basemort_ICUC1<-(out[,(ICUCindex+1)]) - basemort_ICUCV1<-(out[,(ICUCVindex+1)]) - basemort_Vent1<-(out[,(Ventindex+1)]) - basemort_VentC1<-(out[,(VentCindex+1)]) - totbase1<-as.data.frame(basemort_H1+basemort_HC1+basemort_ICU1+basemort_ICUC1+basemort_ICUCV1+basemort_Vent1+basemort_VentC1) - tc<-c() - - for (i in 1:dim(cinc_mort_H1)[1]) { - for (j in 1:dim(cinc_mort_H1)[2]) { - tc<-rbind(tc,c(i, j, totage1[i,j]*ifr[j,2]+totbase1[i,j]*mort[j])) - } - } - tc<-as.data.frame(tc) - colnames(tc)<-c("Day","Age","value") - - results$tc <- tc %>% - mutate(Date = startdate + Day, - age_cat = case_when( - Age >= 1 & Age <= 6 ~ "≤ 30 y.o.", - Age > 6 & Age <= 8 ~ "30-40 y.o.", - Age > 8 & Age <= 10 ~ "40-50 y.o.", - Age > 10 & Age <= 12 ~ "50-60 y.o.", - Age > 12 & Age <= 14 ~ "60-70 y.o.", - Age >= 15 ~ "≥ 70 y.o.")) %>% - mutate(age_cat = factor(age_cat, levels = rev(c("≤ 30 y.o.", "30-40 y.o.", - "40-50 y.o.", "50-60 y.o.", "60-70 y.o.", "≥ 70 y.o.")))) - - mortality_lag <- data.frame(Age = popstruc$agefloor) - if(nrow(out) >= 30) mortality_lag <- bind_cols(mortality_lag, - data.frame(day30 = out[30,CMindex+1]/out[30,Cindex+1]) %>% - mutate(day30 = ifelse(is.infinite(day30), 0, day30)) %>% - rename(`Day 30` = day30)) - if(nrow(out) >= 60) mortality_lag <- bind_cols(mortality_lag, - data.frame(day60 = out[60,CMindex+1]/out[60,Cindex+1]) %>% - mutate(day60 = ifelse(is.infinite(day60), 0, day60)) %>% - rename(`Day 60` = day60)) - if(nrow(out) >= 90) mortality_lag <- bind_cols(mortality_lag, - data.frame(day90 = out[90,CMindex+1]/out[90,Cindex+1]) %>% - mutate(day90 = ifelse(is.infinite(day90), 0, day90)) %>% - rename(`Day 90` = day90)) - if(nrow(out) >= 120) mortality_lag <- bind_cols(mortality_lag, - data.frame(day120 = out[120,CMindex+1]/out[120,Cindex+1]) %>% - mutate(day120 = ifelse(is.infinite(day120), 0, day120)) %>% - rename(`Day 120` = day120)) - - results$mortality_lag <- mortality_lag - - return(results) -} - - -# out0 <- ode(y = Y, times = times, method = "euler", hini = 0.05, func = covid, parms = parameters, input=vectors0) - -# Rcpp::sourceCpp( './comoOdeCpp/src/comoOde.cpp') - -covidOdeCpp_reset() -system.time( -out0 <- ode(y = Y, times = times, func = covidOdeCpp, parms = parameters, - input=vectors0, A=A, - contact_home=contact_home, contact_school=contact_school, - contact_work=contact_work, contact_other=contact_other, - popbirth_col2=popbirth[,2], popstruc_col2=popstruc[,2], - ageing=ageing, - ifr_col2=ifr[,2], ihr_col2=ihr[,2], mort_col=mort) -) - -simul_baseline <- process_ode_outcome(out0) -# write.csv(simul_baseline, paste0(hilo,"_baseline_",gsub(":|-","",Sys.time()),".csv")) - -#future interventions -#extend travel ban, quarantine, hand washing, cocooning the elderly until 1st July -parameters2 <- parameters - -# system.time( -# out <- ode(y = Y, times = times, method = "euler", hini = 0.05, func = covid, parms = parameters2,input=vectors) -# ) - -# Rcpp::sourceCpp( './comoOdeCpp/src/comoOde.cpp') - -covidOdeCpp_reset() -system.time( -out <- ode(y = Y, times = times, func = covidOdeCpp, parms = parameters2, - input=vectors, A=A, - contact_home=contact_home, contact_school=contact_school, - contact_work=contact_work, contact_other=contact_other, - popbirth_col2=popbirth[,2], popstruc_col2=popstruc[,2], - ageing=ageing, - ifr_col2=ifr[,2], ihr_col2=ihr[,2], mort_col=mort) -) - - -simul_interventions <- process_ode_outcome(out) -# write.csv(simul_interventions, paste0(hilo,"_futureIntv_",gsub(":|-","",Sys.time()),".csv")) - -pop1<-out[,(Sindex+1)]+out[,(Eindex+1)]+out[,(Iindex+1)]+out[,(CLindex+1)]+out[,(Rindex+1)]+out[,(Xindex+1)]+out[,(Vindex+1)]+ - out[,(QSindex+1)]+out[,(QEindex+1)]+out[,(QIindex+1)]+out[,(QCindex+1)]+out[,(QRindex+1)]+ - out[,(Hindex+1)]+out[,(HCindex+1)]+out[,(ICUindex+1)]+out[,(ICUCindex+1)]+out[,(ICUCVindex+1)]+out[,(Ventindex+1)]+out[,(VentCindex+1)] -tpop1<-rowSums(pop1) - -############# PLOTTING -# Fitting tab -# fitting the intervention lines to the data to account for any historical interventions -time<-as.Date(out0[,1]+startdate) -par(mfrow=c(1,2)) -# set up the axis limits -xmin<-min(as.Date(cases_rv[,1])) -xmax<-max(as.Date(cases_rv[,1])) -ymax<-max(cases_rv[,2],na.rm = T) -xtick<-seq(xmin, xmax, by=7) -plot(time,simul_interventions$daily_incidence,type='l',lwd=3, - main="New Reported Cases", xlab="Date", ylab="Cases per day", - xlim=c(xmin,xmax), ylim=c(0,ymax), col='blue',xaxt="n") -axis(side=1, labels = FALSE) -text(x=xtick, y=-250, labels = format(xtick,"%b-%d"), srt = 0, xpd = TRUE) -points(as.Date(cases_rv[,1]),cases_rv[,2],pch=19,col='red') - -# reset the maximum to the cumulative mortality -ymax<-max(cases_rv[,3],na.rm = T) -plot(time,simul_interventions$cum_mortality,type='l',lwd=3, - main="Cumulative Mortality", xlab="Date", ylab="Total deaths", - xlim=c(xmin,xmax), ylim=c(0,ymax), col='blue',xaxt="n") -text(x=xtick, y=-100, labels = format(xtick,"%b-%d"), srt = 0, xpd = TRUE) -points(as.Date(cases_rv[,1]),cases_rv[,3],pch=19,col='red') - - -### Predictions tab -par(mfrow=c(1,2)) -### Cases at baseline and intervention -ymax<-max(c(cases_rv[,2],simul_baseline$daily_incidence,simul_interventions$daily_incidence),na.rm=T) -plot(time,simul_baseline$daily_incidence,type='l',lwd=3,col='blue', - main="Baseline", xlab="Date", ylab="New cases per day",ylim=c(0,ymax)) -points(as.Date(cases_rv[,1]),cases_rv[,2],pch=19,col='red') -plot(time,simul_interventions$daily_incidence,type='l',lwd=3,col='blue', - main="Intervention", xlab="Date", ylab="New cases per day",ylim=c(0,ymax)) -points(as.Date(cases_rv[,1]),cases_rv[,2],pch=19,col='red') - - - -# # Hospital prevalences stratified by H,ICU and Vent -ymax<-max(c((simul_baseline$hospital_surge_beds+simul_baseline$icu_beds+simul_baseline$ventilators),(simul_interventions$hospital_surge_beds+simul_interventions$icu_beds+simul_interventions$ventilators))) -time<-as.Date(out[,"time"]+startdate) -coul=c("#047883", "#24A9E2","#051A46") -DM<-as.data.frame(cbind(time,simul_baseline$hospital_surge_beds,simul_baseline$icu_beds,simul_baseline$ventilators)) -colnames(DM)<-c("Time","Hospital surge beds","ICU beds","Ventilators") -DM$Time<-as.Date(DM$Time,origin = "1970-01-01") -DMF<-melt(DM, id.vars="Time",measure.vars = c("Hospital surge beds","ICU beds","Ventilators")) -d0<-ggplot(DMF, aes(x = Time, y = value,fill=variable)) + - geom_area()+ - scale_fill_manual(values=coul) - -DM<-as.data.frame(cbind(time,simul_interventions$hospital_surge_beds,simul_interventions$icu_beds,simul_interventions$ventilators)) -colnames(DM)<-c("Time","Hospital surge beds","ICU beds","Ventilators") -DM$Time<-as.Date(DM$Time, origin = "1970-01-01") -DMF<-melt(DM, id.vars="Time",measure.vars = c("Hospital surge beds","ICU beds","Ventilators")) -d1<-ggplot(DMF, aes(x = Time, y = value,fill=variable)) + - geom_area()+ - scale_fill_manual(values=coul) - -grid.arrange(d0+ylab("Number of Patients")+ - ggtitle("Baseline")+ - ylim(0, ymax)+ - geom_hline(yintercept=(parameters["beds_available"]+parameters["icu_beds_available"]+parameters["ventilators_available"]), linetype="dashed", color = "#047883")+ - geom_hline(yintercept=(parameters["icu_beds_available"]+parameters["ventilators_available"]), linetype="dashed", color = "#24A9E2")+ - geom_hline(yintercept=parameters["ventilators_available"], linetype="dashed", color = "#051A46")+ - theme_bw(), - d1+ylab("Number of Patients")+ - ggtitle("Intervention")+ - ylim(0, ymax)+ - geom_hline(yintercept=(parameters["beds_available"]+parameters["icu_beds_available"]+parameters["ventilators_available"]), linetype="dashed", color = "#047883")+ - geom_hline(yintercept=(parameters["icu_beds_available"]+parameters["ventilators_available"]), linetype="dashed", color = "#24A9E2")+ - geom_hline(yintercept=parameters["ventilators_available"], linetype="dashed", color = "#051A46")+ - theme_bw(), - nrow = 1) - - -# # Cumulative mortality at baseline and intervention stratified by hospital status -ymax<-max(c((simul_baseline$total_deaths),(simul_interventions$total_deaths))) -time<-as.Date(out[,"time"]+startdate) -coul=c("#047883", "#24A9E2","#051A46","#E68029", "#D63304","#D1D604") -DM0<-as.data.frame(cbind(time,simul_baseline$base_mort_I+simul_baseline$base_mort_QI, - simul_baseline$base_mort_CL+simul_baseline$base_mort_QC, - simul_baseline$base_mort_X, - simul_baseline$base_mort_S+simul_baseline$base_mort_QS, - simul_baseline$base_mort_E+simul_baseline$base_mort_QE, - simul_baseline$base_mort_QR+simul_baseline$base_mort_R, - simul_baseline$death_treated_hospital, - simul_baseline$death_treated_icu, - simul_baseline$death_treated_ventilator, - simul_baseline$death_untreated_hospital, - simul_baseline$death_untreated_icu, - simul_baseline$death_untreated_ventilator)) -colnames(DM0)<-c("Time","Asymptomatic","Clnical","Self-Isolating","Susceptible","Exposed","Recovered", - "Treated: Hospital","Treated: ICU","Treated: Ventilator","Untreated: Hospital","Untreated: ICU","Untreated: Ventilator") -DM0$Time<-as.Date(DM0$Time, origin = "1970-01-01") -DMF0<-melt(DM0, id.vars="Time",measure.vars = c("Asymptomatic","Clnical","Self-Isolating","Susceptible","Exposed","Recovered", - "Treated: Hospital","Treated: ICU","Treated: Ventilator","Untreated: Hospital","Untreated: ICU","Untreated: Ventilator")) -m0<-ggplot(DMF0, aes(x = Time, y = value,fill=variable)) + - geom_area() - -DM<-as.data.frame(cbind(time,simul_interventions$base_mort_I+simul_interventions$base_mort_QI,simul_interventions$base_mort_CL+simul_interventions$base_mort_QC,simul_interventions$base_mort_X,simul_interventions$base_mort_S+ - simul_interventions$base_mort_QS,simul_interventions$base_mort_E+simul_interventions$base_mort_QE,simul_interventions$base_mort_QR+simul_interventions$base_mort_R, - simul_interventions$death_treated_hospital,simul_interventions$death_treated_icu,simul_interventions$death_treated_ventilator,simul_interventions$death_untreated_hospital,simul_interventions$death_untreated_icu,simul_interventions$death_untreated_ventilator)) -colnames(DM)<-c("Time","Asymptomatic","Clnical","Self-Isolating","Susceptible","Exposed","Recovered", - "Treated: Hospital","Treated: ICU","Treated: Ventilator","Untreated: Hospital","Untreated: ICU","Untreated: Ventilator") -DM$Time<-as.Date(DM$Time, origin = "1970-01-01") -DMF<-melt(DM, id.vars="Time",measure.vars = c("Asymptomatic","Clnical","Self-Isolating","Susceptible","Exposed","Recovered", - "Treated: Hospital","Treated: ICU","Treated: Ventilator","Untreated: Hospital","Untreated: ICU","Untreated: Ventilator")) -m1<-ggplot(DMF, aes(x = Time, y = value,fill=variable)) + - geom_area() -grid.arrange(m0+ylab("Cumulatice mortality")+ - ggtitle("Baseline")+ - ylim(0, ymax), - m1+ylab("Cumulatice mortality")+ - ggtitle("Intervention")+ - ylim(0, ymax), - nrow = 1) - - - -# # Estimated basic reproduction number, R_t -# par(mfrow=c(1,2)) -# ymax<-max(c(simul_baseline$Rt[!is.na(simul_baseline$Rt)],simul_interventions$Rt[!is.na(simul_interventions$Rt)])) -# plot(time,simul_baseline$Rt,type='l',lwd=3,col='black', -# main="Baseline", xlab="Date", ylab="Reproduction number",ylim=c(0,ymax)) -# lines(time,simul_baseline$Rt/simul_baseline$Rt,lwd=2,col='grey') -# plot(time,simul_interventions$Rt,type='l',lwd=3,col='black', -# main="Intervention", xlab="Date", ylab="Reproduction number",ylim=c(0,ymax)) -# lines(time,simul_interventions$Rt/simul_interventions$Rt,lwd=2,col='grey') -# - -## Predicted ifr -# ymax=max(c(simul_baseline$MORT1$value,simul_interventions$MORT1$value)) -# gm<-ggplot(data=simul_interventions$MORT1,aes(x=Age,y=value,fill=variable))+ -# geom_line(data=simul_interventions$MORT1,aes(x=Age,y=value,colour=variable),lwd=1.5)+ylim(0,ymax)+ylab("Mortality") -# gm0<-ggplot(data=simul_baseline$MORT1,aes(x=Age,y=value,fill=variable))+ -# geom_line(data=simul_baseline$MORT1,aes(x=Age,y=value,colour=variable),lwd=1.5)+ylim(0,ymax)+ylab("Mortality") - -# grid.arrange(gm+theme_classic(), -# gm0+theme_classic(), -# nrow=1) - - -# ## AGE DEPENDENT MORTALITY -# cinc_mort_H1 <- parameters["nus"]*parameters["pdeath_h"]*(out[,(Hindex+1)]) -# cinc_mort_HC1 <- parameters["nusc"]*parameters["pdeath_hc"]*(out[,(HCindex+1)]) -# cinc_mort_ICU1 <- parameters["nu_icu"]*parameters["pdeath_icu"]*out[,(ICUindex+1)] -# cinc_mort_ICUC1 <- parameters["nu_icuc"]*parameters["pdeath_icuc"]*out[,(ICUCindex+1)] -# cinc_mort_Vent1 <- parameters["nu_vent"]*parameters["pdeath_vent"]*out[,(Ventindex+1)] -# cinc_mort_VentC1 <- parameters["nu_ventc"]*parameters["pdeath_ventc"]*out[,(VentCindex+1)] -# totage1<-as.data.frame(cinc_mort_H1+cinc_mort_HC1+cinc_mort_ICU1+cinc_mort_ICUC1+cinc_mort_Vent1+cinc_mort_VentC1) -# basemort_H1<-(out[,(Hindex+1)]) -# basemort_HC1<-(out[,(HCindex+1)]) -# basemort_ICU1<-(out[,(ICUindex+1)]) -# basemort_ICUC1<-(out[,(ICUCindex+1)]) -# basemort_Vent1<-(out[,(Ventindex+1)]) -# basemort_VentC1<-(out[,(VentCindex+1)]) -# totbase1<-as.data.frame(basemort_H1+basemort_HC1+basemort_ICU1+basemort_ICUC1+basemort_Vent1+basemort_VentC1) -# tc<-c() -# ages<-seq(0,100,by=5) -# for (i in 1:dim(cinc_mort_H1)[1]) { -# for (j in 1:dim(cinc_mort_H1)[2]) { -# tc<-rbind(tc,c(i,ages[j],totage1[i,j]*ifr[j,2]+totbase1[i,j]*mort[j])) -# } -# } -# tc<-as.data.frame(tc) -# colnames(tc)<-c("Day","Age","value") -# tc$Age<-as.factor(tc$Age) -# p6<-ggplot(data=tc, aes(x=Day,y=value,fill=Age))+ -# geom_bar(stat = "identity",position="fill", width=1)+ -# ylab("Proportion of deaths") -# -# inc_mort_H0 <- parameters["nus"]*parameters["pdeath_h"]*(out0[,(Hindex+1)]) -# inc_mort_HC0 <- parameters["nusc"]*parameters["pdeath_hc"]*(out0[,(HCindex+1)]) -# inc_mort_ICU0 <- parameters["nu_icu"]*parameters["pdeath_icu"]*out0[,(ICUindex+1)] -# inc_mort_ICUC0 <- parameters["nu_icuc"]*parameters["pdeath_icuc"]*out0[,(ICUCindex+1)] -# inc_mort_Vent0 <- parameters["nu_vent"]*parameters["pdeath_vent"]*out0[,(Ventindex+1)] -# inc_mort_VentC0 <- parameters["nu_ventc"]*parameters["pdeath_ventc"]*out0[,(VentCindex+1)] -# totage0<-as.data.frame(inc_mort_H0+inc_mort_HC0+inc_mort_ICU0+inc_mort_ICUC0+inc_mort_Vent0+inc_mort_VentC0) -# basemort_H0<-(out0[,(Hindex+1)]) -# basemort_HC0<-(out0[,(HCindex+1)]) -# basemort_ICU0<-(out0[,(ICUindex+1)]) -# basemort_ICUC0<-(out0[,(ICUCindex+1)]) -# basemort_Vent0<-(out0[,(Ventindex+1)]) -# basemort_VentC0<-(out0[,(VentCindex+1)]) -# totbase0<-as.data.frame(basemort_H0+basemort_HC0+basemort_ICU0+basemort_ICUC0+basemort_Vent0+basemort_VentC0) -# tc0<-c() -# for (i in 1:dim(cinc_mort_H1)[1]) { -# for (j in 1:dim(cinc_mort_H1)[2]) { -# tc0<-rbind(tc0,c(i,ages[j],totage0[i,j]*ifr[j,2]+totbase0[i,j]*mort[j])) -# } -# } -# tc0<-as.data.frame(tc0) -# colnames(tc0)<-c("Day","Age","value") -# tc0$Age<-as.factor(tc0$Age) -# p16<-ggplot(data=tc0, aes(x=Day,y=value,fill=Age))+ -# geom_bar(stat = "identity",position="fill", width=1)+ylab("Proportion of deaths") - -# grid.arrange(p16+theme_minimal(), -# p6+theme_minimal(), -# nrow=1) -# - - -# -# -# -# ######################################################################################################################### -# ##### SUMMARY METRICS ################################################################################################ -# ####################################################################################################################### -# -# infected0<-tail((rowSums(out0[,(Rindex+1)])),1)/sum(popstruc[,2]) -# infected0 -# infected1<-tail((rowSums(out[,(Rindex+1)])),1)/sum(popstruc[,2]) -# infected1 -# -# # #Population size checks -# # tpop1 -# # tpop0 -# -# # PCR -# time_of_measurement<-40:49 -# # general population -# (rowSums(out[time_of_measurement,Iindex+1])+rowSums(out[time_of_measurement,CLindex+1])+rowSums(out[time_of_measurement,QIindex+1])+ -# rowSums(out[time_of_measurement,QCindex+1]))/sum(popstruc[,2]) -# # every infection including hospital infections -# (rowSums(out[time_of_measurement,Iindex+1])+rowSums(out[time_of_measurement,CLindex+1])+rowSums(out[time_of_measurement,Hindex+1])+ -# rowSums(out[time_of_measurement,ICUindex+1])+rowSums(out[time_of_measurement,Ventindex+1])+rowSums(out[time_of_measurement,HCindex+1])+ -# rowSums(out[time_of_measurement,ICUCindex+1])+rowSums(out[time_of_measurement,VentCindex+1])+rowSums(out[time_of_measurement,QIindex+1])+ -# rowSums(out[time_of_measurement,QCindex+1]))/sum(popstruc[,2]) -# -# # SEROLOGY -# tail((rowSums(out[,(Rindex+1)])),1)/sum(popstruc[,2]) -# -# # IHR -# sum(ihr$severe*popstruc[,2]/sum(popstruc[,2])) -# -# -# # PORPORTIONAL MORTALITY IN THE ELDEST -# m30<-out0[30,CMindex+1]/(out0[30,Cindex+1]) -# m30[is.infinite(m30)]<-0 -# m60<-out0[60,CMindex+1]/out0[60,Cindex+1] -# m60[is.infinite(m60)]<-0 -# m90<-out0[90,CMindex+1]/out0[90,Cindex+1] -# m90[is.infinite(m90)]<-0 -# m120<-out0[120,CMindex+1]/out0[120,Cindex+1] -# m120[is.infinite(m120)]<-0 -# -# ifr30<-sum(m30*popstruc[,2]/sum(popstruc[,2]),na.rm = T) -# ifr60<-sum(m60*popstruc[,2]/sum(popstruc[,2]),na.rm = T) -# ifr90<-sum(m90*popstruc[,2]/sum(popstruc[,2]),na.rm = T) -# ifr120<-sum(m120*popstruc[,2]/sum(popstruc[,2]),na.rm = T) -# cbind(ifr30,ifr60,ifr90,ifr120)*100 -# -# PMORTDF0<-as.data.frame(cbind(out0[30,CMindex+1]/sum(out0[30,CMindex+1]),out0[60,CMindex+1]/sum(out0[60,CMindex+1]), -# out0[90,CMindex+1]/sum(out0[90,CMindex+1]),out0[120,CMindex+1]/sum(out0[120,CMindex+1]))) -# PMORTDF<-as.data.frame(cbind(out[30,CMindex+1]/sum(out[30,CMindex+1]),out[60,CMindex+1]/sum(out[60,CMindex+1]), -# out[90,CMindex+1]/sum(out[90,CMindex+1]),out[120,CMindex+1]/sum(out[120,CMindex+1]))) -# sum(PMORTDF0$V2[15:21]) -# sum(PMORTDF$V2[15:21]) -# -# -# # output doubling time over time first 7 days -# dd<-7 -# doub0<-log(2)*dd/(log(dailyinc0[2+dd]/dailyinc0[2])) -# doub0 - -# -# diff --git a/r_versions/covidage_v13.8_->_v13.13.diff b/r_versions/covidage_v13.8_->_v13.13.diff deleted file mode 100644 index 1b50a0d..0000000 --- a/r_versions/covidage_v13.8_->_v13.13.diff +++ /dev/null @@ -1,330 +0,0 @@ ---- /home/bogao/Projects/como/comoOdeCpp/r_versions/covidage_v13.8_original.R Mon Jun 8 19:51:36 2020 -+++ /home/bogao/Projects/como/comoOdeCpp/r_versions/covidage_v13.13_original.R Mon Jun 8 19:34:10 2020 -@@ -21,6 +21,7 @@ - library(shinyWidgets) - library(tidyverse) - library(XLConnect) -+# library("comoOdeCpp") - - #read data from excel file - setwd("C:/covid19/covid_age") -@@ -328,6 +329,9 @@ - - inp <- read_excel(file_path, sheet = "Interventions") - inputs<-function(inp, run){ -+ # cap intervention end dates with simulation end date -+ inp$`Date End` = pmin(stopdate, inp$`Date End`) -+ - tb<-which(inp$`Apply to`==run) - - si<-intersect(which(inp$Intervention=="Self-isolation if Symptomatic"),tb) -@@ -347,12 +351,7 @@ - - v<-(format(as.POSIXct(inp$`Date End`,format='%Y/%m/%d %H:%M:%S'),format="%d/%m/%y")) - v2<-as.Date(v,format="%d/%m/%y") -- ll<-length(v[!is.na(v)]) -- for (gg in 1:ll) { -- v2[gg]<-min(v2[gg],stopdate) -- } - inp$`Date End`<-v2 -- - - ## self isolation - f<-c() -@@ -702,6 +701,16 @@ - vectors<-inputs(inp,'Hypothetical Scenario') - vectors0<-inputs(inp,'Baseline (Calibration)') - -+f <- c(1,(1+parameters["give"])/2,(1-parameters["give"])/2,0) -+KH<-parameters["beds_available"] -+KICU<- parameters["icu_beds_available"]+parameters["ventilators_available"] -+Kvent<- parameters["ventilators_available"] -+x.H <- c(0,(1+parameters["give"])*KH/2,(3-parameters["give"])*KH/2,2*KH) -+x.ICU <- c(0,(1+parameters["give"])*KICU/2,(3-parameters["give"])*KICU/2,2*KICU) -+x.Vent <- c(0,(1+parameters["give"])*Kvent/2,(3-parameters["give"])*Kvent/2,2*Kvent) -+fH <- splinefun(x.H, f, method = "hyman") -+fICU <- splinefun(x.ICU, f, method = "hyman") -+fVent<- splinefun(x.Vent, f, method = "hyman") - - # set up a function to solve the equations - covid<-function(t, Y, parameters,input) -@@ -731,18 +740,10 @@ - VentC <- Y[VentCindex] - CMC <- Y[CMCindex] - P <- (S+E+I+R+X+V+H+HC+QS+QE+QI+QR+CL+QC+ICU+ICUC+ICUCV+Vent+VentC) -+ Q <- (sum(QS)+sum(QE)+sum(QI)+sum(QC)+sum(QR))/sum(P) -+ print(Q) - - # health system performance -- f <- c(1,(1+give)/2,(1-give)/2,0) -- KH<-beds_available -- KICU<- icu_beds_available+ventilators_available -- Kvent<- ventilators_available -- x.H <- c(0,(1+give)*KH/2,(3-give)*KH/2,2*KH) -- x.ICU <- c(0,(1+give)*KICU/2,(3-give)*KICU/2,2*KICU) -- x.Vent <- c(0,(1+give)*Kvent/2,(3-give)*Kvent/2,2*Kvent) -- fH <- splinefun(x.H, f, method = "hyman") -- fICU <- splinefun(x.ICU, f, method = "hyman") -- fVent<- splinefun(x.Vent, f, method = "hyman") - critH<-min(1-fH(sum(H)+sum(ICUC)+sum(ICUCV)),1) - crit<-min(1-fICU(sum(ICU)+sum(Vent)+sum(VentC)),1) - critV<-min(1-fVent(sum(Vent)),1) -@@ -808,7 +809,11 @@ - trvban_eff<-travelban_eff - } - if(quarantine){ -- quarantine_rate<-min(sum((I+CL+H+ICU+Vent+HC+ICUC+ICUCV+VentC)*(household_size-1)/P),1)*quarantine_cov*quarantine_effort -+ rate_q<-min((min(sum((I+CL+H+ICU+Vent+HC+ICUC+ICUCV+VentC))*(household_size-1)/sum(P),1)*quarantine_effort),quarantine_cov/2) -+ quarantine_rate<-rate_q/(1+exp(-10*(quarantine_cov/2-Q))) -+ # print(paste('Q',Q)) -+ # print(paste('rate',quarantine_rate)) -+ # print(paste('rate_q',rate_q)) - } - - -@@ -847,7 +852,7 @@ - dSdt <- -S*lam-S*vaccinate+omega*R+ageing%*%S-mort*S+birth-quarantine_rate*S +(1/quarantine_days)*QS - dEdt <- S*lam-gamma*E+ageing%*%E-mort*E + (1-vaccine_eff)*lam*V-quarantine_rate*E+(1/quarantine_days)*QE - dIdt <- gamma*(1-pclin)*(1-screen_eff)*(1-ihr[,2])*E-nui*I+ageing%*%I-mort*I + (1/quarantine_days)*QI - quarantine_rate*I -- dCLdt<- gamma*pclin*(1-selfis)*(1-ihr[,2])*E-nui*CL+ageing%*%CL-mort*CL + (1/quarantine_days)*QC -+ dCLdt<- gamma*pclin*(1-selfis)*(1-ihr[,2])*(1-quarantine_rate)*E-nui*CL+ageing%*%CL-mort*CL + (1/quarantine_days)*QC - dRdt <- nui*I-omega*R+nui*X+nui*CL+ageing%*%R-mort*R + (1/quarantine_days)*QR + nus*(1-pdeath_h*ifr[,2])*H + (1-pdeath_icu*ifr[,2])*nu_icu*ICU + (1-pdeath_icuc*ifr[,2])*nu_icuc*ICUC + (1-pdeath_ventc*ifr[,2])*nu_ventc*ICUCV + (1-pdeath_hc*ifr[,2])*nusc*HC + (1-pdeath_vent*ifr[,2])*nu_vent*Vent+ (1-pdeath_ventc*ifr[,2])*nu_ventc*VentC - dXdt <- gamma*selfis*pclin*(1-ihr[,2])*E+gamma*(1-pclin)*screen_eff*(1-ihr[,2])*E-nui*X+ageing%*%X-mort*X - dVdt <- vaccinate*S -(1-vaccine_eff)*lam*V +ageing%*%V - mort*V -@@ -855,7 +860,7 @@ - dQSdt <- quarantine_rate*S+ ageing%*%QS-mort*QS - (1/quarantine_days)*QS - lamq*QS - dQEdt <- quarantine_rate*E - gamma*QE + ageing%*%QE-mort*QE - (1/quarantine_days)*QE + lamq*QS - dQIdt <- quarantine_rate*I + gamma*(1-ihr[,2])*(1-pclin)*QE-nui*QI+ageing%*%QI-mort*QI - (1/quarantine_days)*QI -- dQCdt <- gamma*(1-ihr[,2])*pclin*QE-nui*QC+ageing%*%QC-mort*QC - (1/quarantine_days)*QC -+ dQCdt <- gamma*pclin*(1-selfis)*(1-ihr[,2])*quarantine_rate*E+gamma*(1-ihr[,2])*pclin*QE-nui*QC+ageing%*%QC-mort*QC - (1/quarantine_days)*QC - dQRdt <- nui*QI+nui*QC+ageing%*%QR-mort*QR - (1/quarantine_days)*QR - - dHdt <- gamma*ihr[,2]*(1-prob_icu)*(1-critH)*reporth*E + gamma*ihr[,2]*(1-prob_icu)*(1-critH)*QE - nus*H + ageing%*%H-mort*H -@@ -873,8 +878,8 @@ - gamma*ihr[,2]*prob_icu*(E+QE) - dCMdt<- nus*pdeath_h*ifr[,2]*H + nusc*pdeath_hc*ifr[,2]*HC + nu_icu*pdeath_icu*ifr[,2]*ICU +nu_icuc*pdeath_icuc*ifr[,2]*ICUC +nu_vent*pdeath_vent*ifr[,2]*Vent +nu_ventc*pdeath_ventc*ifr[,2]*VentC +nu_ventc*pdeath_ventc*ifr[,2]*ICUCV+ - mort*H + mort*HC + mort*ICU + mort*ICUC + mort*ICUCV + mort*Vent + mort*VentC -- dCMCdt <- nusc*pdeath_hc*ifr[,2]*HC+nu_icuc*pdeath_icuc*ifr[,2]*ICUC + nu_ventc*pdeath_ventc*ifr[,2]*VentC + nu_ventc*pdeath_ventc*ifr[,2]*ICUCV -- mort*HC + mort*ICUC + mort*VentC + mort*ICUCV -+ dCMCdt <- nusc*pdeath_hc*ifr[,2]*HC+nu_icuc*pdeath_icuc*ifr[,2]*ICUC + nu_ventc*pdeath_ventc*ifr[,2]*VentC + nu_ventc*pdeath_ventc*ifr[,2]*ICUCV+ -+ mort*HC + mort*ICUC + mort*VentC + mort*ICUCV - - # return the rate of change - list(c(dSdt,dEdt,dIdt,dRdt,dXdt,dHdt,dHCdt,dCdt,dCMdt,dVdt,dQSdt,dQEdt,dQIdt,dQRdt,dCLdt,dQCdt,dICUdt,dICUCdt,dICUCVdt,dVentdt,dVentCdt,dCMCdt)) -@@ -892,16 +897,6 @@ - crit<-c() - critV<-c() - -- f <- c(1,(1+parameters["give"])/2,(1-parameters["give"])/2,0) -- KH<-parameters["beds_available"] -- KICU<- parameters["icu_beds_available"]+parameters["ventilators_available"] -- Kvent<- parameters["ventilators_available"] -- x.H <- c(0,(1+parameters["give"])*KH/2,(3-parameters["give"])*KH/2,2*KH) -- x.ICU <- c(0,(1+parameters["give"])*KICU/2,(3-parameters["give"])*KICU/2,2*KICU) -- x.Vent <- c(0,(1+parameters["give"])*Kvent/2,(3-parameters["give"])*Kvent/2,2*Kvent) -- fH <- splinefun(x.H, f, method = "hyman") -- fICU <- splinefun(x.ICU, f, method = "hyman") -- fVent<- splinefun(x.Vent, f, method = "hyman") - for (i in 1:length(times)){ - critH[i]<-min(1-fH((sum(out[i,(Hindex+1)]))+sum(out[i,(ICUCindex+1)])+sum(out[i,(ICUCVindex+1)])),1) - crit[i]<-min(1-fICU((sum(out[i,(ICUindex+1)]))+(sum(out[i,(Ventindex+1)]))+(sum(out[i,(VentCindex+1)])))) -@@ -1006,6 +1001,9 @@ - results$hospital_surge_beds <- round(previcureq1) - results$icu_beds <- round(previcureq21) - results$ventilators <- round(previcureq31) -+ results$normal_bed_requirement <- round(reqsurge1) #real required beds. previcureq1 above is the occupancy -+ results$icu_bed_requirement <- round(reqicu1) -+ results$icu_ventilator_requirement <- round(reqvent1) - - results$death_natural_non_exposed <- round(base_mort_S1) - results$death_natural_exposed <- round(base_mort_E1 + base_mort_I1 + base_mort_CL1 + base_mort_X1 + base_mort_QS1 + -@@ -1018,8 +1016,10 @@ - results$death_untreated_hospital <- round(cinc_mort_HC1) - results$death_untreated_icu <- round(cinc_mort_ICUC1) - results$death_untreated_ventilator <- round(cinc_mort_VentC1)+round(cinc_mort_ICUCV1) -- results$total_deaths <- results$death_treated_hospital + results$death_treated_icu + results$death_treated_ventilator + -- results$death_untreated_hospital + results$death_untreated_icu + results$death_untreated_ventilator+results$death_natural_non_exposed+results$death_natural_exposed -+ results$attributable_deaths <- results$death_treated_hospital + results$death_treated_icu + results$death_treated_ventilator + -+ results$death_untreated_hospital + results$death_untreated_icu + results$death_untreated_ventilator -+ results$attributable_deaths_end <- last(results$attributable_deaths) -+ results$total_deaths <- results$attributable_deaths + results$death_natural_non_exposed + results$death_natural_exposed - results$total_deaths_end <- last(results$total_deaths) - results$total_reported_deaths_end <- last(results$cum_mortality) - results$base_mort_H <- base_mort_H1 -@@ -1103,10 +1103,18 @@ - return(results) - } - -+# covidOdeCpp_reset() -+# out <- ode(y = Y, times = times, func = covidOdeCpp, parms = parameters2, -+# input=vectors, A=A, -+# contact_home=contact_home, contact_school=contact_school, -+# contact_work=contact_work, contact_other=contact_other, -+# popbirth_col2=popbirth[,2], popstruc_col2=popstruc[,2], -+# ageing=ageing, -+# ifr_col2=ifr[,2], ihr_col2=ihr[,2], mort_col=mort) - - out0 <- ode(y = Y, times = times, method = "euler", hini = 0.05, func = covid, parms = parameters, input=vectors0) - simul_baseline <- process_ode_outcome(out0) --# write.csv(simul_baseline, paste0(hilo,"_baseline_",gsub(":|-","",Sys.time()),".csv")) -+# # write.csv(simul_baseline, paste0(hilo,"_baseline_",gsub(":|-","",Sys.time()),".csv")) - - #future interventions - #extend travel ban, quarantine, hand washing, cocooning the elderly until 1st July -@@ -1117,7 +1125,7 @@ - - pop1<-out[,(Sindex+1)]+out[,(Eindex+1)]+out[,(Iindex+1)]+out[,(CLindex+1)]+out[,(Rindex+1)]+out[,(Xindex+1)]+out[,(Vindex+1)]+ - out[,(QSindex+1)]+out[,(QEindex+1)]+out[,(QIindex+1)]+out[,(QCindex+1)]+out[,(QRindex+1)]+ -- out[,(Hindex+1)]+out[,(HCindex+1)]+out[,(ICUindex+1)]+out[,(ICUCindex+1)]+out[,(ICUCVindex+1)]+out[,(Ventindex+1)]+out[,(VentCindex+1)] -+ out[,(Hindex+1)]+out[,(HCindex+1)]+out[,(ICUindex+1)]+out[,(ICUCindex+1)]+out[,(ICUCVindex+1)]+out[,(Ventindex+1)]+out[,(VentCindex+1)] - tpop1<-rowSums(pop1) - - ############# PLOTTING -@@ -1137,7 +1145,7 @@ - text(x=xtick, y=-250, labels = format(xtick,"%b-%d"), srt = 0, xpd = TRUE) - points(as.Date(cases_rv[,1]),cases_rv[,2],pch=19,col='red') - --# reset the maximum to the cumulative mortality -+# reset the maximum to the cumulative mortality - ymax<-max(cases_rv[,3],na.rm = T) - plot(time,simul_interventions$cum_mortality,type='l',lwd=3, - main="Cumulative Mortality", xlab="Date", ylab="Total deaths", -@@ -1201,7 +1209,7 @@ - time<-as.Date(out[,"time"]+startdate) - coul=c("#047883", "#24A9E2","#051A46","#E68029", "#D63304","#D1D604") - DM0<-as.data.frame(cbind(time,simul_baseline$base_mort_I+simul_baseline$base_mort_QI, -- simul_baseline$base_mort_CL+simul_baseline$base_mort_QC, -+ simul_baseline$base_mort_CL+simul_baseline$base_mort_QC, - simul_baseline$base_mort_X, - simul_baseline$base_mort_S+simul_baseline$base_mort_QS, - simul_baseline$base_mort_E+simul_baseline$base_mort_QE, -@@ -1249,7 +1257,7 @@ - # plot(time,simul_interventions$Rt,type='l',lwd=3,col='black', - # main="Intervention", xlab="Date", ylab="Reproduction number",ylim=c(0,ymax)) - # lines(time,simul_interventions$Rt/simul_interventions$Rt,lwd=2,col='grey') --# -+# - - ## Predicted ifr - # ymax=max(c(simul_baseline$MORT1$value,simul_interventions$MORT1$value)) -@@ -1267,9 +1275,9 @@ - # cinc_mort_H1 <- parameters["nus"]*parameters["pdeath_h"]*(out[,(Hindex+1)]) - # cinc_mort_HC1 <- parameters["nusc"]*parameters["pdeath_hc"]*(out[,(HCindex+1)]) - # cinc_mort_ICU1 <- parameters["nu_icu"]*parameters["pdeath_icu"]*out[,(ICUindex+1)] --# cinc_mort_ICUC1 <- parameters["nu_icuc"]*parameters["pdeath_icuc"]*out[,(ICUCindex+1)] --# cinc_mort_Vent1 <- parameters["nu_vent"]*parameters["pdeath_vent"]*out[,(Ventindex+1)] --# cinc_mort_VentC1 <- parameters["nu_ventc"]*parameters["pdeath_ventc"]*out[,(VentCindex+1)] -+# cinc_mort_ICUC1 <- parameters["nu_icuc"]*parameters["pdeath_icuc"]*out[,(ICUCindex+1)] -+# cinc_mort_Vent1 <- parameters["nu_vent"]*parameters["pdeath_vent"]*out[,(Ventindex+1)] -+# cinc_mort_VentC1 <- parameters["nu_ventc"]*parameters["pdeath_ventc"]*out[,(VentCindex+1)] - # totage1<-as.data.frame(cinc_mort_H1+cinc_mort_HC1+cinc_mort_ICU1+cinc_mort_ICUC1+cinc_mort_Vent1+cinc_mort_VentC1) - # basemort_H1<-(out[,(Hindex+1)]) - # basemort_HC1<-(out[,(HCindex+1)]) -@@ -1282,16 +1290,16 @@ - # ages<-seq(0,100,by=5) - # for (i in 1:dim(cinc_mort_H1)[1]) { - # for (j in 1:dim(cinc_mort_H1)[2]) { --# tc<-rbind(tc,c(i,ages[j],totage1[i,j]*ifr[j,2]+totbase1[i,j]*mort[j])) -+# tc<-rbind(tc,c(i,ages[j],totage1[i,j]*ifr[j,2]+totbase1[i,j]*mort[j])) - # } - # } - # tc<-as.data.frame(tc) - # colnames(tc)<-c("Day","Age","value") - # tc$Age<-as.factor(tc$Age) --# p6<-ggplot(data=tc, aes(x=Day,y=value,fill=Age))+ -+# p6<-ggplot(data=tc, aes(x=Day,y=value,fill=Age))+ - # geom_bar(stat = "identity",position="fill", width=1)+ - # ylab("Proportion of deaths") --# -+# - # inc_mort_H0 <- parameters["nus"]*parameters["pdeath_h"]*(out0[,(Hindex+1)]) - # inc_mort_HC0 <- parameters["nusc"]*parameters["pdeath_hc"]*(out0[,(HCindex+1)]) - # inc_mort_ICU0 <- parameters["nu_icu"]*parameters["pdeath_icu"]*out0[,(ICUindex+1)] -@@ -1321,25 +1329,25 @@ - # grid.arrange(p16+theme_minimal(), - # p6+theme_minimal(), - # nrow=1) --# -- -- --# --# --# -+# -+ -+ -+# -+# -+# - # ######################################################################################################################### - # ##### SUMMARY METRICS ################################################################################################ - # ####################################################################################################################### --# -+# - # infected0<-tail((rowSums(out0[,(Rindex+1)])),1)/sum(popstruc[,2]) - # infected0 - # infected1<-tail((rowSums(out[,(Rindex+1)])),1)/sum(popstruc[,2]) - # infected1 --# -+# - # # #Population size checks - # # tpop1 - # # tpop0 --# -+# - # # PCR - # time_of_measurement<-40:49 - # # general population -@@ -1350,14 +1358,14 @@ - # rowSums(out[time_of_measurement,ICUindex+1])+rowSums(out[time_of_measurement,Ventindex+1])+rowSums(out[time_of_measurement,HCindex+1])+ - # rowSums(out[time_of_measurement,ICUCindex+1])+rowSums(out[time_of_measurement,VentCindex+1])+rowSums(out[time_of_measurement,QIindex+1])+ - # rowSums(out[time_of_measurement,QCindex+1]))/sum(popstruc[,2]) --# -+# - # # SEROLOGY - # tail((rowSums(out[,(Rindex+1)])),1)/sum(popstruc[,2]) --# -+# - # # IHR - # sum(ihr$severe*popstruc[,2]/sum(popstruc[,2])) --# --# -+# -+# - # # PORPORTIONAL MORTALITY IN THE ELDEST - # m30<-out0[30,CMindex+1]/(out0[30,Cindex+1]) - # m30[is.infinite(m30)]<-0 -@@ -1367,25 +1375,27 @@ - # m90[is.infinite(m90)]<-0 - # m120<-out0[120,CMindex+1]/out0[120,Cindex+1] - # m120[is.infinite(m120)]<-0 --# -+# - # ifr30<-sum(m30*popstruc[,2]/sum(popstruc[,2]),na.rm = T) - # ifr60<-sum(m60*popstruc[,2]/sum(popstruc[,2]),na.rm = T) - # ifr90<-sum(m90*popstruc[,2]/sum(popstruc[,2]),na.rm = T) - # ifr120<-sum(m120*popstruc[,2]/sum(popstruc[,2]),na.rm = T) - # cbind(ifr30,ifr60,ifr90,ifr120)*100 --# -+# - # PMORTDF0<-as.data.frame(cbind(out0[30,CMindex+1]/sum(out0[30,CMindex+1]),out0[60,CMindex+1]/sum(out0[60,CMindex+1]), - # out0[90,CMindex+1]/sum(out0[90,CMindex+1]),out0[120,CMindex+1]/sum(out0[120,CMindex+1]))) - # PMORTDF<-as.data.frame(cbind(out[30,CMindex+1]/sum(out[30,CMindex+1]),out[60,CMindex+1]/sum(out[60,CMindex+1]), - # out[90,CMindex+1]/sum(out[90,CMindex+1]),out[120,CMindex+1]/sum(out[120,CMindex+1]))) - # sum(PMORTDF0$V2[15:21]) - # sum(PMORTDF$V2[15:21]) --# --# -+# -+# - # # output doubling time over time first 7 days - # dd<-7 - # doub0<-log(2)*dd/(log(dailyinc0[2+dd]/dailyinc0[2])) - # doub0 - --# --# -+# -+# -+ -+ diff --git a/r_versions/covidage_v13.8_original.R b/r_versions/covidage_v13.8_original.R deleted file mode 100644 index 04a72a0..0000000 --- a/r_versions/covidage_v13.8_original.R +++ /dev/null @@ -1,1391 +0,0 @@ -require("deSolve") -library("ggplot2") -library("dplyr") -library("reshape2") -require(gridExtra) -library(ggpubr) -library(bsplus) -library(deSolve) -library(DT) -library(highcharter) -library(lubridate) -library(pushbar) -library(readxl) -library(reshape2) -library(scales) -library(shiny) -library(shinyBS) -library(shinycssloaders) -library(shinyhelper) -library(shinythemes) -library(shinyWidgets) -library(tidyverse) -library(XLConnect) - -#read data from excel file -setwd("C:/covid19/covid_age") -load("data_CoMo.RData") -file_path <- paste0(getwd(),"/Template_CoMoCOVID-19App_new.xlsx") -country_name<-"Cambodia" - -# Cases -dta <- read_excel(file_path, sheet = "Cases") -names(dta) <- c("date", "cases", "deaths") - -cases_rv <- dta %>% - mutate(date = as.Date(date), cumulative_death = cumsum(deaths)) %>% - as.data.frame() - -# Severity/Mortality -dta <- read_excel(file_path, sheet = "Severity-Mortality") -names(dta) <- c("age_category", "ifr", "ihr") - -mort_sever_rv <- dta %>% - mutate(ihr = ihr/100) %>% # starting unit should be % - scaling to a value between 0 and 1 - mutate(ifr = ifr/max(ifr)) # starting unit should be % - scaling to a value between 0 and 1 - -# Population -dta <- read_excel(file_path, sheet = "Population") -names(dta) <- c("age_category", "pop", "birth", "death") - -population_rv <- dta %>% - transmute(country = NA, age_category, pop, birth, death) - -# Parameters -param <- bind_rows(read_excel(file_path, sheet = "Parameters"), - read_excel(file_path, sheet = "Country Area Param"), - read_excel(file_path, sheet = "Virus Param"), - read_excel(file_path, sheet = "Hospitalisation Param"), - read_excel(file_path, sheet = "Interventions Param"), - read_excel(file_path, sheet = "Interventions")) %>% - mutate(Value_Date = as.Date(Value_Date)) - -# START Bridge ---- -popstruc <- population_rv %>% - select(age_category, pop) %>% - rename(agefloor = age_category) %>% - as.data.frame() - -popbirth <- population_rv %>% - select(age_category, birth) %>% - as.data.frame() # unit should be per person per day - -mort <- population_rv %>% - pull(death) # unit should be per person per day - -ihr <- mort_sever_rv %>% - select(age_category, ihr) %>% - as.data.frame() - -ifr <- mort_sever_rv %>% - select(age_category, ifr) %>% - as.data.frame() - - -######### POP AGEING -# per year ageing matrix -A<-length(popstruc[,2]) -dd<-seq(1:A)/seq(1:A) -ageing <- t(diff(diag(dd),lag=1)/(5*365.25)) -ageing<-cbind(ageing,0*seq(1:A)) # no ageing from last compartment - -# -pop<-population$country==country_name -pp<-population$pop[pop] -### CONTACT MATRICES -c_home <- contact_home[[country_name]] %>% as.matrix() -c_school <- contact_school[[country_name]] %>% as.matrix() -c_work <- contact_work[[country_name]] %>% as.matrix() -c_other <- contact_other[[country_name]] %>% as.matrix() -nce <-A-length(c_home[1,]) - -contact_home<-matrix(0,nrow=A,ncol=A) -contact_school<-matrix(0,nrow=A,ncol=A) -contact_work<-matrix(0,nrow=A,ncol=A) -contact_other<-matrix(0,nrow=A,ncol=A) - -for (i in 1:(A-nce)){ - for (j in 1:(A-nce)){ - contact_home[i,j]<-c_home[i,j] - contact_school[i,j]<-c_school[i,j] - contact_work[i,j]<-c_work[i,j] - contact_other[i,j]<-c_other[i,j] - } -} - -for (i in (A+1-nce):A){ - for (j in 1:(A-nce)){ - contact_home[i,j]<-c_home[(A-nce),j] - contact_school[i,j]<-c_school[(A-nce),j] - contact_work[i,j]<-c_work[(A-nce),j] - contact_other[i,j]<-c_other[(A-nce),j] - } -} -for (i in 1:(A-nce)){ - for (j in (A+1-nce):A){ - contact_home[i,j]<-c_home[i,(A-nce)] - contact_school[i,j]<-c_school[i,(A-nce)] - contact_work[i,j]<-c_work[i,(A-nce)] - contact_other[i,j]<-c_other[i,(A-nce)] - } -} -for (i in (A+1-nce):A){ - for (j in (A+1-nce):A){ - contact_home[i,j]<-c_home[(A-nce),(A-nce)] - contact_school[i,j]<-c_school[(A-nce),(A-nce)] - contact_work[i,j]<-c_work[(A-nce),(A-nce)] - contact_other[i,j]<-c_other[(A-nce),(A-nce)] - } -} - - - -######### INITIALISE SIMULATION/INTERVENTION START TIMES -startdate <- param$Value_Date[param$Parameter == "date_range_simul_start"] -stopdate <- param$Value_Date[param$Parameter == "date_range_simul_end"] -startdate <- startdate[1] -stopdate <- stopdate[1] - - -day_start <- as.numeric(startdate-startdate) -day_stop <- as.numeric(stopdate-startdate) -times <- seq(day_start, day_stop) - -tin<-as.numeric(startdate-as.Date("2020-01-01"))/365.25 -initP<-sum(popstruc[,2]) # population size -ageindcase<-20 # age of index case (years) -aci <- floor((ageindcase/5)+1) # age class of index case - - -############# DEFINE PARAMETERS -parameters <- c( - ### Transmission instrinsic - p = param$Value[param$Parameter=="p"][1], - rho = param$Value[param$Parameter=="rho"][1], - omega = param$Value[param$Parameter=="omega"][1], - gamma = param$Value[param$Parameter=="gamma"][1], - nui = param$Value[param$Parameter=="nui"][1], - report = param$Value[param$Parameter=="report"][1], - reportc = param$Value[param$Parameter=="reportc"][1], - reporth = param$Value[param$Parameter=="reporth"][1], - beds_available = param$Value[param$Parameter=="beds_available"][1], - icu_beds_available = param$Value[param$Parameter=="icu_beds_available"][1], - ventilators_available = param$Value[param$Parameter=="ventilators_available"][1], - give = 95, - pdeath_h = param$Value[param$Parameter=="pdeath_h"][1], - pdeath_hc = param$Value[param$Parameter=="pdeath_hc"][1], - pdeath_icu = param$Value[param$Parameter=="pdeath_icu"][1], - pdeath_icuc = param$Value[param$Parameter=="pdeath_icuc"][1], - pdeath_vent = param$Value[param$Parameter=="pdeath_vent"][1], - pdeath_ventc = param$Value[param$Parameter=="pdeath_ventc"][1], - ihr_scaling = param$Value[param$Parameter=="ihr_scaling"][1], - nus = param$Value[param$Parameter=="nus"][1], - nusc = param$Value[param$Parameter=="nus"][1], # nusc = nus - nu_icu = param$Value[param$Parameter=="nu_icu"][1], - nu_icuc = param$Value[param$Parameter=="nu_icu"][1], # nu_icuc = nu_icu - nu_vent = param$Value[param$Parameter=="nu_vent"][1], - nu_ventc = param$Value[param$Parameter=="nu_vent"][1], # nu_ventc = nu_vent - rhos = param$Value[param$Parameter=="rhos"][1], - amp = param$Value[param$Parameter=="amp"][1], - phi = param$Value[param$Parameter=="phi"][1], - pclin = param$Value[param$Parameter=="pclin"][1], - prob_icu = param$Value[param$Parameter=="prob_icu"][1], - prob_vent = param$Value[param$Parameter=="prob_vent"][1], - - ### INTERVENTIONS - # self isolation - selfis_eff = mean(param$Value[param$Parameter=="selfis_eff"],na.rm=T), - # social distancing - dist_eff = mean(param$Value[param$Parameter=="dist_eff"],na.rm=T), - # hand washing - hand_eff = mean(param$Value[param$Parameter=="hand_eff"],na.rm=T), - # working at home - work_eff = mean(param$Value[param$Parameter=="work_eff"],na.rm=T), - w2h = mean(param$Value[param$Parameter=="w2h"],na.rm=T), - # school closures - school_eff = mean(param$Value[param$Parameter=="school_eff"],na.rm=T), - s2h = mean(param$Value[param$Parameter=="s2h"],na.rm=T), - # cocooning the elderly - cocoon_eff = mean(param$Value[param$Parameter=="cocoon_eff"],na.rm=T), - age_cocoon = mean(param$Value[param$Parameter=="age_cocoon"],na.rm=T), - # vaccination campaign - # vaccine_on = as.numeric(param$Value_Date[param$Parameter=="date_vaccine_on"] - startdate), - vaccine_eff = mean(param$Value[param$Parameter=="vaccine_eff"],na.rm=T), - # vaccine_cov = param$Value[param$Parameter=="vaccine_cov"], - vac_campaign = mean(param$Value[param$Parameter=="vac_campaign"],na.rm=T), - # travel ban - mean_imports = mean(param$Value[param$Parameter=="mean_imports"],na.rm=T), - # screening - screen_test_sens = mean(param$Value[param$Parameter=="screen_test_sens"],na.rm=T), - # screen_contacts = mean(param$Value[param$Parameter=="screen_contacts"],na.rm=T), - screen_overdispersion = mean(param$Value[param$Parameter=="screen_overdispersion"],na.rm=T), - # voluntary home quarantine - quarantine_days = mean(param$Value[param$Parameter=="quarantine_days"],na.rm=T), - quarantine_effort = mean(param$Value[param$Parameter=="quarantine_effort"],na.rm=T), - quarantine_eff_home = mean(param$Value[param$Parameter=="quarantine_eff_home"],na.rm=T), - quarantine_eff_other = mean(param$Value[param$Parameter=="quarantine_eff_other"],na.rm=T), - - household_size = param$Value[param$Parameter=="household_size"][1] -) -ihr[,2]<- parameters["ihr_scaling"]*ihr[,2] - -# Scale parameters to percentages/ rates -parameters["rho"]<-parameters["rho"]/100 -parameters["omega"]<-(1/(parameters["omega"]*365)) -parameters["gamma"]<-1/parameters["gamma"] -parameters["nui"]<-1/parameters["nui"] -parameters["report"]<-parameters["report"]/100 -parameters["reportc"]<-parameters["reportc"]/100 -parameters["reporth"]<-parameters["reporth"]/100 -parameters["nus"]<-1/parameters["nus"] -parameters["rhos"]<-parameters["rhos"]/100 -parameters["amp"]<-parameters["amp"]/100 -parameters["selfis_eff"]<-parameters["selfis_eff"]/100 -parameters["dist_eff"]<-parameters["dist_eff"]/100 -parameters["hand_eff"]<-parameters["hand_eff"]/100 -parameters["work_eff"]<-parameters["work_eff"]/100 -parameters["w2h"]<-parameters["w2h"]/100 -parameters["school_eff"]<-parameters["school_eff"]/100 -parameters["s2h"]<-parameters["s2h"]/100 -parameters["cocoon_eff"]<-parameters["cocoon_eff"]/100 -parameters["age_cocoon"]<-floor((parameters["age_cocoon"]/5)+1) -parameters["vaccine_eff"]<-parameters["vaccine_eff"]/100 -# parameters["vaccine_cov"]<-parameters["vaccine_cov"]/100 -# parameters["vac_campaign"]<-parameters["vac_campaign"]*7 -parameters["screen_test_sens"]<-parameters["screen_test_sens"]/100 -parameters["quarantine_days"]<-parameters["quarantine_days"] -parameters["quarantine_effort"]<-1/parameters["quarantine_effort"] -parameters["quarantine_eff_home"]<-parameters["quarantine_eff_home"]/-100 -parameters["quarantine_eff_other"]<-parameters["quarantine_eff_other"]/100 -parameters["give"]<-parameters["give"]/100 -parameters["pdeath_h"]<-parameters["pdeath_h"]/100 -parameters["pdeath_hc"]<-parameters["pdeath_hc"]/100 -parameters["pdeath_icu"]<-parameters["pdeath_icu"]/100 -parameters["pdeath_icuc"]<-parameters["pdeath_icuc"]/100 -parameters["pdeath_vent"]<-parameters["pdeath_vent"]/100 -parameters["pdeath_ventc"]<-parameters["pdeath_ventc"]/100 -parameters["nusc"]<-1/parameters["nusc"] -parameters["nu_icu"]<-1/parameters["nu_icu"] -parameters["nu_icuc"]<-1/parameters["nu_icuc"] -parameters["nu_vent"]<-1/parameters["nu_vent"] -parameters["nu_ventc"]<-1/parameters["nu_ventc"] -parameters["pclin"]<-parameters["pclin"]/100 -parameters["prob_icu"]<-parameters["prob_icu"]/100 -parameters["prob_vent"]<-parameters["prob_vent"]/100 -parameters2<-parameters - -########################################################################### -# Define the indices for each variable -Sindex<-1:A -Eindex<-(A+1):(2*A) -Iindex<-(2*A+1):(3*A) -Rindex<-(3*A+1):(4*A) -Xindex<-(4*A+1):(5*A) -Hindex<-(5*A+1):(6*A) -HCindex<-(6*A+1):(7*A) -Cindex<-(7*A+1):(8*A) -CMindex<-(8*A+1):(9*A) -Vindex<-(9*A+1):(10*A) -QSindex<-(10*A+1):(11*A) -QEindex<-(11*A+1):(12*A) -QIindex<-(12*A+1):(13*A) -QRindex<-(13*A+1):(14*A) -CLindex<-(14*A+1):(15*A) -QCindex<-(15*A+1):(16*A) -ICUindex<-(16*A+1):(17*A) -ICUCindex<-(17*A+1):(18*A) -ICUCVindex<-(18*A+1):(19*A) -Ventindex<-(19*A+1):(20*A) -VentCindex<-(20*A+1):(21*A) -CMCindex<-(21*A+1):(22*A) - -########################################################################### -# MODEL INITIAL CONDITIONS -initI<-0*popstruc[,2] # Infected and symptomatic -initE<-0*popstruc[,2] # Incubating -initE[aci]<-1 # place random index case in E compartment -initR<-0*popstruc[,2] # Immune -initX<-0*popstruc[,2] # Isolated -initV<-0*popstruc[,2] # Vaccinated -initQS<-0*popstruc[,2] # quarantined S -initQE<-0*popstruc[,2] # quarantined E -initQI<-0*popstruc[,2] # quarantined I -initQR<-0*popstruc[,2] # quarantined R -initH<-0*popstruc[,2] # hospitalised -initHC<-0*popstruc[,2] # hospital critical -initC<-0*popstruc[,2] # Cumulative cases (true) -initCM<-0*popstruc[,2] # Cumulative deaths (true) -initCL<-0*popstruc[,2] # symptomatic cases -initQC<-0*popstruc[,2] # quarantined C -initICU<-0*popstruc[,2] # icu -initICUC<-0*popstruc[,2] # icu critical -initICUCV<-0*popstruc[,2] # icu critical -initVent<-0*popstruc[,2] # icu vent -initVentC<-0*popstruc[,2] # icu vent crit -initCMC<-0*popstruc[,2] # Cumulative deaths (true) -initS<-popstruc[,2]-initE-initI-initR-initX-initV-initH-initHC-initQS-initQE-initQI-initQR-initCL-initQC-initICU-initICUC-initICUCV-initVent-initVentC # Susceptible (non-immune) - - -inp <- read_excel(file_path, sheet = "Interventions") -inputs<-function(inp, run){ - tb<-which(inp$`Apply to`==run) - - si<-intersect(which(inp$Intervention=="Self-isolation if Symptomatic"),tb) - scr<-intersect(which(inp$Intervention=="Screening (when S.I.)"),tb) - sd<-intersect(which(inp$Intervention=="Social Distancing"),tb) - hw<-intersect(which(inp$Intervention=="Handwashing"),tb) - wah<-intersect(which(inp$Intervention=="Working at Home"),tb) - sc<-intersect(which(inp$Intervention=="School Closures"),tb) - cte<-intersect(which(inp$Intervention=="Shielding the Elderly"),tb) - q<-intersect(which(inp$Intervention=="Household Isolation (when S.I.)"),tb) - tb<-intersect(which(inp$Intervention=="International Travel Ban"),tb) - vc<-intersect(which(inp$Intervention=="Vaccination"),tb) - - v<-(format(as.POSIXct(inp$`Date Start`,format='%Y/%m/%d %H:%M:%S'),format="%d/%m/%y")) - v2<-as.Date(v,format="%d/%m/%y") - inp$`Date Start`<-v2 - - v<-(format(as.POSIXct(inp$`Date End`,format='%Y/%m/%d %H:%M:%S'),format="%d/%m/%y")) - v2<-as.Date(v,format="%d/%m/%y") - ll<-length(v[!is.na(v)]) - for (gg in 1:ll) { - v2[gg]<-min(v2[gg],stopdate) - } - inp$`Date End`<-v2 - - - ## self isolation - f<-c() - si_vector<-c() - isolation<-c() - if (length(si)>=1){ - for (i in 1:length(si)){ - f<-c(f,as.numeric(inp$`Date Start`[si[i]]-startdate),as.numeric(inp$`Date End`[si[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[si[i]]>startdate){ - si_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[si[i]],(f[i+1]-f[i])*20)) - isolation<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - si_vector<-c(rep(inp$`Value`[si[i]],(f[i+1])*20)) - isolation<-c(rep(1,(f[i+1])*20)) - } - } - else{ - si_vector<-c(si_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - si_vector<-c(si_vector,rep(inp$`Value`[si[i]],(f[i*2]-f[i*2-1])*20)) - isolation<-c(isolation,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - isolation<-c(isolation,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(si) && f[i*2]=1){ - for (i in 1:length(sd)){ - - f<-c(f,as.numeric(inp$`Date Start`[sd[i]]-startdate),as.numeric(inp$`Date End`[sd[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[sd[i]]>startdate){ - sd_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[sd[i]],(f[i+1]-f[i])*20)) - distancing<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - sd_vector<-c(rep(inp$`Value`[sd[i]],(f[i+1])*20)) - distancing<-c(rep(1,(f[i+1])*20)) - } - } - else{ - sd_vector<-c(sd_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - sd_vector<-c(sd_vector,rep(inp$`Value`[sd[i]],(f[i*2]-f[i*2-1])*20)) - distancing<-c(distancing,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - distancing<-c(distancing,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(sd)&& f[i*2]=1){ - for (i in 1:length(scr)){ - - f<-c(f,as.numeric(inp$`Date Start`[scr[i]]-startdate),as.numeric(inp$`Date End`[scr[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[scr[i]]>startdate){ - scr_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[scr[i]],(f[i+1]-f[i])*20)) - screen<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - scr_vector<-c(rep(inp$`Value`[scr[i]],(f[i+1])*20)) - screen<-c(rep(1,(f[i+1])*20)) - } - } - else{ - scr_vector<-c(scr_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - scr_vector<-c(scr_vector,rep(inp$`Value`[scr[i]],(f[i*2]-f[i*2-1])*20)) - screen<-c(screen,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - screen<-c(screen,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(scr)&& f[i*2]=1){ - for (i in 1:length(hw)){ - - f<-c(f,as.numeric(inp$`Date Start`[hw[i]]-startdate),as.numeric(inp$`Date End`[hw[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[hw[i]]>startdate){ - hw_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[hw[i]],(f[i+1]-f[i])*20)) - handwash<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - hw_vector<-c(rep(inp$`Value`[hw[i]],(f[i+1])*20)) - handwash<-c(rep(1,(f[i+1])*20)) - } - } - else{ - hw_vector<-c(hw_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - hw_vector<-c(hw_vector,rep(inp$`Value`[hw[i]],(f[i*2]-f[i*2-1])*20)) - handwash<-c(handwash,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - handwash<-c(handwash,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(hw)&& f[i*2]=1){ - for (i in 1:length(wah)){ - - f<-c(f,as.numeric(inp$`Date Start`[wah[i]]-startdate),as.numeric(inp$`Date End`[wah[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[wah[i]]>startdate){ - wah_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[wah[i]],(f[i+1]-f[i])*20)) - workhome<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - wah_vector<-c(rep(inp$`Value`[wah[i]],(f[i+1])*20)) - workhome<-c(rep(1,(f[i+1])*20)) - } - } - else{ - wah_vector<-c(wah_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - wah_vector<-c(wah_vector,rep(inp$`Value`[wah[i]],(f[i*2]-f[i*2-1])*20)) - workhome<-c(workhome,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - workhome<-c(workhome,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(wah)&& f[i*2]=1){ - for (i in 1:length(sc)){ - - f<-c(f,as.numeric(inp$`Date Start`[sc[i]]-startdate),as.numeric(inp$`Date End`[sc[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[sc[i]]>startdate){ - sc_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[sc[i]],(f[i+1]-f[i])*20)) - schoolclose<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - sc_vector<-c(rep(inp$`Value`[sc[i]],(f[i+1])*20)) - schoolclose<-c(rep(1,(f[i+1])*20)) - } - } - else{ - sc_vector<-c(sc_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - sc_vector<-c(sc_vector,rep(inp$`Value`[sc[i]],(f[i*2]-f[i*2-1])*20)) - schoolclose<-c(schoolclose,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - schoolclose<-c(schoolclose,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(sc)&& f[i*2]=1){ - for (i in 1:length(cte)){ - - f<-c(f,as.numeric(inp$`Date Start`[cte[i]]-startdate),as.numeric(inp$`Date End`[cte[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[cte[i]]>startdate){ - cte_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[cte[i]],(f[i+1]-f[i])*20)) - cocoon<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - cte_vector<-c(rep(inp$`Value`[cte[i]],(f[i+1])*20)) - cocoon<-c(rep(1,(f[i+1])*20)) - } - } - else{ - cte_vector<-c(cte_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - cte_vector<-c(cte_vector,rep(inp$`Value`[cte[i]],(f[i*2]-f[i*2-1])*20)) - cocoon<-c(cocoon,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - cocoon<-c(cocoon,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(cte)&& f[i*2]=1){ - for (i in 1:length(q)){ - - f<-c(f,as.numeric(inp$`Date Start`[q[i]]-startdate),as.numeric(inp$`Date End`[q[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[q[i]]>startdate){ - q_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[q[i]],(f[i+1]-f[i])*20)) - quarantine<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - q_vector<-c(rep(inp$`Value`[q[i]],(f[i+1])*20)) - quarantine<-c(rep(1,(f[i+1])*20)) - } - } - else{ - q_vector<-c(q_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - q_vector<-c(q_vector,rep(inp$`Value`[q[i]],(f[i*2]-f[i*2-1])*20)) - quarantine<-c(quarantine,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - quarantine<-c(quarantine,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(q)&& f[i*2]=1){ - for (i in 1:length(tb)){ - - f<-c(f,as.numeric(inp$`Date Start`[tb[i]]-startdate),as.numeric(inp$`Date End`[tb[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[tb[i]]>startdate){ - tb_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[tb[i]],(f[i+1]-f[i])*20)) - travelban<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - tb_vector<-c(rep(inp$`Value`[tb[i]],(f[i+1])*20)) - travelban<-c(rep(1,(f[i+1])*20)) - } - } - else{ - tb_vector<-c(tb_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - tb_vector<-c(tb_vector,rep(inp$`Value`[tb[i]],(f[i*2]-f[i*2-1])*20)) - travelban<-c(travelban,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - travelban<-c(travelban,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(tb)&& f[i*2]=1){ - for (i in 1:length(vc)){ - - f<-c(f,as.numeric(inp$`Date Start`[vc[i]]-startdate),as.numeric(inp$`Date End`[vc[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[vc[i]]>startdate){ - vc_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[vc[i]],(f[i+1]-f[i])*20)) - vaccine<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - vc_vector<-c(rep(inp$`Value`[vc[i]],(f[i+1])*20)) - vaccine<-c(rep(1,(f[i+1])*20)) - } - } - else{ - vc_vector<-c(vc_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - vc_vector<-c(vc_vector,rep(inp$`Value`[vc[i]],(f[i*2]-f[i*2-1])*20)) - vaccine<-c(vaccine,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - vaccine<-c(vaccine,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(vc)&& f[i*2]= 7) {Rt[i] <- NA} - } - - # Export in a cohesive format ---- - results <- list() - results$time <- startdate + times # dates - results$Rt <- Rt - results$cum_mortality <- round(cmortality1) # cumulative mortality - results$pct_total_pop_infected <- round(100 * tail(cumsum(rowSums(parameters["gamma"]*out[,(Eindex+1)])),1)/sum(popstruc[,2]), 1) # proportion of the population that has been infected at the end of the simulation - results$doubling_time <- round(log(2)*7 / (log(dailyinc1[2+7] / dailyinc1[2])), 2) # (Baseline only) to double the number of infections at inception - results$required_beds <- round(previcureq1) # required beds - results$saturation <- parameters["beds_available"] # saturation - results$daily_incidence <- round(dailyinc1) # daily incidence (Reported) - results$daily_total_cases <- round(rowSums(parameters["gamma"]*out[,(Eindex+1)]+parameters["gamma"]*out[,(QEindex+1)])) # daily incidence (Reported + Unreported) # daily incidence (Reported + Unreported) - results$hospital_surge_beds <- round(previcureq1) - results$icu_beds <- round(previcureq21) - results$ventilators <- round(previcureq31) - - results$death_natural_non_exposed <- round(base_mort_S1) - results$death_natural_exposed <- round(base_mort_E1 + base_mort_I1 + base_mort_CL1 + base_mort_X1 + base_mort_QS1 + - base_mort_QE1 + base_mort_QI1 + base_mort_QC1 + base_mort_QR1 + base_mort_R1+ - base_mort_H1+base_mort_HC1+base_mort_ICU1+base_mort_ICUC1+base_mort_ICUCV1+ - base_mort_Vent1+base_mort_VentC1) - results$death_treated_hospital <- round(cinc_mort_H1) - results$death_treated_icu <- round(cinc_mort_ICU1) - results$death_treated_ventilator <- round(cinc_mort_Vent1) - results$death_untreated_hospital <- round(cinc_mort_HC1) - results$death_untreated_icu <- round(cinc_mort_ICUC1) - results$death_untreated_ventilator <- round(cinc_mort_VentC1)+round(cinc_mort_ICUCV1) - results$total_deaths <- results$death_treated_hospital + results$death_treated_icu + results$death_treated_ventilator + - results$death_untreated_hospital + results$death_untreated_icu + results$death_untreated_ventilator+results$death_natural_non_exposed+results$death_natural_exposed - results$total_deaths_end <- last(results$total_deaths) - results$total_reported_deaths_end <- last(results$cum_mortality) - results$base_mort_H <- base_mort_H1 - results$base_mort_HC <- base_mort_HC1 - results$base_mort_ICU <- base_mort_ICU1 - results$base_mort_ICUC <- base_mort_ICUC1 - results$base_mort_ICUCV <- base_mort_ICUCV1 - results$base_mort_Vent <- base_mort_Vent1 - results$base_mort_VentC <- base_mort_VentC1 - results$base_mort_S <- base_mort_S1 - results$base_mort_E <- base_mort_E1 - results$base_mort_I <- base_mort_I1 - results$base_mort_CL <- base_mort_CL1 - results$base_mort_X <- base_mort_X1 - results$base_mort_QS <- base_mort_QS1 - results$base_mort_QE <- base_mort_QE1 - results$base_mort_QI <- base_mort_QI1 - results$base_mort_QC <- base_mort_QC1 - results$base_mort_QR <- base_mort_QR1 - results$base_mort_R <- base_mort_R1 - - ## AGE DEPENDENT MORTALITY - cinc_mort_H1 <- parameters["nus"]*parameters["pdeath_h"]*(out[,(Hindex+1)]) - cinc_mort_HC1 <- parameters["nusc"]*parameters["pdeath_hc"]*(out[,(HCindex+1)]) - cinc_mort_ICU1 <- parameters["nu_icu"]*parameters["pdeath_icu"]*out[,(ICUindex+1)] - cinc_mort_ICUC1 <- parameters["nu_icuc"]*parameters["pdeath_icuc"]*out[,(ICUCindex+1)] - cinc_mort_ICUCV1 <- parameters["nu_ventc"]*parameters["pdeath_ventc"]*out[,(ICUCVindex+1)] - cinc_mort_Vent1 <- parameters["nu_vent"]*parameters["pdeath_vent"]*out[,(Ventindex+1)] - cinc_mort_VentC1 <- parameters["nu_ventc"]*parameters["pdeath_ventc"]*out[,(VentCindex+1)] - totage1<-as.data.frame(cinc_mort_H1+cinc_mort_HC1+cinc_mort_ICU1+cinc_mort_ICUC1+cinc_mort_ICUCV1+cinc_mort_Vent1+cinc_mort_VentC1) - basemort_H1<-(out[,(Hindex+1)]) - basemort_HC1<-(out[,(HCindex+1)]) - basemort_ICU1<-(out[,(ICUindex+1)]) - basemort_ICUC1<-(out[,(ICUCindex+1)]) - basemort_ICUCV1<-(out[,(ICUCVindex+1)]) - basemort_Vent1<-(out[,(Ventindex+1)]) - basemort_VentC1<-(out[,(VentCindex+1)]) - totbase1<-as.data.frame(basemort_H1+basemort_HC1+basemort_ICU1+basemort_ICUC1+basemort_ICUCV1+basemort_Vent1+basemort_VentC1) - tc<-c() - - for (i in 1:dim(cinc_mort_H1)[1]) { - for (j in 1:dim(cinc_mort_H1)[2]) { - tc<-rbind(tc,c(i, j, totage1[i,j]*ifr[j,2]+totbase1[i,j]*mort[j])) - } - } - tc<-as.data.frame(tc) - colnames(tc)<-c("Day","Age","value") - - results$tc <- tc %>% - mutate(Date = startdate + Day, - age_cat = case_when( - Age >= 1 & Age <= 6 ~ "≤ 30 y.o.", - Age > 6 & Age <= 8 ~ "30-40 y.o.", - Age > 8 & Age <= 10 ~ "40-50 y.o.", - Age > 10 & Age <= 12 ~ "50-60 y.o.", - Age > 12 & Age <= 14 ~ "60-70 y.o.", - Age >= 15 ~ "≥ 70 y.o.")) %>% - mutate(age_cat = factor(age_cat, levels = rev(c("≤ 30 y.o.", "30-40 y.o.", - "40-50 y.o.", "50-60 y.o.", "60-70 y.o.", "≥ 70 y.o.")))) - - mortality_lag <- data.frame(Age = popstruc$agefloor) - if(nrow(out) >= 30) mortality_lag <- bind_cols(mortality_lag, - data.frame(day30 = out[30,CMindex+1]/out[30,Cindex+1]) %>% - mutate(day30 = ifelse(is.infinite(day30), 0, day30)) %>% - rename(`Day 30` = day30)) - if(nrow(out) >= 60) mortality_lag <- bind_cols(mortality_lag, - data.frame(day60 = out[60,CMindex+1]/out[60,Cindex+1]) %>% - mutate(day60 = ifelse(is.infinite(day60), 0, day60)) %>% - rename(`Day 60` = day60)) - if(nrow(out) >= 90) mortality_lag <- bind_cols(mortality_lag, - data.frame(day90 = out[90,CMindex+1]/out[90,Cindex+1]) %>% - mutate(day90 = ifelse(is.infinite(day90), 0, day90)) %>% - rename(`Day 90` = day90)) - if(nrow(out) >= 120) mortality_lag <- bind_cols(mortality_lag, - data.frame(day120 = out[120,CMindex+1]/out[120,Cindex+1]) %>% - mutate(day120 = ifelse(is.infinite(day120), 0, day120)) %>% - rename(`Day 120` = day120)) - - results$mortality_lag <- mortality_lag - - return(results) -} - - -out0 <- ode(y = Y, times = times, method = "euler", hini = 0.05, func = covid, parms = parameters, input=vectors0) -simul_baseline <- process_ode_outcome(out0) -# write.csv(simul_baseline, paste0(hilo,"_baseline_",gsub(":|-","",Sys.time()),".csv")) - -#future interventions -#extend travel ban, quarantine, hand washing, cocooning the elderly until 1st July -parameters2 <- parameters -out <- ode(y = Y, times = times, method = "euler", hini = 0.05, func = covid, parms = parameters2,input=vectors) -simul_interventions <- process_ode_outcome(out) -# write.csv(simul_interventions, paste0(hilo,"_futureIntv_",gsub(":|-","",Sys.time()),".csv")) - -pop1<-out[,(Sindex+1)]+out[,(Eindex+1)]+out[,(Iindex+1)]+out[,(CLindex+1)]+out[,(Rindex+1)]+out[,(Xindex+1)]+out[,(Vindex+1)]+ - out[,(QSindex+1)]+out[,(QEindex+1)]+out[,(QIindex+1)]+out[,(QCindex+1)]+out[,(QRindex+1)]+ - out[,(Hindex+1)]+out[,(HCindex+1)]+out[,(ICUindex+1)]+out[,(ICUCindex+1)]+out[,(ICUCVindex+1)]+out[,(Ventindex+1)]+out[,(VentCindex+1)] -tpop1<-rowSums(pop1) - -############# PLOTTING -# Fitting tab -# fitting the intervention lines to the data to account for any historical interventions -time<-as.Date(out0[,1]+startdate) -par(mfrow=c(1,2)) -# set up the axis limits -xmin<-min(as.Date(cases_rv[,1])) -xmax<-max(as.Date(cases_rv[,1])) -ymax<-max(cases_rv[,2],na.rm = T) -xtick<-seq(xmin, xmax, by=7) -plot(time,simul_interventions$daily_incidence,type='l',lwd=3, - main="New Reported Cases", xlab="Date", ylab="Cases per day", - xlim=c(xmin,xmax), ylim=c(0,ymax), col='blue',xaxt="n") -axis(side=1, labels = FALSE) -text(x=xtick, y=-250, labels = format(xtick,"%b-%d"), srt = 0, xpd = TRUE) -points(as.Date(cases_rv[,1]),cases_rv[,2],pch=19,col='red') - -# reset the maximum to the cumulative mortality -ymax<-max(cases_rv[,3],na.rm = T) -plot(time,simul_interventions$cum_mortality,type='l',lwd=3, - main="Cumulative Mortality", xlab="Date", ylab="Total deaths", - xlim=c(xmin,xmax), ylim=c(0,ymax), col='blue',xaxt="n") -text(x=xtick, y=-100, labels = format(xtick,"%b-%d"), srt = 0, xpd = TRUE) -points(as.Date(cases_rv[,1]),cases_rv[,3],pch=19,col='red') - - -### Predictions tab -par(mfrow=c(1,2)) -### Cases at baseline and intervention -ymax<-max(c(cases_rv[,2],simul_baseline$daily_incidence,simul_interventions$daily_incidence),na.rm=T) -plot(time,simul_baseline$daily_incidence,type='l',lwd=3,col='blue', - main="Baseline", xlab="Date", ylab="New cases per day",ylim=c(0,ymax)) -points(as.Date(cases_rv[,1]),cases_rv[,2],pch=19,col='red') -plot(time,simul_interventions$daily_incidence,type='l',lwd=3,col='blue', - main="Intervention", xlab="Date", ylab="New cases per day",ylim=c(0,ymax)) -points(as.Date(cases_rv[,1]),cases_rv[,2],pch=19,col='red') - - - -# # Hospital prevalences stratified by H,ICU and Vent -ymax<-max(c((simul_baseline$hospital_surge_beds+simul_baseline$icu_beds+simul_baseline$ventilators),(simul_interventions$hospital_surge_beds+simul_interventions$icu_beds+simul_interventions$ventilators))) -time<-as.Date(out[,"time"]+startdate) -coul=c("#047883", "#24A9E2","#051A46") -DM<-as.data.frame(cbind(time,simul_baseline$hospital_surge_beds,simul_baseline$icu_beds,simul_baseline$ventilators)) -colnames(DM)<-c("Time","Hospital surge beds","ICU beds","Ventilators") -DM$Time<-as.Date(DM$Time,origin = "1970-01-01") -DMF<-melt(DM, id.vars="Time",measure.vars = c("Hospital surge beds","ICU beds","Ventilators")) -d0<-ggplot(DMF, aes(x = Time, y = value,fill=variable)) + - geom_area()+ - scale_fill_manual(values=coul) - -DM<-as.data.frame(cbind(time,simul_interventions$hospital_surge_beds,simul_interventions$icu_beds,simul_interventions$ventilators)) -colnames(DM)<-c("Time","Hospital surge beds","ICU beds","Ventilators") -DM$Time<-as.Date(DM$Time, origin = "1970-01-01") -DMF<-melt(DM, id.vars="Time",measure.vars = c("Hospital surge beds","ICU beds","Ventilators")) -d1<-ggplot(DMF, aes(x = Time, y = value,fill=variable)) + - geom_area()+ - scale_fill_manual(values=coul) - -grid.arrange(d0+ylab("Number of Patients")+ - ggtitle("Baseline")+ - ylim(0, ymax)+ - geom_hline(yintercept=(parameters["beds_available"]+parameters["icu_beds_available"]+parameters["ventilators_available"]), linetype="dashed", color = "#047883")+ - geom_hline(yintercept=(parameters["icu_beds_available"]+parameters["ventilators_available"]), linetype="dashed", color = "#24A9E2")+ - geom_hline(yintercept=parameters["ventilators_available"], linetype="dashed", color = "#051A46")+ - theme_bw(), - d1+ylab("Number of Patients")+ - ggtitle("Intervention")+ - ylim(0, ymax)+ - geom_hline(yintercept=(parameters["beds_available"]+parameters["icu_beds_available"]+parameters["ventilators_available"]), linetype="dashed", color = "#047883")+ - geom_hline(yintercept=(parameters["icu_beds_available"]+parameters["ventilators_available"]), linetype="dashed", color = "#24A9E2")+ - geom_hline(yintercept=parameters["ventilators_available"], linetype="dashed", color = "#051A46")+ - theme_bw(), - nrow = 1) - - -# # Cumulative mortality at baseline and intervention stratified by hospital status -ymax<-max(c((simul_baseline$total_deaths),(simul_interventions$total_deaths))) -time<-as.Date(out[,"time"]+startdate) -coul=c("#047883", "#24A9E2","#051A46","#E68029", "#D63304","#D1D604") -DM0<-as.data.frame(cbind(time,simul_baseline$base_mort_I+simul_baseline$base_mort_QI, - simul_baseline$base_mort_CL+simul_baseline$base_mort_QC, - simul_baseline$base_mort_X, - simul_baseline$base_mort_S+simul_baseline$base_mort_QS, - simul_baseline$base_mort_E+simul_baseline$base_mort_QE, - simul_baseline$base_mort_QR+simul_baseline$base_mort_R, - simul_baseline$death_treated_hospital, - simul_baseline$death_treated_icu, - simul_baseline$death_treated_ventilator, - simul_baseline$death_untreated_hospital, - simul_baseline$death_untreated_icu, - simul_baseline$death_untreated_ventilator)) -colnames(DM0)<-c("Time","Asymptomatic","Clnical","Self-Isolating","Susceptible","Exposed","Recovered", - "Treated: Hospital","Treated: ICU","Treated: Ventilator","Untreated: Hospital","Untreated: ICU","Untreated: Ventilator") -DM0$Time<-as.Date(DM0$Time, origin = "1970-01-01") -DMF0<-melt(DM0, id.vars="Time",measure.vars = c("Asymptomatic","Clnical","Self-Isolating","Susceptible","Exposed","Recovered", - "Treated: Hospital","Treated: ICU","Treated: Ventilator","Untreated: Hospital","Untreated: ICU","Untreated: Ventilator")) -m0<-ggplot(DMF0, aes(x = Time, y = value,fill=variable)) + - geom_area() - -DM<-as.data.frame(cbind(time,simul_interventions$base_mort_I+simul_interventions$base_mort_QI,simul_interventions$base_mort_CL+simul_interventions$base_mort_QC,simul_interventions$base_mort_X,simul_interventions$base_mort_S+ - simul_interventions$base_mort_QS,simul_interventions$base_mort_E+simul_interventions$base_mort_QE,simul_interventions$base_mort_QR+simul_interventions$base_mort_R, - simul_interventions$death_treated_hospital,simul_interventions$death_treated_icu,simul_interventions$death_treated_ventilator,simul_interventions$death_untreated_hospital,simul_interventions$death_untreated_icu,simul_interventions$death_untreated_ventilator)) -colnames(DM)<-c("Time","Asymptomatic","Clnical","Self-Isolating","Susceptible","Exposed","Recovered", - "Treated: Hospital","Treated: ICU","Treated: Ventilator","Untreated: Hospital","Untreated: ICU","Untreated: Ventilator") -DM$Time<-as.Date(DM$Time, origin = "1970-01-01") -DMF<-melt(DM, id.vars="Time",measure.vars = c("Asymptomatic","Clnical","Self-Isolating","Susceptible","Exposed","Recovered", - "Treated: Hospital","Treated: ICU","Treated: Ventilator","Untreated: Hospital","Untreated: ICU","Untreated: Ventilator")) -m1<-ggplot(DMF, aes(x = Time, y = value,fill=variable)) + - geom_area() -grid.arrange(m0+ylab("Cumulatice mortality")+ - ggtitle("Baseline")+ - ylim(0, ymax), - m1+ylab("Cumulatice mortality")+ - ggtitle("Intervention")+ - ylim(0, ymax), - nrow = 1) - - - -# # Estimated basic reproduction number, R_t -# par(mfrow=c(1,2)) -# ymax<-max(c(simul_baseline$Rt[!is.na(simul_baseline$Rt)],simul_interventions$Rt[!is.na(simul_interventions$Rt)])) -# plot(time,simul_baseline$Rt,type='l',lwd=3,col='black', -# main="Baseline", xlab="Date", ylab="Reproduction number",ylim=c(0,ymax)) -# lines(time,simul_baseline$Rt/simul_baseline$Rt,lwd=2,col='grey') -# plot(time,simul_interventions$Rt,type='l',lwd=3,col='black', -# main="Intervention", xlab="Date", ylab="Reproduction number",ylim=c(0,ymax)) -# lines(time,simul_interventions$Rt/simul_interventions$Rt,lwd=2,col='grey') -# - -## Predicted ifr -# ymax=max(c(simul_baseline$MORT1$value,simul_interventions$MORT1$value)) -# gm<-ggplot(data=simul_interventions$MORT1,aes(x=Age,y=value,fill=variable))+ -# geom_line(data=simul_interventions$MORT1,aes(x=Age,y=value,colour=variable),lwd=1.5)+ylim(0,ymax)+ylab("Mortality") -# gm0<-ggplot(data=simul_baseline$MORT1,aes(x=Age,y=value,fill=variable))+ -# geom_line(data=simul_baseline$MORT1,aes(x=Age,y=value,colour=variable),lwd=1.5)+ylim(0,ymax)+ylab("Mortality") - -# grid.arrange(gm+theme_classic(), -# gm0+theme_classic(), -# nrow=1) - - -# ## AGE DEPENDENT MORTALITY -# cinc_mort_H1 <- parameters["nus"]*parameters["pdeath_h"]*(out[,(Hindex+1)]) -# cinc_mort_HC1 <- parameters["nusc"]*parameters["pdeath_hc"]*(out[,(HCindex+1)]) -# cinc_mort_ICU1 <- parameters["nu_icu"]*parameters["pdeath_icu"]*out[,(ICUindex+1)] -# cinc_mort_ICUC1 <- parameters["nu_icuc"]*parameters["pdeath_icuc"]*out[,(ICUCindex+1)] -# cinc_mort_Vent1 <- parameters["nu_vent"]*parameters["pdeath_vent"]*out[,(Ventindex+1)] -# cinc_mort_VentC1 <- parameters["nu_ventc"]*parameters["pdeath_ventc"]*out[,(VentCindex+1)] -# totage1<-as.data.frame(cinc_mort_H1+cinc_mort_HC1+cinc_mort_ICU1+cinc_mort_ICUC1+cinc_mort_Vent1+cinc_mort_VentC1) -# basemort_H1<-(out[,(Hindex+1)]) -# basemort_HC1<-(out[,(HCindex+1)]) -# basemort_ICU1<-(out[,(ICUindex+1)]) -# basemort_ICUC1<-(out[,(ICUCindex+1)]) -# basemort_Vent1<-(out[,(Ventindex+1)]) -# basemort_VentC1<-(out[,(VentCindex+1)]) -# totbase1<-as.data.frame(basemort_H1+basemort_HC1+basemort_ICU1+basemort_ICUC1+basemort_Vent1+basemort_VentC1) -# tc<-c() -# ages<-seq(0,100,by=5) -# for (i in 1:dim(cinc_mort_H1)[1]) { -# for (j in 1:dim(cinc_mort_H1)[2]) { -# tc<-rbind(tc,c(i,ages[j],totage1[i,j]*ifr[j,2]+totbase1[i,j]*mort[j])) -# } -# } -# tc<-as.data.frame(tc) -# colnames(tc)<-c("Day","Age","value") -# tc$Age<-as.factor(tc$Age) -# p6<-ggplot(data=tc, aes(x=Day,y=value,fill=Age))+ -# geom_bar(stat = "identity",position="fill", width=1)+ -# ylab("Proportion of deaths") -# -# inc_mort_H0 <- parameters["nus"]*parameters["pdeath_h"]*(out0[,(Hindex+1)]) -# inc_mort_HC0 <- parameters["nusc"]*parameters["pdeath_hc"]*(out0[,(HCindex+1)]) -# inc_mort_ICU0 <- parameters["nu_icu"]*parameters["pdeath_icu"]*out0[,(ICUindex+1)] -# inc_mort_ICUC0 <- parameters["nu_icuc"]*parameters["pdeath_icuc"]*out0[,(ICUCindex+1)] -# inc_mort_Vent0 <- parameters["nu_vent"]*parameters["pdeath_vent"]*out0[,(Ventindex+1)] -# inc_mort_VentC0 <- parameters["nu_ventc"]*parameters["pdeath_ventc"]*out0[,(VentCindex+1)] -# totage0<-as.data.frame(inc_mort_H0+inc_mort_HC0+inc_mort_ICU0+inc_mort_ICUC0+inc_mort_Vent0+inc_mort_VentC0) -# basemort_H0<-(out0[,(Hindex+1)]) -# basemort_HC0<-(out0[,(HCindex+1)]) -# basemort_ICU0<-(out0[,(ICUindex+1)]) -# basemort_ICUC0<-(out0[,(ICUCindex+1)]) -# basemort_Vent0<-(out0[,(Ventindex+1)]) -# basemort_VentC0<-(out0[,(VentCindex+1)]) -# totbase0<-as.data.frame(basemort_H0+basemort_HC0+basemort_ICU0+basemort_ICUC0+basemort_Vent0+basemort_VentC0) -# tc0<-c() -# for (i in 1:dim(cinc_mort_H1)[1]) { -# for (j in 1:dim(cinc_mort_H1)[2]) { -# tc0<-rbind(tc0,c(i,ages[j],totage0[i,j]*ifr[j,2]+totbase0[i,j]*mort[j])) -# } -# } -# tc0<-as.data.frame(tc0) -# colnames(tc0)<-c("Day","Age","value") -# tc0$Age<-as.factor(tc0$Age) -# p16<-ggplot(data=tc0, aes(x=Day,y=value,fill=Age))+ -# geom_bar(stat = "identity",position="fill", width=1)+ylab("Proportion of deaths") - -# grid.arrange(p16+theme_minimal(), -# p6+theme_minimal(), -# nrow=1) -# - - -# -# -# -# ######################################################################################################################### -# ##### SUMMARY METRICS ################################################################################################ -# ####################################################################################################################### -# -# infected0<-tail((rowSums(out0[,(Rindex+1)])),1)/sum(popstruc[,2]) -# infected0 -# infected1<-tail((rowSums(out[,(Rindex+1)])),1)/sum(popstruc[,2]) -# infected1 -# -# # #Population size checks -# # tpop1 -# # tpop0 -# -# # PCR -# time_of_measurement<-40:49 -# # general population -# (rowSums(out[time_of_measurement,Iindex+1])+rowSums(out[time_of_measurement,CLindex+1])+rowSums(out[time_of_measurement,QIindex+1])+ -# rowSums(out[time_of_measurement,QCindex+1]))/sum(popstruc[,2]) -# # every infection including hospital infections -# (rowSums(out[time_of_measurement,Iindex+1])+rowSums(out[time_of_measurement,CLindex+1])+rowSums(out[time_of_measurement,Hindex+1])+ -# rowSums(out[time_of_measurement,ICUindex+1])+rowSums(out[time_of_measurement,Ventindex+1])+rowSums(out[time_of_measurement,HCindex+1])+ -# rowSums(out[time_of_measurement,ICUCindex+1])+rowSums(out[time_of_measurement,VentCindex+1])+rowSums(out[time_of_measurement,QIindex+1])+ -# rowSums(out[time_of_measurement,QCindex+1]))/sum(popstruc[,2]) -# -# # SEROLOGY -# tail((rowSums(out[,(Rindex+1)])),1)/sum(popstruc[,2]) -# -# # IHR -# sum(ihr$severe*popstruc[,2]/sum(popstruc[,2])) -# -# -# # PORPORTIONAL MORTALITY IN THE ELDEST -# m30<-out0[30,CMindex+1]/(out0[30,Cindex+1]) -# m30[is.infinite(m30)]<-0 -# m60<-out0[60,CMindex+1]/out0[60,Cindex+1] -# m60[is.infinite(m60)]<-0 -# m90<-out0[90,CMindex+1]/out0[90,Cindex+1] -# m90[is.infinite(m90)]<-0 -# m120<-out0[120,CMindex+1]/out0[120,Cindex+1] -# m120[is.infinite(m120)]<-0 -# -# ifr30<-sum(m30*popstruc[,2]/sum(popstruc[,2]),na.rm = T) -# ifr60<-sum(m60*popstruc[,2]/sum(popstruc[,2]),na.rm = T) -# ifr90<-sum(m90*popstruc[,2]/sum(popstruc[,2]),na.rm = T) -# ifr120<-sum(m120*popstruc[,2]/sum(popstruc[,2]),na.rm = T) -# cbind(ifr30,ifr60,ifr90,ifr120)*100 -# -# PMORTDF0<-as.data.frame(cbind(out0[30,CMindex+1]/sum(out0[30,CMindex+1]),out0[60,CMindex+1]/sum(out0[60,CMindex+1]), -# out0[90,CMindex+1]/sum(out0[90,CMindex+1]),out0[120,CMindex+1]/sum(out0[120,CMindex+1]))) -# PMORTDF<-as.data.frame(cbind(out[30,CMindex+1]/sum(out[30,CMindex+1]),out[60,CMindex+1]/sum(out[60,CMindex+1]), -# out[90,CMindex+1]/sum(out[90,CMindex+1]),out[120,CMindex+1]/sum(out[120,CMindex+1]))) -# sum(PMORTDF0$V2[15:21]) -# sum(PMORTDF$V2[15:21]) -# -# -# # output doubling time over time first 7 days -# dd<-7 -# doub0<-log(2)*dd/(log(dailyinc0[2+dd]/dailyinc0[2])) -# doub0 - -# -# diff --git a/r_versions/covidage_v14.3.R b/r_versions/covidage_v14.3.R deleted file mode 100644 index dd2c797..0000000 --- a/r_versions/covidage_v14.3.R +++ /dev/null @@ -1,1704 +0,0 @@ -require("deSolve") -library("ggplot2") -library("dplyr") -library("reshape2") -require(gridExtra) -library(ggpubr) -library(bsplus) -library(deSolve) -library(DT) -library(highcharter) -library(lubridate) -library(pushbar) -library(readxl) -library(reshape2) -library(scales) -library(shiny) -library(shinyBS) -library(shinycssloaders) -library(shinyhelper) -library(shinythemes) -library(shinyWidgets) -library(tidyverse) -library(XLConnect) -# library("comoOdeCpp") - -#read data from excel file -setwd("C:/covid19/covid_age") -load("data_CoMo.RData") -file_path <- paste0(getwd(),"/Template_CoMoCOVID-19App_new.xlsx") -country_name<-"Cambodia" - -# Cases -dta <- read_excel(file_path, sheet = "Cases") -names(dta) <- c("date", "cases", "deaths") - -cases_rv <- dta %>% - mutate(date = as.Date(date), cumulative_death = cumsum(deaths)) %>% - as.data.frame() - -# Severity/Mortality -dta <- read_excel(file_path, sheet = "Severity-Mortality") -names(dta) <- c("age_category", "ifr", "ihr") - -mort_sever_rv <- dta %>% - mutate(ihr = ihr/100) %>% # starting unit should be % - scaling to a value between 0 and 1 - mutate(ifr = ifr/max(ifr)) # starting unit should be % - scaling to a value between 0 and 1 - -# Population -dta <- read_excel(file_path, sheet = "Population") -names(dta) <- c("age_category", "pop", "birth", "death") - -population_rv <- dta %>% - transmute(country = NA, age_category, pop, birth, death) - -# Parameters -param <- bind_rows(read_excel(file_path, sheet = "Parameters"), - read_excel(file_path, sheet = "Country Area Param"), - read_excel(file_path, sheet = "Virus Param"), - read_excel(file_path, sheet = "Hospitalisation Param"), - read_excel(file_path, sheet = "Interventions Param"), - read_excel(file_path, sheet = "Interventions")) %>% - mutate(Value_Date = as.Date(Value_Date)) - -# START Bridge ---- -popstruc <- population_rv %>% - select(age_category, pop) %>% - rename(agefloor = age_category) %>% - as.data.frame() - -popbirth <- population_rv %>% - select(age_category, birth) %>% - as.data.frame() # unit should be per person per day - -mort <- population_rv %>% - pull(death) # unit should be per person per day - -ihr <- mort_sever_rv %>% - select(age_category, ihr) %>% - as.data.frame() - -ifr <- mort_sever_rv %>% - select(age_category, ifr) %>% - as.data.frame() - - -######### POP AGEING -# per year ageing matrix -A<-length(popstruc[,2]) -dd<-seq(1:A)/seq(1:A) -ageing <- t(diff(diag(dd),lag=1)/(5*365.25)) -ageing<-cbind(ageing,0*seq(1:A)) # no ageing from last compartment - -# -pop<-population$country==country_name -pp<-population$pop[pop] -### CONTACT MATRICES -c_home <- contact_home[[country_name]] %>% as.matrix() -c_school <- contact_school[[country_name]] %>% as.matrix() -c_work <- contact_work[[country_name]] %>% as.matrix() -c_other <- contact_other[[country_name]] %>% as.matrix() -nce <-A-length(c_home[1,]) - -contact_home<-matrix(0,nrow=A,ncol=A) -contact_school<-matrix(0,nrow=A,ncol=A) -contact_work<-matrix(0,nrow=A,ncol=A) -contact_other<-matrix(0,nrow=A,ncol=A) - -for (i in 1:(A-nce)){ - for (j in 1:(A-nce)){ - contact_home[i,j]<-c_home[i,j] - contact_school[i,j]<-c_school[i,j] - contact_work[i,j]<-c_work[i,j] - contact_other[i,j]<-c_other[i,j] - } -} - -for (i in (A+1-nce):A){ - for (j in 1:(A-nce)){ - contact_home[i,j]<-c_home[(A-nce),j] - contact_school[i,j]<-c_school[(A-nce),j] - contact_work[i,j]<-c_work[(A-nce),j] - contact_other[i,j]<-c_other[(A-nce),j] - } -} -for (i in 1:(A-nce)){ - for (j in (A+1-nce):A){ - contact_home[i,j]<-c_home[i,(A-nce)] - contact_school[i,j]<-c_school[i,(A-nce)] - contact_work[i,j]<-c_work[i,(A-nce)] - contact_other[i,j]<-c_other[i,(A-nce)] - } -} -for (i in (A+1-nce):A){ - for (j in (A+1-nce):A){ - contact_home[i,j]<-c_home[(A-nce),(A-nce)] - contact_school[i,j]<-c_school[(A-nce),(A-nce)] - contact_work[i,j]<-c_work[(A-nce),(A-nce)] - contact_other[i,j]<-c_other[(A-nce),(A-nce)] - } -} - - - -######### INITIALISE SIMULATION/INTERVENTION START TIMES -startdate <- param$Value_Date[param$Parameter == "date_range_simul_start"] -stopdate <- param$Value_Date[param$Parameter == "date_range_simul_end"] -startdate <- startdate[1] -stopdate <- stopdate[1] - - -day_start <- as.numeric(startdate-startdate) -day_stop <- as.numeric(stopdate-startdate) -times <- seq(day_start, day_stop) - -tin<-as.numeric(startdate-as.Date("2020-01-01"))/365.25 -initP<-sum(popstruc[,2]) # population size -ageindcase<-20 # age of index case (years) -aci <- floor((ageindcase/5)+1) # age class of index case - - -############# DEFINE PARAMETERS -parameters <- c( - ### Transmission instrinsic - p = param$Value[param$Parameter=="p"][1], - rho = param$Value[param$Parameter=="rho"][1], - omega = param$Value[param$Parameter=="omega"][1], - gamma = param$Value[param$Parameter=="gamma"][1], - nui = param$Value[param$Parameter=="nui"][1], - report = param$Value[param$Parameter=="report"][1], - reportc = param$Value[param$Parameter=="reportc"][1], - reporth = param$Value[param$Parameter=="reporth"][1], - beds_available = param$Value[param$Parameter=="beds_available"][1], - icu_beds_available = param$Value[param$Parameter=="icu_beds_available"][1], - ventilators_available = param$Value[param$Parameter=="ventilators_available"][1], - give = 95, - pdeath_h = param$Value[param$Parameter=="pdeath_h"][1], - pdeath_hc = param$Value[param$Parameter=="pdeath_hc"][1], - pdeath_icu = param$Value[param$Parameter=="pdeath_icu"][1], - pdeath_icuc = param$Value[param$Parameter=="pdeath_icuc"][1], - pdeath_vent = param$Value[param$Parameter=="pdeath_vent"][1], - pdeath_ventc = param$Value[param$Parameter=="pdeath_ventc"][1], - ihr_scaling = param$Value[param$Parameter=="ihr_scaling"][1], - nus = param$Value[param$Parameter=="nus"][1], - nusc = param$Value[param$Parameter=="nus"][1], # nusc = nus - nu_icu = param$Value[param$Parameter=="nu_icu"][1], - nu_icuc = param$Value[param$Parameter=="nu_icu"][1], # nu_icuc = nu_icu - nu_vent = param$Value[param$Parameter=="nu_vent"][1], - nu_ventc = param$Value[param$Parameter=="nu_vent"][1], # nu_ventc = nu_vent - rhos = param$Value[param$Parameter=="rhos"][1], - amp = param$Value[param$Parameter=="amp"][1], - phi = param$Value[param$Parameter=="phi"][1], - pclin = param$Value[param$Parameter=="pclin"][1], - prob_icu = param$Value[param$Parameter=="prob_icu"][1], - prob_vent = param$Value[param$Parameter=="prob_vent"][1], - - ### INTERVENTIONS - # self isolation - selfis_eff = mean(param$Value[param$Parameter=="selfis_eff"],na.rm=T), - # social distancing - dist_eff = mean(param$Value[param$Parameter=="dist_eff"],na.rm=T), - # hand washing - hand_eff = mean(param$Value[param$Parameter=="hand_eff"],na.rm=T), - # working at home - work_eff = mean(param$Value[param$Parameter=="work_eff"],na.rm=T), - w2h = mean(param$Value[param$Parameter=="w2h"],na.rm=T), - # school closures - school_eff = mean(param$Value[param$Parameter=="school_eff"],na.rm=T), - s2h = mean(param$Value[param$Parameter=="s2h"],na.rm=T), - # cocooning the elderly - cocoon_eff = mean(param$Value[param$Parameter=="cocoon_eff"],na.rm=T), - age_cocoon = mean(param$Value[param$Parameter=="age_cocoon"],na.rm=T), - # vaccination campaign - # vaccine_on = as.numeric(param$Value_Date[param$Parameter=="date_vaccine_on"] - startdate), - vaccine_eff = mean(param$Value[param$Parameter=="vaccine_eff"],na.rm=T), - age_vaccine_min = mean(param$Value[param$Parameter=="age_vaccine_min"],na.rm=T), - # vaccine_cov = param$Value[param$Parameter=="vaccine_cov"], - vac_campaign = mean(param$Value[param$Parameter=="vac_campaign"],na.rm=T), - # travel ban - mean_imports = mean(param$Value[param$Parameter=="mean_imports"],na.rm=T), - # screening - screen_test_sens = mean(param$Value[param$Parameter=="screen_test_sens"],na.rm=T), - # screen_contacts = mean(param$Value[param$Parameter=="screen_contacts"],na.rm=T), - screen_overdispersion = mean(param$Value[param$Parameter=="screen_overdispersion"],na.rm=T), - # voluntary home quarantine - quarantine_days = mean(param$Value[param$Parameter=="quarantine_days"],na.rm=T), - quarantine_effort = mean(param$Value[param$Parameter=="quarantine_effort"],na.rm=T), - quarantine_eff_home = mean(param$Value[param$Parameter=="quarantine_eff_home"],na.rm=T), - quarantine_eff_other = mean(param$Value[param$Parameter=="quarantine_eff_other"],na.rm=T), - # mass testing - age_testing_min = mean(param$Value[param$Parameter=="age_testing_min"],na.rm=T), - age_testing_max = mean(param$Value[param$Parameter=="age_testing_max"],na.rm=T), - mass_test_sens = mean(param$Value[param$Parameter=="mass_test_sens"],na.rm=T), - isolation_days = mean(param$Value[param$Parameter=="isolation_days"],na.rm=T), - - household_size = param$Value[param$Parameter=="household_size"][1], - noise = param$Value[param$Parameter=="noise"][1], - iterations = param$Value[param$Parameter=="iterations"][1], - confidence = param$Value[param$Parameter=="confidence"][1] -) -ihr[,2]<- parameters["ihr_scaling"]*ihr[,2] - -# Scale parameters to percentages/ rates -parameters["rho"]<-parameters["rho"]/100 -parameters["omega"]<-(1/(parameters["omega"]*365)) -parameters["gamma"]<-1/parameters["gamma"] -parameters["nui"]<-1/parameters["nui"] -parameters["report"]<-parameters["report"]/100 -parameters["reportc"]<-parameters["reportc"]/100 -parameters["reporth"]<-parameters["reporth"]/100 -parameters["nus"]<-1/parameters["nus"] -parameters["rhos"]<-parameters["rhos"]/100 -parameters["amp"]<-parameters["amp"]/100 -parameters["selfis_eff"]<-parameters["selfis_eff"]/100 -parameters["dist_eff"]<-parameters["dist_eff"]/100 -parameters["hand_eff"]<-parameters["hand_eff"]/100 -parameters["work_eff"]<-parameters["work_eff"]/100 -parameters["w2h"]<-parameters["w2h"]/100 -parameters["school_eff"]<-parameters["school_eff"]/100 -parameters["s2h"]<-parameters["s2h"]/100 -parameters["cocoon_eff"]<-parameters["cocoon_eff"]/100 -parameters["age_cocoon"]<-floor((parameters["age_cocoon"]/5)+1) -parameters["vaccine_eff"]<-parameters["vaccine_eff"]/100 -age_vaccine_min<-(parameters["age_vaccine_min"]) -# parameters["vaccine_cov"]<-parameters["vaccine_cov"]/100 -# parameters["vac_campaign"]<-parameters["vac_campaign"]*7 -parameters["screen_test_sens"]<-parameters["screen_test_sens"]/100 -parameters["quarantine_days"]<-parameters["quarantine_days"] -parameters["quarantine_effort"]<-1/parameters["quarantine_effort"] -parameters["quarantine_eff_home"]<-parameters["quarantine_eff_home"]/-100 -parameters["quarantine_eff_other"]<-parameters["quarantine_eff_other"]/100 -parameters["give"]<-parameters["give"]/100 -parameters["pdeath_h"]<-parameters["pdeath_h"]/100 -parameters["pdeath_hc"]<-parameters["pdeath_hc"]/100 -parameters["pdeath_icu"]<-parameters["pdeath_icu"]/100 -parameters["pdeath_icuc"]<-parameters["pdeath_icuc"]/100 -parameters["pdeath_vent"]<-parameters["pdeath_vent"]/100 -parameters["pdeath_ventc"]<-parameters["pdeath_ventc"]/100 -parameters["nusc"]<-1/parameters["nusc"] -parameters["nu_icu"]<-1/parameters["nu_icu"] -parameters["nu_icuc"]<-1/parameters["nu_icuc"] -parameters["nu_vent"]<-1/parameters["nu_vent"] -parameters["nu_ventc"]<-1/parameters["nu_ventc"] -parameters["pclin"]<-parameters["pclin"]/100 -parameters["prob_icu"]<-parameters["prob_icu"]/100 -parameters["prob_vent"]<-parameters["prob_vent"]/100 -parameters_noise<-c(1:5,19:26,32:39,43,45,47:49) -iterations<-parameters["iterations"] -noise<-parameters["noise"] -confidence<-parameters["confidence"]/100 -parameters["mass_test_sens"]<-parameters["mass_test_sens"]/100 -age_testing_min<-(parameters["age_testing_min"]) -age_testing_max<-(parameters["age_testing_max"]) -parameters["isolation_days"]<-parameters["isolation_days"] - -########################################################################### -# Define the indices for each variable -Sindex<-1:A -Eindex<-(A+1):(2*A) -Iindex<-(2*A+1):(3*A) -Rindex<-(3*A+1):(4*A) -Xindex<-(4*A+1):(5*A) -Hindex<-(5*A+1):(6*A) -HCindex<-(6*A+1):(7*A) -Cindex<-(7*A+1):(8*A) -CMindex<-(8*A+1):(9*A) -Vindex<-(9*A+1):(10*A) -QSindex<-(10*A+1):(11*A) -QEindex<-(11*A+1):(12*A) -QIindex<-(12*A+1):(13*A) -QRindex<-(13*A+1):(14*A) -CLindex<-(14*A+1):(15*A) -QCindex<-(15*A+1):(16*A) -ICUindex<-(16*A+1):(17*A) -ICUCindex<-(17*A+1):(18*A) -ICUCVindex<-(18*A+1):(19*A) -Ventindex<-(19*A+1):(20*A) -VentCindex<-(20*A+1):(21*A) -CMCindex<-(21*A+1):(22*A) -Zindex<-(22*A+1):(23*A) - -########################################################################### -# MODEL INITIAL CONDITIONS -initI<-0*popstruc[,2] # Infected and symptomatic -initE<-0*popstruc[,2] # Incubating -initE[aci]<-1 # place random index case in E compartment -initR<-0*popstruc[,2] # Immune -initX<-0*popstruc[,2] # Isolated -initV<-0*popstruc[,2] # Vaccinated -initQS<-0*popstruc[,2] # quarantined S -initQE<-0*popstruc[,2] # quarantined E -initQI<-0*popstruc[,2] # quarantined I -initQR<-0*popstruc[,2] # quarantined R -initH<-0*popstruc[,2] # hospitalised -initHC<-0*popstruc[,2] # hospital critical -initC<-0*popstruc[,2] # Cumulative cases (true) -initCM<-0*popstruc[,2] # Cumulative deaths (true) -initCL<-0*popstruc[,2] # symptomatic cases -initQC<-0*popstruc[,2] # quarantined C -initICU<-0*popstruc[,2] # icu -initICUC<-0*popstruc[,2] # icu critical -initICUCV<-0*popstruc[,2] # icu critical -initVent<-0*popstruc[,2] # icu vent -initVentC<-0*popstruc[,2] # icu vent crit -initCMC<-0*popstruc[,2] # Cumulative deaths (true) -initZ<-0*popstruc[,2] # Cumulative deaths (true) -initS<-popstruc[,2]-initE-initI-initR-initX-initZ-initV-initH-initHC-initQS-initQE-initQI-initQR-initCL-initQC-initICU-initICUC-initICUCV-initVent-initVentC # Susceptible (non-immune) - - -inp <- read_excel(file_path, sheet = "Interventions") -inputs<-function(inp, run){ - # cap intervention end dates with simulation end date - inp$`Date End` = pmin(stopdate, inp$`Date End`) - - tv<-which(inp$`Apply to`==run) - - si<-intersect(which(inp$Intervention=="Self-isolation if Symptomatic"),tv) - scr<-intersect(which(inp$Intervention=="Screening (when S.I.)"),tv) - sd<-intersect(which(inp$Intervention=="Social Distancing"),tv) - hw<-intersect(which(inp$Intervention=="Handwashing"),tv) - wah<-intersect(which(inp$Intervention=="Working at Home"),tv) - sc<-intersect(which(inp$Intervention=="School Closures"),tv) - cte<-intersect(which(inp$Intervention=="Shielding the Elderly"),tv) - q<-intersect(which(inp$Intervention=="Household Isolation (when S.I.)"),tv) - tb<-intersect(which(inp$Intervention=="International Travel Ban"),tv) - mt<-intersect(which(inp$Intervention=="Mass Testing"),tv) - minas<-intersect(which(inp$Intervention=="Age Testing Minimum"),tv) - maxas<-intersect(which(inp$Intervention=="Age Testing Maximum"),tv) - vc<-intersect(which(inp$Intervention=="Vaccination"),tv) - minav<-intersect(which(inp$Intervention=="Age Vaccine Minimum"),tv) - - v<-(format(as.POSIXct(inp$`Date Start`,format='%Y/%m/%d %H:%M:%S'),format="%d/%m/%y")) - v2<-as.Date(v,format="%d/%m/%y") - inp$`Date Start`<-v2 - - v<-(format(as.POSIXct(inp$`Date End`,format='%Y/%m/%d %H:%M:%S'),format="%d/%m/%y")) - v2<-as.Date(v,format="%d/%m/%y") - inp$`Date End`<-v2 - - ## self isolation - f<-c() - si_vector<-c() - isolation<-c() - if (length(si)>=1){ - for (i in 1:length(si)){ - f<-c(f,as.numeric(inp$`Date Start`[si[i]]-startdate),as.numeric(inp$`Date End`[si[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[si[i]]>startdate){ - si_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[si[i]],(f[i+1]-f[i])*20)) - isolation<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - si_vector<-c(rep(inp$`Value`[si[i]],(f[i+1])*20)) - isolation<-c(rep(1,(f[i+1])*20)) - } - } - else{ - si_vector<-c(si_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - si_vector<-c(si_vector,rep(inp$`Value`[si[i]],(f[i*2]-f[i*2-1])*20)) - isolation<-c(isolation,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - isolation<-c(isolation,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(si) && f[i*2]=1){ - for (i in 1:length(sd)){ - - f<-c(f,as.numeric(inp$`Date Start`[sd[i]]-startdate),as.numeric(inp$`Date End`[sd[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[sd[i]]>startdate){ - sd_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[sd[i]],(f[i+1]-f[i])*20)) - distancing<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - sd_vector<-c(rep(inp$`Value`[sd[i]],(f[i+1])*20)) - distancing<-c(rep(1,(f[i+1])*20)) - } - } - else{ - sd_vector<-c(sd_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - sd_vector<-c(sd_vector,rep(inp$`Value`[sd[i]],(f[i*2]-f[i*2-1])*20)) - distancing<-c(distancing,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - distancing<-c(distancing,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(sd)&& f[i*2]=1){ - for (i in 1:length(scr)){ - - f<-c(f,as.numeric(inp$`Date Start`[scr[i]]-startdate),as.numeric(inp$`Date End`[scr[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[scr[i]]>startdate){ - scr_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[scr[i]],(f[i+1]-f[i])*20)) - screen<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - scr_vector<-c(rep(inp$`Value`[scr[i]],(f[i+1])*20)) - screen<-c(rep(1,(f[i+1])*20)) - } - } - else{ - scr_vector<-c(scr_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - scr_vector<-c(scr_vector,rep(inp$`Value`[scr[i]],(f[i*2]-f[i*2-1])*20)) - screen<-c(screen,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - screen<-c(screen,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(scr)&& f[i*2]=1){ - for (i in 1:length(hw)){ - - f<-c(f,as.numeric(inp$`Date Start`[hw[i]]-startdate),as.numeric(inp$`Date End`[hw[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[hw[i]]>startdate){ - hw_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[hw[i]],(f[i+1]-f[i])*20)) - handwash<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - hw_vector<-c(rep(inp$`Value`[hw[i]],(f[i+1])*20)) - handwash<-c(rep(1,(f[i+1])*20)) - } - } - else{ - hw_vector<-c(hw_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - hw_vector<-c(hw_vector,rep(inp$`Value`[hw[i]],(f[i*2]-f[i*2-1])*20)) - handwash<-c(handwash,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - handwash<-c(handwash,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(hw)&& f[i*2]=1){ - for (i in 1:length(wah)){ - - f<-c(f,as.numeric(inp$`Date Start`[wah[i]]-startdate),as.numeric(inp$`Date End`[wah[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[wah[i]]>startdate){ - wah_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[wah[i]],(f[i+1]-f[i])*20)) - workhome<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - wah_vector<-c(rep(inp$`Value`[wah[i]],(f[i+1])*20)) - workhome<-c(rep(1,(f[i+1])*20)) - } - } - else{ - wah_vector<-c(wah_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - wah_vector<-c(wah_vector,rep(inp$`Value`[wah[i]],(f[i*2]-f[i*2-1])*20)) - workhome<-c(workhome,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - workhome<-c(workhome,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(wah)&& f[i*2]=1){ - for (i in 1:length(sc)){ - - f<-c(f,as.numeric(inp$`Date Start`[sc[i]]-startdate),as.numeric(inp$`Date End`[sc[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[sc[i]]>startdate){ - sc_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[sc[i]],(f[i+1]-f[i])*20)) - schoolclose<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - sc_vector<-c(rep(inp$`Value`[sc[i]],(f[i+1])*20)) - schoolclose<-c(rep(1,(f[i+1])*20)) - } - } - else{ - sc_vector<-c(sc_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - sc_vector<-c(sc_vector,rep(inp$`Value`[sc[i]],(f[i*2]-f[i*2-1])*20)) - schoolclose<-c(schoolclose,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - schoolclose<-c(schoolclose,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(sc)&& f[i*2]=1){ - for (i in 1:length(cte)){ - - f<-c(f,as.numeric(inp$`Date Start`[cte[i]]-startdate),as.numeric(inp$`Date End`[cte[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[cte[i]]>startdate){ - cte_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[cte[i]],(f[i+1]-f[i])*20)) - cocoon<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - cte_vector<-c(rep(inp$`Value`[cte[i]],(f[i+1])*20)) - cocoon<-c(rep(1,(f[i+1])*20)) - } - } - else{ - cte_vector<-c(cte_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - cte_vector<-c(cte_vector,rep(inp$`Value`[cte[i]],(f[i*2]-f[i*2-1])*20)) - cocoon<-c(cocoon,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - cocoon<-c(cocoon,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(cte)&& f[i*2]=1){ - for (i in 1:length(q)){ - - f<-c(f,as.numeric(inp$`Date Start`[q[i]]-startdate),as.numeric(inp$`Date End`[q[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[q[i]]>startdate){ - q_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[q[i]],(f[i+1]-f[i])*20)) - quarantine<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - q_vector<-c(rep(inp$`Value`[q[i]],(f[i+1])*20)) - quarantine<-c(rep(1,(f[i+1])*20)) - } - } - else{ - q_vector<-c(q_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - q_vector<-c(q_vector,rep(inp$`Value`[q[i]],(f[i*2]-f[i*2-1])*20)) - quarantine<-c(quarantine,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - quarantine<-c(quarantine,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(q)&& f[i*2]=1){ - for (i in 1:length(tb)){ - - f<-c(f,as.numeric(inp$`Date Start`[tb[i]]-startdate),as.numeric(inp$`Date End`[tb[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[tb[i]]>startdate){ - tb_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[tb[i]],(f[i+1]-f[i])*20)) - travelban<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - tb_vector<-c(rep(inp$`Value`[tb[i]],(f[i+1])*20)) - travelban<-c(rep(1,(f[i+1])*20)) - } - } - else{ - tb_vector<-c(tb_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - tb_vector<-c(tb_vector,rep(inp$`Value`[tb[i]],(f[i*2]-f[i*2-1])*20)) - travelban<-c(travelban,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - travelban<-c(travelban,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(tb)&& f[i*2]=1){ - for (i in 1:length(mt)){ - - f<-c(f,as.numeric(inp$`Date Start`[mt[i]]-startdate),as.numeric(inp$`Date End`[mt[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[mt[i]]>startdate){ - mt_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[mt[i]],(f[i+1]-f[i])*20)) - masstesting<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - mt_vector<-c(rep(inp$`Value`[mt[i]],(f[i+1])*20)) - masstesting<-c(rep(1,(f[i+1])*20)) - } - } - else{ - mt_vector<-c(mt_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - mt_vector<-c(mt_vector,rep(inp$`Value`[mt[i]],(f[i*2]-f[i*2-1])*20)) - masstesting<-c(masstesting,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - masstesting<-c(masstesting,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(mt)&& f[i*2]=1){ - for (i in 1:length(minas)){ - f<-c(f,as.numeric(inp$`Date Start`[minas[i]]-startdate),as.numeric(inp$`Date End`[minas[i]]-startdate)) - if(i==1){ - if (inp$`Date Start`[minas[i]]>startdate){ - minas_vector<-c(rep(age_testing_min,f[i]*20),rep(inp$`Value`[minas[i]],(f[i+1]-f[i])*20)) - } - else{ - minas_vector<-c(rep(inp$`Value`[minas[i]],(f[i+1])*20)) - } - } - else{ - minas_vector<-c(minas_vector,rep(age_testing_min,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - minas_vector<-c(minas_vector,rep(inp$`Value`[minas[i]],(f[i*2]-f[i*2-1])*20)) - } - if(i==length(minas)&& f[i*2]=1){ - for (i in 1:length(maxas)){ - f<-c(f,as.numeric(inp$`Date Start`[maxas[i]]-startdate),as.numeric(inp$`Date End`[maxas[i]]-startdate)) - if(i==1){ - if (inp$`Date Start`[maxas[i]]>startdate){ - maxas_vector<-c(rep(age_testing_max,f[i]*20),rep(inp$`Value`[maxas[i]],(f[i+1]-f[i])*20)) - } - else{ - maxas_vector<-c(rep(inp$`Value`[maxas[i]],(f[i+1])*20)) - } - } - else{ - maxas_vector<-c(maxas_vector,rep(age_testing_max,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - maxas_vector<-c(maxas_vector,rep(inp$`Value`[maxas[i]],(f[i*2]-f[i*2-1])*20)) - } - if(i==length(maxas)&& f[i*2]=1){ - for (i in 1:length(vc)){ - - f<-c(f,as.numeric(inp$`Date Start`[vc[i]]-startdate),as.numeric(inp$`Date End`[vc[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[vc[i]]>startdate){ - vc_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[vc[i]],(f[i+1]-f[i])*20)) - vaccine<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - vc_vector<-c(rep(inp$`Value`[vc[i]],(f[i+1])*20)) - vaccine<-c(rep(1,(f[i+1])*20)) - } - } - else{ - vc_vector<-c(vc_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - vc_vector<-c(vc_vector,rep(inp$`Value`[vc[i]],(f[i*2]-f[i*2-1])*20)) - vaccine<-c(vaccine,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - vaccine<-c(vaccine,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(vc)&& f[i*2]=1){ - for (i in 1:length(minav)){ - f<-c(f,as.numeric(inp$`Date Start`[minav[i]]-startdate),as.numeric(inp$`Date End`[minav[i]]-startdate)) - if(i==1){ - if (inp$`Date Start`[minav[i]]>startdate){ - minav_vector<-c(rep(age_vaccine_min,f[i]*20),rep(inp$`Value`[minav[i]],(f[i+1]-f[i])*20)) - } - else{ - minav_vector<-c(rep(inp$`Value`[minav[i]],(f[i+1])*20)) - } - } - else{ - minav_vector<-c(minav_vector,rep(age_vaccine_min,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - minav_vector<-c(minav_vector,rep(inp$`Value`[minav[i]],(f[i*2]-f[i*2-1])*20)) - } - if(i==length(minav)&& f[i*2]1){ - ratetestI<-mass_test_sens*testI/sum(I) - # print(paste('rateI: ',ratetestI)) - }else{ratetestI<-0} - if(sum(CL)>1){ - ratetestC<-mass_test_sens*testC/sum(CL) - # print(paste('rateC: ',ratetestC)) - }else{ratetestC<-0} - if(sum(E)>1){ - ratetestE<-mass_test_sens*testE/sum(E) - # print(paste('rateC: ',ratetestC)) - }else{ratetestE<-0} - - # print(mass_test_sens) - # print(ratetestI*sum(I) + ratetestC*sum(CL) - (1/isolation_days)*sum(Z) ) - # print(propC) - # print(testI) - # print(testC) - # - # cocooning the elderly - cocoon_mat<-matrix((1-cocoon_eff),nrow = length(popstruc$pop),ncol = length(popstruc$pop)) - cocoon_mat[1:(age_cocoon-1),1:(age_cocoon-1)]<-1 - - # contact matrices - cts<-(contact_home+distancing*(1-dist)*contact_other+(1-distancing)*contact_other - +(1-schoolclose)*contact_school # school on - +schoolclose*(1-school)*contact_school # school close - +schoolclose*contact_home*school*s2h # inflating contacts at home when school closes - +(1-workhome)*contact_work # normal work - +workhome*(1-work)*contact_work # people not working from home when homework is active - +contact_home*workhome*work*w2h # inflating contacts at home when working from home - ) - - # Final transmission related parameters - contacts <- (1-cocoon)*cts+cocoon*cts*cocoon_mat+cocoon*(1+schoolclose*(1-school_eff)+workhome*(1-work_eff))*contact_home*(1-cocoon_mat) - seas <- 1+amp*cos(2*3.14*(t-(phi*365.25/12))/365.25) - importation <- mean_imports*(1-trvban_eff) - HH<-H+ICU+Vent+ICUC+ICUCV+VentC - HHC<-HC - lam <- (1-hand)*p*seas*(contacts%*%((rho*E+(I+CL+importation)+(1-selfis_eff)*(X+HHC)+rhos*(HH))/P))+ - (1-hand)*p*seas*(1-quarantine*quarantine_eff_other)*(contact_other%*%((rho*QE+QI+QC)/P)) - # contacts under home quarantine - lamq<-(1-hand)*p*seas*((1-quarantine_eff_home)*contact_home%*%(((1-selfis_eff)*(X+HHC+rho*QE+QI+QC))/P))+ - (1-hand)*p*seas*(1-quarantine_eff_other)*(contact_other%*%((rho*E+(I+CL+importation)+(1-selfis_eff)*(X+HHC+rho*QE+QI+QC)+rhos*(HH))/P)) - - # birth/death - b1<-sum(popbirth[,2]*popstruc[,2]) - birth<-0*popbirth[,2] - birth[1]<-b1 - - # ODE system - dSdt <- -S*lam-vaccinate*age_vaccine_vector*S+omega*R+ageing%*%S-mort*S+birth-quarantine_rate*S +(1/quarantine_days)*QS - dEdt <- S*lam-gamma*E+ageing%*%E-mort*E + (1-vaccine_eff)*lam*V-quarantine_rate*E+(1/quarantine_days)*QE - dIdt <- gamma*(1-pclin)*(1-age_testing_vector*ratetestE)*(1-screen_eff)*(1-ihr[,2])*E-nui*I+ageing%*%I-mort*I + (1/quarantine_days)*QI - quarantine_rate*I - ratetestI*age_testing_vector*I - dCLdt<- gamma*pclin*(1-age_testing_vector*ratetestE)*(1-selfis)*(1-ihr[,2])*(1-quarantine_rate)*E-nui*CL+ageing%*%CL-mort*CL + (1/quarantine_days)*QC - ratetestC*age_testing_vector*CL - dRdt <- nui*I-omega*R+nui*X+nui*CL+ageing%*%R-mort*R + (1/isolation_days)*Z+(1/quarantine_days)*QR + nus*(1-pdeath_h*ifr[,2])*H + (1-pdeath_icu*ifr[,2])*nu_icu*ICU + (1-pdeath_icuc*ifr[,2])*nu_icuc*ICUC + (1-pdeath_ventc*ifr[,2])*nu_ventc*ICUCV + (1-pdeath_hc*ifr[,2])*nusc*HC + (1-pdeath_vent*ifr[,2])*nu_vent*Vent+ (1-pdeath_ventc*ifr[,2])*nu_ventc*VentC - dXdt <- gamma*selfis*(1-age_testing_vector*ratetestE)*pclin*(1-ihr[,2])*E+gamma*(1-pclin)*(1-age_testing_vector*ratetestE)*screen_eff*(1-ihr[,2])*E-nui*X+ageing%*%X-mort*X - dVdt <- vaccinate*age_vaccine_vector*S -(1-vaccine_eff)*lam*V +ageing%*%V - mort*V - - dQSdt <- quarantine_rate*S+ ageing%*%QS-mort*QS - (1/quarantine_days)*QS - lamq*QS - dQEdt <- quarantine_rate*E - gamma*QE + ageing%*%QE-mort*QE - (1/quarantine_days)*QE + lamq*QS - dQIdt <- quarantine_rate*I + gamma*(1-ihr[,2])*(1-pclin)*QE-nui*QI+ageing%*%QI-mort*QI - (1/quarantine_days)*QI - dQCdt <- gamma*pclin*(1-selfis)*(1-age_testing_vector*ratetestE)*(1-ihr[,2])*quarantine_rate*E+gamma*(1-ihr[,2])*pclin*QE-nui*QC+ageing%*%QC-mort*QC - (1/quarantine_days)*QC - dQRdt <- nui*QI+nui*QC+ageing%*%QR-mort*QR - (1/quarantine_days)*QR - - dHdt <- gamma*ihr[,2]*(1-prob_icu)*(1-critH)*reporth*E + gamma*ihr[,2]*(1-prob_icu)*(1-critH)*QE - nus*H + ageing%*%H-mort*H - dHCdt <- gamma*ihr[,2]*(1-prob_icu)*(1-critH)*(1-reporth)*E+gamma*ihr[,2]*(1-prob_icu)*critH*E + gamma*ihr[,2]*(1-prob_icu)*critH*QE - nusc*HC + ageing%*%HC-mort*HC - dICUdt <- gamma*ihr[,2]*prob_icu*(1-crit)*(1-prob_vent)*E + gamma*ihr[,2]*prob_icu*(1-crit)*(1-prob_vent)*QE - nu_icu*ICU +ageing%*%ICU - mort*ICU +(1-crit)*ICUC*1/2 - dICUCdt <- gamma*ihr[,2]*prob_icu*crit*(1-prob_vent)*E + gamma*ihr[,2]*prob_icu*crit*(1-prob_vent)*QE - - nu_icuc*ICUC -(1-crit)*ICUC*1/2 +ageing%*%ICUC - mort*ICUC - dICUCVdt <- gamma*ihr[,2]*prob_icu*prob_vent*crit*E +gamma*ihr[,2]*prob_icu*prob_vent*crit*QE -nu_ventc*ICUCV +ageing%*%ICUCV - mort*ICUCV - (1-critV)*ICUCV*1/2 - dVentdt <- gamma*ihr[,2]*prob_icu*(1-crit)*(1-critV)*prob_vent*E + gamma*ihr[,2]*prob_icu*(1-crit)*(1-critV)*prob_vent*QE +(1-critV)*VentC*1/2 +(1-critV)*ICUCV*1/2 -nu_vent*Vent +ageing%*%Vent - mort*Vent - dVentCdt <- gamma*ihr[,2]*prob_icu*prob_vent*(1-crit)*critV*E +gamma*ihr[,2]*prob_icu*prob_vent*(1-crit)*critV*QE - - (1-critV)*VentC*1/2 -nu_ventc*VentC +ageing%*%VentC - mort*VentC - - dCdt <- report*gamma*(1-age_testing_vector*ratetestE)*(1-pclin)*(1-ihr[,2])*(E+QE)+reportc*gamma*pclin*(1-age_testing_vector*ratetestE)*(1-ihr[,2])*(E+QE)+ - gamma*ihr[,2]*(1-critH)*(1-prob_icu)*(E+QE)+gamma*ihr[,2]*critH*reporth*(1-prob_icu)*(E+QE)+ - gamma*ihr[,2]*prob_icu*(E+QE)+ratetestI*age_testing_vector*I+ratetestC*age_testing_vector*CL+gamma*age_testing_vector*ratetestE*(1-ihr[,2])*E - dCMdt<- nus*pdeath_h*ifr[,2]*H + nusc*pdeath_hc*ifr[,2]*HC + nu_icu*pdeath_icu*ifr[,2]*ICU +nu_icuc*pdeath_icuc*ifr[,2]*ICUC +nu_vent*pdeath_vent*ifr[,2]*Vent +nu_ventc*pdeath_ventc*ifr[,2]*VentC +nu_ventc*pdeath_ventc*ifr[,2]*ICUCV+ - mort*H + mort*HC + mort*ICU + mort*ICUC + mort*ICUCV + mort*Vent + mort*VentC + mort*Z - dCMCdt <- nusc*pdeath_hc*ifr[,2]*HC+nu_icuc*pdeath_icuc*ifr[,2]*ICUC + nu_ventc*pdeath_ventc*ifr[,2]*VentC + nu_ventc*pdeath_ventc*ifr[,2]*ICUCV+ - mort*HC + mort*ICUC + mort*VentC + mort*ICUCV - - dZdt <- gamma*ratetestE*age_testing_vector*(1-ihr[,2])*E+ratetestI*age_testing_vector*I+ratetestC*age_testing_vector*CL-(1/isolation_days)*Z-mort*Z - - # return the rate of change - list(c(dSdt,dEdt,dIdt,dRdt,dXdt,dHdt,dHCdt,dCdt,dCMdt,dVdt,dQSdt,dQEdt,dQIdt,dQRdt,dCLdt,dQCdt,dICUdt,dICUCdt,dICUCVdt,dVentdt,dVentCdt,dCMCdt,dZdt)) - } - ) -} - -########### RUN BASELINE MODEL - start time for interventions is set to day 1e5, i.e. interventions are always off - -Y<-c(initS,initE,initI,initR,initX,initH,initHC,initC,initCM,initV, initQS, initQE, initQI, initQR, initCL, initQC, initICU, initICUC, initICUCV, initVent, initVentC, initCMC, initZ) # initial conditions for the main solution vector - - -process_ode_outcome <- function(out, iterations){ - out_min<-out$min - out_max<-out$max - out_mean<-out$mean - - critH<-c() - crit<-c() - critV<-c() - - for (i in 1:length(times)){ - critH[i]<-min(1-fH((sum(out_mean[i,(Hindex+1)]))+sum(out_mean[i,(ICUCindex+1)])+sum(out_mean[i,(ICUCVindex+1)])),1) - crit[i]<-min(1-fICU((sum(out_mean[i,(ICUindex+1)]))+(sum(out_mean[i,(Ventindex+1)]))+(sum(out_mean[i,(VentCindex+1)])))) - critV[i]<-min(1-fVent((sum(out_mean[i,(Ventindex+1)]))),1) - } - - # total population - pop1<-out_mean[,(Sindex+1)]+out_mean[,(Eindex+1)]+out_mean[,(Iindex+1)]+out_mean[,(CLindex+1)]+out_mean[,(Rindex+1)]+out_mean[,(Xindex+1)]+out_mean[,(Vindex+1)]+ - out_mean[,(Zindex+1)]+out_mean[,(QSindex+1)]+out_mean[,(QEindex+1)]+out_mean[,(QIindex+1)]+out_mean[,(QCindex+1)]+out_mean[,(QRindex+1)]+ - out_mean[,(Hindex+1)]+out_mean[,(HCindex+1)]+out_mean[,(ICUindex+1)]+out_mean[,(ICUCindex+1)]+out_mean[,(ICUCVindex+1)]+out_mean[,(Ventindex+1)]+out_mean[,(VentCindex+1)] - tpop1<-rowSums(pop1) - time<-as.Date(out_mean[,1]+startdate) - - dailyinc1<-out$mean_cases # daily incidence - cuminc1<-out$mean_cum_cases # cumulative incidence - previcureq1<-rowSums(out_mean[,(Hindex+1)])+ rowSums(out_mean[,(ICUCindex+1)])+rowSums(out_mean[,(ICUCVindex+1)]) # surge beds occupancy - previcureq21<-rowSums(out_mean[,(ICUindex+1)])+rowSums(out_mean[,(VentCindex+1)]) # icu beds occupancy - previcureq31<-rowSums(out_mean[,(Ventindex+1)]) # ventilator occupancy - cmortality1<-rowSums(out_mean[,(CMindex+1)]) # cumulative mortality - overloadH1<-rowSums(out_mean[,(HCindex+1)]) # requirement for beds - overloadICU1<-rowSums(out_mean[,(ICUCindex+1)]) # requirement for icu beds - overloadICUV1<-rowSums(out_mean[,(ICUCVindex+1)]) # requirement for ventilators - overloadVent1<-rowSums(out_mean[,(VentCindex+1)]) # requirement for ventilators - ccases1<-rowSums(out_mean[,(Cindex+1)]) # cumulative cases - reqsurge1<-rowSums(out_mean[,(Hindex+1)])+overloadH1 - reqicu1<-rowSums(out_mean[,(ICUindex+1)])+overloadICU1 - reqvent1<-rowSums(out_mean[,(Ventindex+1)])+overloadICUV1+overloadVent1 - - - ########################## CALCULATE MORTALITY - pdeath_hc<-parameters["pdeath_hc"] - prob_icu<-parameters["prob_icu"] - prob_vent<-parameters["prob_vent"] - pdeath_icuc<-parameters["pdeath_icuc"] - pdeath_ventc<-parameters["pdeath_ventc"] - - cinc_mort_H1 <- cumsum(rowSums(parameters["nus"]*parameters["pdeath_h"]*(out_mean[,(Hindex+1)]%*%ifr[,2]))) - cinc_mort_HC1 <- cumsum(rowSums(parameters["nusc"]*parameters["pdeath_hc"]*(out_mean[,(HCindex+1)]%*%ifr[,2]))) - cinc_mort_ICU1 <- cumsum(rowSums(parameters["nu_icu"]*parameters["pdeath_icu"]*out_mean[,(ICUindex+1)]%*%ifr[,2])) - cinc_mort_ICUC1 <- cumsum(rowSums(parameters["nu_icuc"]*parameters["pdeath_icuc"]*out_mean[,(ICUCindex+1)]%*%ifr[,2])) - cinc_mort_ICUCV1 <- cumsum(rowSums(parameters["nu_ventc"]*parameters["pdeath_ventc"]*out_mean[,(ICUCVindex+1)]%*%ifr[,2])) - cinc_mort_Vent1 <- cumsum(rowSums(parameters["nu_vent"]*parameters["pdeath_vent"]*out_mean[,(Ventindex+1)]%*%ifr[,2])) - cinc_mort_VentC1 <- cumsum(rowSums(parameters["nu_ventc"]*parameters["pdeath_ventc"]*out_mean[,(VentCindex+1)]%*%ifr[,2])) - base_mort_H1 <- cumsum(rowSums(out_mean[,(Hindex+1)]%*%mort)) - base_mort_HC1 <- cumsum(rowSums(out_mean[,(HCindex+1)]%*%mort)) - base_mort_ICU1 <- cumsum(rowSums(out_mean[,(ICUindex+1)]%*%mort)) - base_mort_ICUC1 <- cumsum(rowSums(out_mean[,(ICUCindex+1)]%*%mort)) - base_mort_ICUCV1 <- cumsum(rowSums(out_mean[,(ICUCVindex+1)]%*%mort)) - base_mort_Vent1 <- cumsum(rowSums(out_mean[,(Ventindex+1)]%*%mort)) - base_mort_VentC1 <- cumsum(rowSums(out_mean[,(VentCindex+1)]%*%mort)) - base_mort_S1 <- cumsum(rowSums(out_mean[,(Sindex+1)]%*%mort)) - base_mort_E1 <- cumsum(rowSums(out_mean[,(Eindex+1)]%*%mort)) - base_mort_I1 <- cumsum(rowSums(out_mean[,(Iindex+1)]%*%mort)) - base_mort_CL1 <- cumsum(rowSums(out_mean[,(CLindex+1)]%*%mort)) - base_mort_X1 <- cumsum(rowSums(out_mean[,(Xindex+1)]%*%mort)) - base_mort_QS1 <- cumsum(rowSums(out_mean[,(QSindex+1)]%*%mort)) - base_mort_QE1 <- cumsum(rowSums(out_mean[,(QEindex+1)]%*%mort)) - base_mort_QI1 <- cumsum(rowSums(out_mean[,(QIindex+1)]%*%mort)) - base_mort_QC1 <- cumsum(rowSums(out_mean[,(QCindex+1)]%*%mort)) - base_mort_QR1 <- cumsum(rowSums(out_mean[,(QRindex+1)]%*%mort)) - base_mort_R1 <- cumsum(rowSums(out_mean[,(Rindex+1)]%*%mort)) - - - # Export in a cohesive format ---- - results <- list() - results$time <- startdate + times # dates - results$Rt <- out$mean_Rt - results$cum_mortality <- round(cmortality1) # cumulative mortality - results$pct_total_pop_infected <- out$mean_infections - results$doubling_time <- round(log(2)*7 / (log(dailyinc1[2+7] / dailyinc1[2])), 2) # (Baseline only) to double the number of infections at inception - results$required_beds <- round(previcureq1) # required beds - results$saturation <- parameters["beds_available"] # saturation - results$daily_incidence <- round(dailyinc1) # daily incidence (Reported) - results$daily_total_cases <- round(out$mean_daily_infection) # daily incidence (Reported + Unreported) # daily incidence (Reported + Unreported) - results$hospital_surge_beds <- round(previcureq1) - results$icu_beds <- round(previcureq21) - results$ventilators <- round(previcureq31) - results$normal_bed_requirement <- round(reqsurge1) #real required beds. previcureq1 above is the occupancy - results$icu_bed_requirement <- round(reqicu1) - results$icu_ventilator_requirement <- round(reqvent1) - - results$death_natural_non_exposed <- round(base_mort_S1) - results$death_natural_exposed <- round(base_mort_E1 + base_mort_I1 + base_mort_CL1 + base_mort_X1 + base_mort_QS1 + - base_mort_QE1 + base_mort_QI1 + base_mort_QC1 + base_mort_QR1 + base_mort_R1+ - base_mort_H1+base_mort_HC1+base_mort_ICU1+base_mort_ICUC1+base_mort_ICUCV1+ - base_mort_Vent1+base_mort_VentC1) - results$death_treated_hospital <- round(cinc_mort_H1) - results$death_treated_icu <- round(cinc_mort_ICU1) - results$death_treated_ventilator <- round(cinc_mort_Vent1) - results$death_untreated_hospital <- round(cinc_mort_HC1) - results$death_untreated_icu <- round(cinc_mort_ICUC1) - results$death_untreated_ventilator <- round(cinc_mort_VentC1)+round(cinc_mort_ICUCV1) - results$attributable_deaths <- results$death_treated_hospital + results$death_treated_icu + results$death_treated_ventilator + - results$death_untreated_hospital + results$death_untreated_icu + results$death_untreated_ventilator - results$attributable_deaths_end <- last(results$attributable_deaths) - results$total_deaths <- results$attributable_deaths + results$death_natural_non_exposed + results$death_natural_exposed - results$total_deaths_end <- last(results$total_deaths) - results$total_reported_deaths_end <- last(results$cum_mortality) - results$base_mort_H <- base_mort_H1 - results$base_mort_HC <- base_mort_HC1 - results$base_mort_ICU <- base_mort_ICU1 - results$base_mort_ICUC <- base_mort_ICUC1 - results$base_mort_ICUCV <- base_mort_ICUCV1 - results$base_mort_Vent <- base_mort_Vent1 - results$base_mort_VentC <- base_mort_VentC1 - results$base_mort_S <- base_mort_S1 - results$base_mort_E <- base_mort_E1 - results$base_mort_I <- base_mort_I1 - results$base_mort_CL <- base_mort_CL1 - results$base_mort_X <- base_mort_X1 - results$base_mort_QS <- base_mort_QS1 - results$base_mort_QE <- base_mort_QE1 - results$base_mort_QI <- base_mort_QI1 - results$base_mort_QC <- base_mort_QC1 - results$base_mort_QR <- base_mort_QR1 - results$base_mort_R <- base_mort_R1 - - ## AGE DEPENDENT MORTALITY - cinc_mort_H1 <- parameters["nus"]*parameters["pdeath_h"]*(out_mean[,(Hindex+1)]) - cinc_mort_HC1 <- parameters["nusc"]*parameters["pdeath_hc"]*(out_mean[,(HCindex+1)]) - cinc_mort_ICU1 <- parameters["nu_icu"]*parameters["pdeath_icu"]*out_mean[,(ICUindex+1)] - cinc_mort_ICUC1 <- parameters["nu_icuc"]*parameters["pdeath_icuc"]*out_mean[,(ICUCindex+1)] - cinc_mort_ICUCV1 <- parameters["nu_ventc"]*parameters["pdeath_ventc"]*out_mean[,(ICUCVindex+1)] - cinc_mort_Vent1 <- parameters["nu_vent"]*parameters["pdeath_vent"]*out_mean[,(Ventindex+1)] - cinc_mort_VentC1 <- parameters["nu_ventc"]*parameters["pdeath_ventc"]*out_mean[,(VentCindex+1)] - totage1<-as.data.frame(cinc_mort_H1+cinc_mort_HC1+cinc_mort_ICU1+cinc_mort_ICUC1+cinc_mort_ICUCV1+cinc_mort_Vent1+cinc_mort_VentC1) - basemort_H1<-(out_mean[,(Hindex+1)]) - basemort_HC1<-(out_mean[,(HCindex+1)]) - basemort_ICU1<-(out_mean[,(ICUindex+1)]) - basemort_ICUC1<-(out_mean[,(ICUCindex+1)]) - basemort_ICUCV1<-(out_mean[,(ICUCVindex+1)]) - basemort_Vent1<-(out_mean[,(Ventindex+1)]) - basemort_VentC1<-(out_mean[,(VentCindex+1)]) - totbase1<-as.data.frame(basemort_H1+basemort_HC1+basemort_ICU1+basemort_ICUC1+basemort_ICUCV1+basemort_Vent1+basemort_VentC1) - tc<-c() - - for (i in 1:dim(cinc_mort_H1)[1]) { - for (j in 1:dim(cinc_mort_H1)[2]) { - tc<-rbind(tc,c(i, j, totage1[i,j]*ifr[j,2]+totbase1[i,j]*mort[j])) - } - } - tc<-as.data.frame(tc) - colnames(tc)<-c("Day","Age","value") - - results$tc <- tc %>% - mutate(Date = startdate + Day, - age_cat = case_when( - Age >= 1 & Age <= 6 ~ "≤ 30 y.o.", - Age > 6 & Age <= 8 ~ "30-40 y.o.", - Age > 8 & Age <= 10 ~ "40-50 y.o.", - Age > 10 & Age <= 12 ~ "50-60 y.o.", - Age > 12 & Age <= 14 ~ "60-70 y.o.", - Age >= 15 ~ "≥ 70 y.o.")) %>% - mutate(age_cat = factor(age_cat, levels = rev(c("≤ 30 y.o.", "30-40 y.o.", - "40-50 y.o.", "50-60 y.o.", "60-70 y.o.", "≥ 70 y.o.")))) - - mortality_lag <- data.frame(Age = popstruc$agefloor) - if(nrow(out_mean) >= 30) mortality_lag <- bind_cols(mortality_lag, - data.frame(day30 = out_mean[30,CMindex+1]/out_mean[30,Cindex+1]) %>% - mutate(day30 = ifelse(is.infinite(day30), 0, day30)) %>% - rename(`Day 30` = day30)) - if(nrow(out_mean) >= 60) mortality_lag <- bind_cols(mortality_lag, - data.frame(day60 = out_mean[60,CMindex+1]/out_mean[60,Cindex+1]) %>% - mutate(day60 = ifelse(is.infinite(day60), 0, day60)) %>% - rename(`Day 60` = day60)) - if(nrow(out_mean) >= 90) mortality_lag <- bind_cols(mortality_lag, - data.frame(day90 = out_mean[90,CMindex+1]/out_mean[90,Cindex+1]) %>% - mutate(day90 = ifelse(is.infinite(day90), 0, day90)) %>% - rename(`Day 90` = day90)) - if(nrow(out_mean) >= 120) mortality_lag <- bind_cols(mortality_lag, - data.frame(day120 = out_mean[120,CMindex+1]/out_mean[120,Cindex+1]) %>% - mutate(day120 = ifelse(is.infinite(day120), 0, day120)) %>% - rename(`Day 120` = day120)) - - results$mortality_lag <- mortality_lag - - - if(iterations>1){ - - previcureq1_max<-rowSums(out_max[,(Hindex+1)])+ rowSums(out_max[,(ICUCindex+1)])+rowSums(out_max[,(ICUCVindex+1)]) # surge beds occupancy - previcureq21_max<-rowSums(out_max[,(ICUindex+1)])+rowSums(out_max[,(VentCindex+1)]) # icu beds occupancy - previcureq31_max<-rowSums(out_max[,(Ventindex+1)]) # ventilator occupancy - cmortality1_max<-rowSums(out_max[,(CMindex+1)]) # cumulative mortality - overloadH1_max<-rowSums(out_max[,(HCindex+1)]) # requirement for beds - overloadICU1_max<-rowSums(out_max[,(ICUCindex+1)]) # requirement for icu beds - overloadICUV1_max<-rowSums(out_max[,(ICUCVindex+1)]) # requirement for ventilators - overloadVent1_max<-rowSums(out_max[,(VentCindex+1)]) # requirement for ventilators - ccases1_max<-rowSums(out_max[,(Cindex+1)]) # cumulative cases - reqsurge1_max<-rowSums(out_max[,(Hindex+1)])+overloadH1 # surge beds total requirements - reqicu1_max<-rowSums(out_max[,(ICUindex+1)])+overloadICU1 # ICU beds total requirements - reqvent1_max<-rowSums(out_max[,(Ventindex+1)])+overloadICUV1+overloadVent1 # ventilator beds total requirements - - previcureq1_min<-rowSums(out_min[,(Hindex+1)])+ rowSums(out_min[,(ICUCindex+1)])+rowSums(out_min[,(ICUCVindex+1)]) # surge beds occupancy - previcureq21_min<-rowSums(out_min[,(ICUindex+1)])+rowSums(out_min[,(VentCindex+1)]) # icu beds occupancy - previcureq31_min<-rowSums(out_min[,(Ventindex+1)]) # ventilator occupancy - cmortality1_min<-rowSums(out_min[,(CMindex+1)]) # cumulative mortality - overloadH1_min<-rowSums(out_min[,(HCindex+1)]) # requirement for beds - overloadICU1_min<-rowSums(out_min[,(ICUCindex+1)]) # requirement for icu beds - overloadICUV1_min<-rowSums(out_min[,(ICUCVindex+1)]) # requirement for ventilators - overloadVent1_min<-rowSums(out_min[,(VentCindex+1)]) # requirement for ventilators - ccases1_min<-rowSums(out_min[,(Cindex+1)]) # cumulative cases - reqsurge1_min<-rowSums(out_min[,(Hindex+1)])+overloadH1 # surge beds total requirements - reqicu1_min<-rowSums(out_min[,(ICUindex+1)])+overloadICU1 # ICU beds total requirements - reqvent1_min<-rowSums(out_min[,(Ventindex+1)])+overloadICUV1+overloadVent1 # ventilator beds total requirements - - results$Rt_max <- out$max_Rt - results$Rt_min <- out$min_Rt - - results$daily_incidence_max <- out$max_cases - results$daily_incidence_min <- out$min_cases - - results$daily_total_cases_max <- out$max_daily_infection - results$daily_total_cases_min <- out$min_daily_infection - - results$total_reported_deaths_end_min <- last(cmortality1_min) - results$total_reported_deaths_end_max <- last(cmortality1_max) - - results$pct_total_pop_infected_min <- out$min_infections # proportion of the population that has been infected at the end of the simulation - results$pct_total_pop_infected_max <- out$max_infections # proportion of the population that has been infected at the end of the simulation - } - return(results) -} - -# covidOdeCpp_reset() -# out <- ode(y = Y, times = times, func = covidOdeCpp, parms = parameters, -# input=vectors, A=A, -# contact_home=contact_home, contact_school=contact_school, -# contact_work=contact_work, contact_other=contact_other, -# popbirth_col2=popbirth[,2], popstruc_col2=popstruc[,2], -# ageing=ageing, -# ifr_col2=ifr[,2], ihr_col2=ihr[,2], mort_col=mort) - -multi_runs<-function(Y,times,parameters,input,iterations,noise,confidence){ - - results <- list() - aux<-array(0, dim=c(length(times),23*A+1,iterations)) - results$mean<-matrix(0,nrow = length(times),ncol = 23*A+1) - results$min<-matrix(0,nrow = length(times),ncol = 23*A+1) - results$max<-matrix(0,nrow = length(times),ncol = 23*A+1) - results$mean_cases<-matrix(0,nrow = length(times),ncol = 23*A+1) - results$min_cases<-matrix(0,nrow = length(times),ncol = 23*A+1) - results$max_cases<-matrix(0,nrow = length(times),ncol = 23*A+1) - results$mean_cum_cases<-matrix(0,nrow = length(times),ncol = 1) - results$min_cum_cases<-matrix(0,nrow = length(times),ncol = 1) - results$max_cum_cases<-matrix(0,nrow = length(times),ncol = 1) - results$mean_daily_infection<-matrix(0,nrow = length(times),ncol = 1) - results$min_daily_infection<-matrix(0,nrow = length(times),ncol = 1) - results$max_daily_infection<-matrix(0,nrow = length(times),ncol = 1) - cases<-matrix(0, nrow=length(times),ncol=iterations) - cum_cases<-matrix(0, nrow=length(times),ncol=iterations) - day_infections<-matrix(0, nrow=length(times),ncol=iterations) - Rt_aux<-matrix(0, nrow=length(times),ncol=iterations) - infections<-matrix(0, nrow=iterations,ncol=1) - Rt <- NULL - - param_vector<-parameters - if(iterations>1){ - for (i in 1:iterations){ - param_vector[parameters_noise]<-parameters[parameters_noise]+rnorm(length(parameters_noise),mean=0,sd=noise*abs(parameters[parameters_noise])) - out0 <- ode(y = Y, times = times, method = "euler", hini = 0.05, func = covid, parms = param_vector, input=vectors0) - aux[,,i]<-out0 - - critH<-c() - crit<-c() - critV<-c() - for (ii in 1:length(times)){ - critH[ii]<-min(1-fH((sum(out0[ii,(Hindex+1)]))+sum(out0[ii,(ICUCindex+1)])+sum(out0[ii,(ICUCVindex+1)])),1) - crit[ii]<-min(1-fICU((sum(out0[ii,(ICUindex+1)]))+(sum(out0[ii,(Ventindex+1)]))+(sum(out0[ii,(VentCindex+1)])))) - critV[ii]<-min(1-fVent((sum(out0[ii,(Ventindex+1)]))),1) - } - - # daily incidence - incidence<-param_vector["report"]*param_vector["gamma"]*(1-param_vector["pclin"])*out0[,(Eindex+1)]%*%(1-ihr[,2])+ - param_vector["reportc"]*param_vector["gamma"]*param_vector["pclin"]*out0[,(Eindex+1)]%*%(1-ihr[,2])+ - param_vector["report"]*param_vector["gamma"]*(1-param_vector["pclin"])*out0[,(QEindex+1)]%*%(1-ihr[,2])+ - param_vector["reportc"]*param_vector["gamma"]*param_vector["pclin"]*out0[,(QEindex+1)]%*%(1-ihr[,2]) - - incidenceh<- param_vector["gamma"]*out0[,(Eindex+1)]%*%ihr[,2]*(1-critH)*(1-param_vector["prob_icu"])*param_vector["reporth"]+ - param_vector["gamma"]*out0[,(Eindex+1)]%*%ihr[,2]*(1-critH)*(1-param_vector["prob_icu"])*(1-param_vector["reporth"])+ - param_vector["gamma"]*out0[,(QEindex+1)]%*%ihr[,2]*(1-critH)*(1-param_vector["prob_icu"])+ - param_vector["gamma"]*out0[,(Eindex+1)]%*%ihr[,2]*critH*param_vector["reporth"]*(1-param_vector["prob_icu"])+ - param_vector["gamma"]*out0[,(QEindex+1)]%*%ihr[,2]*critH*param_vector["reporth"]*(1-param_vector["prob_icu"])+ - param_vector["gamma"]*out0[,(Eindex+1)]%*%ihr[,2]*param_vector["prob_icu"]+ - param_vector["gamma"]*out0[,(QEindex+1)]%*%ihr[,2]*param_vector["prob_icu"] - - cases[,i]<-(rowSums(incidence)+rowSums(incidenceh)) # daily incidence cases - cum_cases[,i]<-colSums(incidence)+colSums(incidenceh) # cumulative incidence cases - day_infections[,i]<- round(rowSums(param_vector["gamma"]*out0[,(Eindex+1)]+param_vector["gamma"]*out0[,(QEindex+1)])) - - # daily infections - infections[i] <- round(100*tail(cumsum(rowSums(param_vector["gamma"]*out0[,(Eindex+1)])),1)/sum(popstruc[,2]), 1) # proportion of the population that has been infected at the end of the simulation - for (w in (ceiling(1/param_vector["nui"])+1):length(times)){ - Rt_aux[w,i]<-cumsum(sum(param_vector["gamma"]*out0[w,(Eindex+1)]))/cumsum(sum(param_vector["gamma"]*out0[(w-1/param_vector["nui"]),(Eindex+1)])) - if(Rt_aux[w,i] >= 7) {Rt_aux[w,i] <- NA} - } - } - qq <- quantile(infections, c(confidence, 0.5, (1-confidence))) - results$mean_infections<-qq[2] - results$min_infections<-qq[1] - results$max_infections<-qq[3] - - for(i in 1:length(out0[,1])){ - qq <- quantile(cases[i,], c(confidence, 0.5, (1-confidence))) - results$mean_cases[i]<-qq[2] - results$min_cases[i]<-qq[1] - results$max_cases[i]<-qq[3] - - qq <- quantile(cum_cases[i,], c(confidence, 0.5, (1-confidence))) - results$mean_cum_cases[i]<-qq[2] - results$min_cum_cases[i]<-qq[1] - results$max_cum_cases[i]<-qq[3] - - qq <- quantile(day_infections[i,], c(confidence, 0.5, (1-confidence))) - results$mean_daily_infection[i]<-qq[2] - results$min_daily_infection[i]<-qq[1] - results$max_daily_infection[i]<-qq[3] - - qq <- quantile(Rt_aux[i,], c(confidence, 0.5, (1-confidence)),na.rm = T) - results$mean_Rt[i]<-qq[2] - results$min_Rt[i]<-qq[1] - results$max_Rt[i]<-qq[3] - - for (j in 1:length(out0[1,])){ - qq <- quantile(aux[i,j,], c(confidence, 0.5, (1-confidence))) - results$mean[i,j]<-qq[2] - results$min[i,j]<-qq[1] - results$max[i,j]<-qq[3] - } - } - }else{ - results$mean <- ode(y = Y, times = times, method = "euler", hini = 0.05, func = covid, parms = parameters, input=vectors0) - } - return(results) -} -out0 <-multi_runs(Y, times, parameters, vectors0, iterations, noise, confidence) -out0$min_infections -out0$max_infections - -plot(times,rowSums(out0$mean[,Iindex+1]),type = 'l') -polygon(c(times, rev(times)), c(rowSums(out0$max[,Iindex+1]), rev(rowSums(out0$min[,Iindex+1]))), - col=rgb(0, 0, 0,0.25), border = NA) - -plot(times,out0$mean_Rt,type = 'l') -polygon(c(times, rev(times)), c(out0$max_Rt, rev(out0$min_Rt)), - col=rgb(0, 0, 0,0.25), border = NA) - - -# out0 <- ode(y = Y, times = times, method = "euler", hini = 0.05, func = covid, parms = parameters, input=vectors0) -# out <- ode(y = Y, times = times, method = "euler", hini = 0.05, func = covid, parms = parameters, input=vectors) - -simul_baseline <- process_ode_outcome(out0,iterations) -# # write.csv(simul_baseline, paste0(hilo,"_baseline_",gsub(":|-","",Sys.time()),".csv")) -# -#future interventions -#extend travel ban, quarantine, hand washing, cocooning the elderly until 1st July -out <-multi_runs(Y, times, parameters, vectors, iterations, noise, confidence) -simul_interventions <- process_ode_outcome(out,iterations) -# write.csv(simul_interventions, paste0(hilo,"_futureIntv_",gsub(":|-","",Sys.time()),".csv")) - -pop1<-out$mean[,(Sindex+1)]+out$mean[,(Eindex+1)]+out$mean[,(Iindex+1)]+out$mean[,(CLindex+1)]+out$mean[,(Rindex+1)]+out$mean[,(Xindex+1)]+out$mean[,(Vindex+1)]+ - out$mean[,(Zindex+1)]+out$mean[,(QSindex+1)]+out$mean[,(QEindex+1)]+out$mean[,(QIindex+1)]+out$mean[,(QCindex+1)]+out$mean[,(QRindex+1)]+ - out$mean[,(Hindex+1)]+out$mean[,(HCindex+1)]+out$mean[,(ICUindex+1)]+out$mean[,(ICUCindex+1)]+out$mean[,(ICUCVindex+1)]+out$mean[,(Ventindex+1)]+out$mean[,(VentCindex+1)] -tpop1<-rowSums(pop1) - -############# PLOTTING -# Fitting tab -# fitting the intervention lines to the data to account for any historical interventions -time<-as.Date(out0$mean[,1]+startdate) -par(mfrow=c(1,2)) -# set up the axis limits -xmin<-min(as.Date(cases_rv[,1])) -xmax<-max(as.Date(cases_rv[,1])) -ymax<-max(cases_rv[,2],na.rm = T) -xtick<-seq(xmin, xmax, by=7) -plot(time,simul_interventions$daily_incidence,type='l',lwd=3, - main="New Reported Cases", xlab="Date", ylab="Cases per day", - xlim=c(xmin,xmax), ylim=c(0,ymax), col='blue',xaxt="n") -axis(side=1, labels = FALSE) -text(x=xtick, y=-250, labels = format(xtick,"%b-%d"), srt = 0, xpd = TRUE) -points(as.Date(cases_rv[,1]),cases_rv[,2],pch=19,col='red') - -# reset the maximum to the cumulative mortality -ymax<-max(cases_rv[,3],na.rm = T) -plot(time,simul_interventions$cum_mortality,type='l',lwd=3, - main="Cumulative Mortality", xlab="Date", ylab="Total deaths", - xlim=c(xmin,xmax), ylim=c(0,ymax), col='blue',xaxt="n") -text(x=xtick, y=-100, labels = format(xtick,"%b-%d"), srt = 0, xpd = TRUE) -points(as.Date(cases_rv[,1]),cases_rv[,3],pch=19,col='red') - - -### Predictions tab -par(mfrow=c(1,2)) -### Cases at baseline and intervention -ymax<-max(c(cases_rv[,2],simul_baseline$daily_incidence,simul_interventions$daily_incidence),na.rm=T) -plot(time,simul_baseline$daily_incidence,type='l',lwd=3,col='blue', - main="Baseline", xlab="Date", ylab="New cases per day",ylim=c(0,ymax)) -points(as.Date(cases_rv[,1]),cases_rv[,2],pch=19,col='red') -plot(time,simul_interventions$daily_incidence,type='l',lwd=3,col='blue', - main="Intervention", xlab="Date", ylab="New cases per day",ylim=c(0,ymax)) -points(as.Date(cases_rv[,1]),cases_rv[,2],pch=19,col='red') - - - -# # # Hospital prevalences stratified by H,ICU and Vent -ymax<-max(c((simul_baseline$hospital_surge_beds+simul_baseline$icu_beds+simul_baseline$ventilators),(simul_interventions$hospital_surge_beds+simul_interventions$icu_beds+simul_interventions$ventilators))) -time<-as.Date(out0$mean[,1]+startdate) -coul=c("#047883", "#24A9E2","#051A46") -DM<-as.data.frame(cbind(time,simul_baseline$hospital_surge_beds,simul_baseline$icu_beds,simul_baseline$ventilators)) -colnames(DM)<-c("Time","Hospital surge beds","ICU beds","Ventilators") -DM$Time<-as.Date(DM$Time,origin = "1970-01-01") -DMF<-melt(DM, id.vars="Time",measure.vars = c("Hospital surge beds","ICU beds","Ventilators")) -d0<-ggplot(DMF, aes(x = Time, y = value,fill=variable)) + - geom_area()+ - scale_fill_manual(values=coul) - -DM<-as.data.frame(cbind(time,simul_interventions$hospital_surge_beds,simul_interventions$icu_beds,simul_interventions$ventilators)) -colnames(DM)<-c("Time","Hospital surge beds","ICU beds","Ventilators") -DM$Time<-as.Date(DM$Time, origin = "1970-01-01") -DMF<-melt(DM, id.vars="Time",measure.vars = c("Hospital surge beds","ICU beds","Ventilators")) -d1<-ggplot(DMF, aes(x = Time, y = value,fill=variable)) + - geom_area()+ - scale_fill_manual(values=coul) - -grid.arrange(d0+ylab("Number of Patients")+ - ggtitle("Baseline")+ - ylim(0, ymax)+ - geom_hline(yintercept=(parameters["beds_available"]+parameters["icu_beds_available"]+parameters["ventilators_available"]), linetype="dashed", color = "#047883")+ - geom_hline(yintercept=(parameters["icu_beds_available"]+parameters["ventilators_available"]), linetype="dashed", color = "#24A9E2")+ - geom_hline(yintercept=parameters["ventilators_available"], linetype="dashed", color = "#051A46")+ - theme_bw(), - d1+ylab("Number of Patients")+ - ggtitle("Intervention")+ - ylim(0, ymax)+ - geom_hline(yintercept=(parameters["beds_available"]+parameters["icu_beds_available"]+parameters["ventilators_available"]), linetype="dashed", color = "#047883")+ - geom_hline(yintercept=(parameters["icu_beds_available"]+parameters["ventilators_available"]), linetype="dashed", color = "#24A9E2")+ - geom_hline(yintercept=parameters["ventilators_available"], linetype="dashed", color = "#051A46")+ - theme_bw(), - nrow = 1) - - -# # # Cumulative mortality at baseline and intervention stratified by hospital status -ymax<-max(c((simul_baseline$total_deaths),(simul_interventions$total_deaths))) -time<-as.Date(out$mean[,1]+startdate) -coul=c("#047883", "#24A9E2","#051A46","#E68029", "#D63304","#D1D604") -DM0<-as.data.frame(cbind(time,simul_baseline$base_mort_I+simul_baseline$base_mort_QI, - simul_baseline$base_mort_CL+simul_baseline$base_mort_QC, - simul_baseline$base_mort_X, - simul_baseline$base_mort_S+simul_baseline$base_mort_QS, - simul_baseline$base_mort_E+simul_baseline$base_mort_QE, - simul_baseline$base_mort_QR+simul_baseline$base_mort_R, - simul_baseline$death_treated_hospital, - simul_baseline$death_treated_icu, - simul_baseline$death_treated_ventilator, - simul_baseline$death_untreated_hospital, - simul_baseline$death_untreated_icu, - simul_baseline$death_untreated_ventilator)) -colnames(DM0)<-c("Time","Asymptomatic","Clnical","Self-Isolating","Susceptible","Exposed","Recovered", - "Treated: Hospital","Treated: ICU","Treated: Ventilator","Untreated: Hospital","Untreated: ICU","Untreated: Ventilator") -DM0$Time<-as.Date(DM0$Time, origin = "1970-01-01") -DMF0<-melt(DM0, id.vars="Time",measure.vars = c("Asymptomatic","Clnical","Self-Isolating","Susceptible","Exposed","Recovered", - "Treated: Hospital","Treated: ICU","Treated: Ventilator","Untreated: Hospital","Untreated: ICU","Untreated: Ventilator")) -m0<-ggplot(DMF0, aes(x = Time, y = value,fill=variable)) + - geom_area() - -DM<-as.data.frame(cbind(time,simul_interventions$base_mort_I+simul_interventions$base_mort_QI,simul_interventions$base_mort_CL+simul_interventions$base_mort_QC,simul_interventions$base_mort_X,simul_interventions$base_mort_S+ - simul_interventions$base_mort_QS,simul_interventions$base_mort_E+simul_interventions$base_mort_QE,simul_interventions$base_mort_QR+simul_interventions$base_mort_R, - simul_interventions$death_treated_hospital,simul_interventions$death_treated_icu,simul_interventions$death_treated_ventilator,simul_interventions$death_untreated_hospital,simul_interventions$death_untreated_icu,simul_interventions$death_untreated_ventilator)) -colnames(DM)<-c("Time","Asymptomatic","Clnical","Self-Isolating","Susceptible","Exposed","Recovered", - "Treated: Hospital","Treated: ICU","Treated: Ventilator","Untreated: Hospital","Untreated: ICU","Untreated: Ventilator") -DM$Time<-as.Date(DM$Time, origin = "1970-01-01") -DMF<-melt(DM, id.vars="Time",measure.vars = c("Asymptomatic","Clnical","Self-Isolating","Susceptible","Exposed","Recovered", - "Treated: Hospital","Treated: ICU","Treated: Ventilator","Untreated: Hospital","Untreated: ICU","Untreated: Ventilator")) -m1<-ggplot(DMF, aes(x = Time, y = value,fill=variable)) + - geom_area() -grid.arrange(m0+ylab("Cumulatice mortality")+ - ggtitle("Baseline")+ - ylim(0, ymax), - m1+ylab("Cumulatice mortality")+ - ggtitle("Intervention")+ - ylim(0, ymax), - nrow = 1) - - - -# Estimated basic reproduction number, R_t -par(mfrow=c(1,2)) -ymax<-max(c(simul_baseline$Rt[!is.na(simul_baseline$Rt)],simul_interventions$Rt[!is.na(simul_interventions$Rt)])) -plot(time,simul_baseline$Rt,type='l',lwd=3,col='black', - main="Baseline", xlab="Date", ylab="Reproduction number",ylim=c(0,ymax)) -lines(time,simul_baseline$Rt/simul_baseline$Rt,lwd=2,col='grey') -plot(time,simul_interventions$Rt,type='l',lwd=3,col='black', - main="Intervention", xlab="Date", ylab="Reproduction number",ylim=c(0,ymax)) -lines(time,simul_interventions$Rt/simul_interventions$Rt,lwd=2,col='grey') - - -# ## Predicted ifr -# ymax=max(c(simul_baseline$MORT1$value,simul_interventions$MORT1$value)) -# gm<-ggplot(data=simul_interventions$MORT1,aes(x=Age,y=value,fill=variable))+ -# geom_line(data=simul_interventions$MORT1,aes(x=Age,y=value,colour=variable),lwd=1.5)+ylim(0,ymax)+ylab("Mortality") -# gm0<-ggplot(data=simul_baseline$MORT1,aes(x=Age,y=value,fill=variable))+ -# geom_line(data=simul_baseline$MORT1,aes(x=Age,y=value,colour=variable),lwd=1.5)+ylim(0,ymax)+ylab("Mortality") -# -# grid.arrange(gm+theme_classic(), -# gm0+theme_classic(), -# nrow=1) - - -# ## AGE DEPENDENT MORTALITY -# cinc_mort_H1 <- parameters["nus"]*parameters["pdeath_h"]*(out$mean[,(Hindex+1)]) -# cinc_mort_HC1 <- parameters["nusc"]*parameters["pdeath_hc"]*(out$mean[,(HCindex+1)]) -# cinc_mort_ICU1 <- parameters["nu_icu"]*parameters["pdeath_icu"]*out$mean[,(ICUindex+1)] -# cinc_mort_ICUC1 <- parameters["nu_icuc"]*parameters["pdeath_icuc"]*out$mean[,(ICUCindex+1)] -# cinc_mort_Vent1 <- parameters["nu_vent"]*parameters["pdeath_vent"]*out$mean[,(Ventindex+1)] -# cinc_mort_VentC1 <- parameters["nu_ventc"]*parameters["pdeath_ventc"]*out$mean[,(VentCindex+1)] -# totage1<-as.data.frame(cinc_mort_H1+cinc_mort_HC1+cinc_mort_ICU1+cinc_mort_ICUC1+cinc_mort_Vent1+cinc_mort_VentC1) -# basemort_H1<-(out$mean[,(Hindex+1)]) -# basemort_HC1<-(out$mean[,(HCindex+1)]) -# basemort_ICU1<-(out$mean[,(ICUindex+1)]) -# basemort_ICUC1<-(out$mean[,(ICUCindex+1)]) -# basemort_Vent1<-(out$mean[,(Ventindex+1)]) -# basemort_VentC1<-(out$mean[,(VentCindex+1)]) -# totbase1<-as.data.frame(basemort_H1+basemort_HC1+basemort_ICU1+basemort_ICUC1+basemort_Vent1+basemort_VentC1) -# tc<-c() -# ages<-seq(0,100,by=5) -# for (i in 1:dim(cinc_mort_H1)[1]) { -# for (j in 1:dim(cinc_mort_H1)[2]) { -# tc<-rbind(tc,c(i,ages[j],totage1[i,j]*ifr[j,2]+totbase1[i,j]*mort[j])) -# } -# } -# tc<-as.data.frame(tc) -# colnames(tc)<-c("Day","Age","value") -# tc$Age<-as.factor(tc$Age) -# p6<-ggplot(data=tc, aes(x=Day,y=value,fill=Age))+ -# geom_bar(stat = "identity",position="fill", width=1)+ -# ylab("Proportion of deaths") -# -# inc_mort_H0 <- parameters["nus"]*parameters["pdeath_h"]*(out0$mean[,(Hindex+1)]) -# inc_mort_HC0 <- parameters["nusc"]*parameters["pdeath_hc"]*(out0$mean[,(HCindex+1)]) -# inc_mort_ICU0 <- parameters["nu_icu"]*parameters["pdeath_icu"]*out0$mean[,(ICUindex+1)] -# inc_mort_ICUC0 <- parameters["nu_icuc"]*parameters["pdeath_icuc"]*out0$mean[,(ICUCindex+1)] -# inc_mort_Vent0 <- parameters["nu_vent"]*parameters["pdeath_vent"]*out0$mean[,(Ventindex+1)] -# inc_mort_VentC0 <- parameters["nu_ventc"]*parameters["pdeath_ventc"]*out0$mean[,(VentCindex+1)] -# totage0<-as.data.frame(inc_mort_H0+inc_mort_HC0+inc_mort_ICU0+inc_mort_ICUC0+inc_mort_Vent0+inc_mort_VentC0) -# basemort_H0<-(out0$mean[,(Hindex+1)]) -# basemort_HC0<-(out0$mean[,(HCindex+1)]) -# basemort_ICU0<-(out0$mean[,(ICUindex+1)]) -# basemort_ICUC0<-(out0$mean[,(ICUCindex+1)]) -# basemort_Vent0<-(out0$mean[,(Ventindex+1)]) -# basemort_VentC0<-(out0$mean[,(VentCindex+1)]) -# totbase0<-as.data.frame(basemort_H0+basemort_HC0+basemort_ICU0+basemort_ICUC0+basemort_Vent0+basemort_VentC0) -# tc0<-c() -# for (i in 1:dim(cinc_mort_H1)[1]) { -# for (j in 1:dim(cinc_mort_H1)[2]) { -# tc0<-rbind(tc0,c(i,ages[j],totage0[i,j]*ifr[j,2]+totbase0[i,j]*mort[j])) -# } -# } -# tc0<-as.data.frame(tc0) -# colnames(tc0)<-c("Day","Age","value") -# tc0$Age<-as.factor(tc0$Age) -# p16<-ggplot(data=tc0, aes(x=Day,y=value,fill=Age))+ -# geom_bar(stat = "identity",position="fill", width=1)+ylab("Proportion of deaths") - -# grid.arrange(p16+theme_minimal(), -# p6+theme_minimal(), -# nrow=1) -# - - -# -# -# -# ######################################################################################################################### -# ##### SUMMARY METRICS ################################################################################################ -# ####################################################################################################################### -# -infected0<-tail((rowSums(out0$mean[,(Rindex+1)])),1)/sum(popstruc[,2]) -infected0 -infected1<-tail((rowSums(out$mean[,(Rindex+1)])),1)/sum(popstruc[,2]) -infected1 - -# # #Population size checks -# # tpop1 -# # tpop0 -# -# # PCR -# time_of_measurement<-40:49 -# # general population -# (rowSums(out$mean[time_of_measurement,Iindex+1])+rowSums(out$mean[time_of_measurement,CLindex+1])+rowSums(out$mean[time_of_measurement,QIindex+1])+ -# rowSums(out$mean[time_of_measurement,QCindex+1]))/sum(popstruc[,2]) -# # every infection including hospital infections -# (rowSums(out$mean[time_of_measurement,Iindex+1])+rowSums(out$mean[time_of_measurement,CLindex+1])+rowSums(out$mean[time_of_measurement,Hindex+1])+ -# rowSums(out$mean[time_of_measurement,ICUindex+1])+rowSums(out$mean[time_of_measurement,Ventindex+1])+rowSums(out$mean[time_of_measurement,HCindex+1])+ -# rowSums(out$mean[time_of_measurement,ICUCindex+1])+rowSums(out$mean[time_of_measurement,VentCindex+1])+rowSums(out$mean[time_of_measurement,QIindex+1])+ -# rowSums(out$mean[time_of_measurement,QCindex+1]))/sum(popstruc[,2]) -# -# SEROLOGY -tail((rowSums(out$mean[,(Rindex+1)])),1)/sum(popstruc[,2]) - -# IHR -sum(ihr$severe*popstruc[,2]/sum(popstruc[,2])) - - -# # PORPORTIONAL MORTALITY IN THE ELDEST -# m30<-out0$mean[30,CMindex+1]/(out0$mean[30,Cindex+1]) -# m30[is.infinite(m30)]<-0 -# m60<-out0$mean[60,CMindex+1]/out0$mean[60,Cindex+1] -# m60[is.infinite(m60)]<-0 -# m90<-out0$mean[90,CMindex+1]/out0$mean[90,Cindex+1] -# m90[is.infinite(m90)]<-0 -# m120<-out0$mean[120,CMindex+1]/out0$mean[120,Cindex+1] -# m120[is.infinite(m120)]<-0 -# -# ifr30<-sum(m30*popstruc[,2]/sum(popstruc[,2]),na.rm = T) -# ifr60<-sum(m60*popstruc[,2]/sum(popstruc[,2]),na.rm = T) -# ifr90<-sum(m90*popstruc[,2]/sum(popstruc[,2]),na.rm = T) -# ifr120<-sum(m120*popstruc[,2]/sum(popstruc[,2]),na.rm = T) -# cbind(ifr30,ifr60,ifr90,ifr120)*100 -# -# PMORTDF0<-as.data.frame(cbind(out0$mean[30,CMindex+1]/sum(out0$mean[30,CMindex+1]),out0$mean[60,CMindex+1]/sum(out0$mean[60,CMindex+1]), -# out0$mean[90,CMindex+1]/sum(out0$mean[90,CMindex+1]),out0$mean[120,CMindex+1]/sum(out0$mean[120,CMindex+1]))) -# PMORTDF<-as.data.frame(cbind(out$mean[30,CMindex+1]/sum(out$mean[30,CMindex+1]),out$mean[60,CMindex+1]/sum(out$mean[60,CMindex+1]), -# out$mean[90,CMindex+1]/sum(out$mean[90,CMindex+1]),out$mean[120,CMindex+1]/sum(out$mean[120,CMindex+1]))) -# sum(PMORTDF0$V2[15:21]) -# sum(PMORTDF$V2[15:21]) - - -# output doubling time over time first 7 days -# dd<-7 -# doub0<-log(2)*dd/(log(dailyinc0[2+dd]/dailyinc0[2])) -# doub0 -# -# -# - - diff --git a/r_versions/covidage_v14.4.R b/r_versions/covidage_v14.4.R deleted file mode 100644 index 159634d..0000000 --- a/r_versions/covidage_v14.4.R +++ /dev/null @@ -1,1706 +0,0 @@ -require("deSolve") -library("ggplot2") -library("dplyr") -library("reshape2") -require(gridExtra) -library(ggpubr) -library(bsplus) -library(deSolve) -library(DT) -library(highcharter) -library(lubridate) -library(pushbar) -library(readxl) -library(reshape2) -library(scales) -library(shiny) -library(shinyBS) -library(shinycssloaders) -library(shinyhelper) -library(shinythemes) -library(shinyWidgets) -library(tidyverse) -library(XLConnect) -# library("comoOdeCpp") - -#read data from excel file -setwd("C:/covid19/covid_age") -load("data_CoMo.RData") -file_path <- paste0(getwd(),"/Template_CoMoCOVID-19App_new.xlsx") -country_name<-"Cambodia" - -# Cases -dta <- read_excel(file_path, sheet = "Cases") -names(dta) <- c("date", "cases", "deaths") - -cases_rv <- dta %>% - mutate(date = as.Date(date), cumulative_death = cumsum(deaths)) %>% - as.data.frame() - -# Severity/Mortality -dta <- read_excel(file_path, sheet = "Severity-Mortality") -names(dta) <- c("age_category", "ifr", "ihr") - -mort_sever_rv <- dta %>% - mutate(ihr = ihr/100) %>% # starting unit should be % - scaling to a value between 0 and 1 - mutate(ifr = ifr/max(ifr)) # starting unit should be % - scaling to a value between 0 and 1 - -# Population -dta <- read_excel(file_path, sheet = "Population") -names(dta) <- c("age_category", "pop", "birth", "death") - -population_rv <- dta %>% - transmute(country = NA, age_category, pop, birth, death) - -# Parameters -param <- bind_rows(read_excel(file_path, sheet = "Parameters"), - read_excel(file_path, sheet = "Country Area Param"), - read_excel(file_path, sheet = "Virus Param"), - read_excel(file_path, sheet = "Hospitalisation Param"), - read_excel(file_path, sheet = "Interventions Param"), - read_excel(file_path, sheet = "Interventions")) %>% - mutate(Value_Date = as.Date(Value_Date)) - -# START Bridge ---- -popstruc <- population_rv %>% - select(age_category, pop) %>% - rename(agefloor = age_category) %>% - as.data.frame() - -popbirth <- population_rv %>% - select(age_category, birth) %>% - as.data.frame() # unit should be per person per day - -mort <- population_rv %>% - pull(death) # unit should be per person per day - -ihr <- mort_sever_rv %>% - select(age_category, ihr) %>% - as.data.frame() - -ifr <- mort_sever_rv %>% - select(age_category, ifr) %>% - as.data.frame() - - -######### POP AGEING -# per year ageing matrix -A<-length(popstruc[,2]) -dd<-seq(1:A)/seq(1:A) -ageing <- t(diff(diag(dd),lag=1)/(5*365.25)) -ageing<-cbind(ageing,0*seq(1:A)) # no ageing from last compartment - -# -pop<-population$country==country_name -pp<-population$pop[pop] -### CONTACT MATRICES -c_home <- contact_home[[country_name]] %>% as.matrix() -c_school <- contact_school[[country_name]] %>% as.matrix() -c_work <- contact_work[[country_name]] %>% as.matrix() -c_other <- contact_other[[country_name]] %>% as.matrix() -nce <-A-length(c_home[1,]) - -contact_home<-matrix(0,nrow=A,ncol=A) -contact_school<-matrix(0,nrow=A,ncol=A) -contact_work<-matrix(0,nrow=A,ncol=A) -contact_other<-matrix(0,nrow=A,ncol=A) - -for (i in 1:(A-nce)){ - for (j in 1:(A-nce)){ - contact_home[i,j]<-c_home[i,j] - contact_school[i,j]<-c_school[i,j] - contact_work[i,j]<-c_work[i,j] - contact_other[i,j]<-c_other[i,j] - } -} - -for (i in (A+1-nce):A){ - for (j in 1:(A-nce)){ - contact_home[i,j]<-c_home[(A-nce),j] - contact_school[i,j]<-c_school[(A-nce),j] - contact_work[i,j]<-c_work[(A-nce),j] - contact_other[i,j]<-c_other[(A-nce),j] - } -} -for (i in 1:(A-nce)){ - for (j in (A+1-nce):A){ - contact_home[i,j]<-c_home[i,(A-nce)] - contact_school[i,j]<-c_school[i,(A-nce)] - contact_work[i,j]<-c_work[i,(A-nce)] - contact_other[i,j]<-c_other[i,(A-nce)] - } -} -for (i in (A+1-nce):A){ - for (j in (A+1-nce):A){ - contact_home[i,j]<-c_home[(A-nce),(A-nce)] - contact_school[i,j]<-c_school[(A-nce),(A-nce)] - contact_work[i,j]<-c_work[(A-nce),(A-nce)] - contact_other[i,j]<-c_other[(A-nce),(A-nce)] - } -} - - - -######### INITIALISE SIMULATION/INTERVENTION START TIMES -startdate <- param$Value_Date[param$Parameter == "date_range_simul_start"] -stopdate <- param$Value_Date[param$Parameter == "date_range_simul_end"] -startdate <- startdate[1] -stopdate <- stopdate[1] - - -day_start <- as.numeric(startdate-startdate) -day_stop <- as.numeric(stopdate-startdate) -times <- seq(day_start, day_stop) - -tin<-as.numeric(startdate-as.Date("2020-01-01"))/365.25 -initP<-sum(popstruc[,2]) # population size -ageindcase<-20 # age of index case (years) -aci <- floor((ageindcase/5)+1) # age class of index case - - -############# DEFINE PARAMETERS -parameters <- c( - ### Transmission instrinsic - p = param$Value[param$Parameter=="p"][1], - rho = param$Value[param$Parameter=="rho"][1], - omega = param$Value[param$Parameter=="omega"][1], - gamma = param$Value[param$Parameter=="gamma"][1], - nui = param$Value[param$Parameter=="nui"][1], - report = param$Value[param$Parameter=="report"][1], - reportc = param$Value[param$Parameter=="reportc"][1], - reporth = param$Value[param$Parameter=="reporth"][1], - beds_available = param$Value[param$Parameter=="beds_available"][1], - icu_beds_available = param$Value[param$Parameter=="icu_beds_available"][1], - ventilators_available = param$Value[param$Parameter=="ventilators_available"][1], - give = 95, - pdeath_h = param$Value[param$Parameter=="pdeath_h"][1], - pdeath_hc = param$Value[param$Parameter=="pdeath_hc"][1], - pdeath_icu = param$Value[param$Parameter=="pdeath_icu"][1], - pdeath_icuc = param$Value[param$Parameter=="pdeath_icuc"][1], - pdeath_vent = param$Value[param$Parameter=="pdeath_vent"][1], - pdeath_ventc = param$Value[param$Parameter=="pdeath_ventc"][1], - ihr_scaling = param$Value[param$Parameter=="ihr_scaling"][1], - nus = param$Value[param$Parameter=="nus"][1], - nusc = param$Value[param$Parameter=="nus"][1], # nusc = nus - nu_icu = param$Value[param$Parameter=="nu_icu"][1], - nu_icuc = param$Value[param$Parameter=="nu_icu"][1], # nu_icuc = nu_icu - nu_vent = param$Value[param$Parameter=="nu_vent"][1], - nu_ventc = param$Value[param$Parameter=="nu_vent"][1], # nu_ventc = nu_vent - rhos = param$Value[param$Parameter=="rhos"][1], - amp = param$Value[param$Parameter=="amp"][1], - phi = param$Value[param$Parameter=="phi"][1], - pclin = param$Value[param$Parameter=="pclin"][1], - prob_icu = param$Value[param$Parameter=="prob_icu"][1], - prob_vent = param$Value[param$Parameter=="prob_vent"][1], - - ### INTERVENTIONS - # self isolation - selfis_eff = mean(param$Value[param$Parameter=="selfis_eff"],na.rm=T), - # social distancing - dist_eff = mean(param$Value[param$Parameter=="dist_eff"],na.rm=T), - # hand washing - hand_eff = mean(param$Value[param$Parameter=="hand_eff"],na.rm=T), - # working at home - work_eff = mean(param$Value[param$Parameter=="work_eff"],na.rm=T), - w2h = mean(param$Value[param$Parameter=="w2h"],na.rm=T), - # school closures - school_eff = mean(param$Value[param$Parameter=="school_eff"],na.rm=T), - s2h = mean(param$Value[param$Parameter=="s2h"],na.rm=T), - # cocooning the elderly - cocoon_eff = mean(param$Value[param$Parameter=="cocoon_eff"],na.rm=T), - age_cocoon = mean(param$Value[param$Parameter=="age_cocoon"],na.rm=T), - # vaccination campaign - # vaccine_on = as.numeric(param$Value_Date[param$Parameter=="date_vaccine_on"] - startdate), - vaccine_eff = mean(param$Value[param$Parameter=="vaccine_eff"],na.rm=T), - age_vaccine_min = mean(param$Value[param$Parameter=="age_vaccine_min"],na.rm=T), - # vaccine_cov = param$Value[param$Parameter=="vaccine_cov"], - vac_campaign = mean(param$Value[param$Parameter=="vac_campaign"],na.rm=T), - # travel ban - mean_imports = mean(param$Value[param$Parameter=="mean_imports"],na.rm=T), - # screening - screen_test_sens = mean(param$Value[param$Parameter=="screen_test_sens"],na.rm=T), - # screen_contacts = mean(param$Value[param$Parameter=="screen_contacts"],na.rm=T), - screen_overdispersion = mean(param$Value[param$Parameter=="screen_overdispersion"],na.rm=T), - # voluntary home quarantine - quarantine_days = mean(param$Value[param$Parameter=="quarantine_days"],na.rm=T), - quarantine_effort = mean(param$Value[param$Parameter=="quarantine_effort"],na.rm=T), - quarantine_eff_home = mean(param$Value[param$Parameter=="quarantine_eff_home"],na.rm=T), - quarantine_eff_other = mean(param$Value[param$Parameter=="quarantine_eff_other"],na.rm=T), - # mass testing - age_testing_min = mean(param$Value[param$Parameter=="age_testing_min"],na.rm=T), - age_testing_max = mean(param$Value[param$Parameter=="age_testing_max"],na.rm=T), - mass_test_sens = mean(param$Value[param$Parameter=="mass_test_sens"],na.rm=T), - isolation_days = mean(param$Value[param$Parameter=="isolation_days"],na.rm=T), - - household_size = param$Value[param$Parameter=="household_size"][1], - noise = param$Value[param$Parameter=="noise"][1], - iterations = param$Value[param$Parameter=="iterations"][1], - confidence = param$Value[param$Parameter=="confidence"][1] -) -ihr[,2]<- parameters["ihr_scaling"]*ihr[,2] - -# Scale parameters to percentages/ rates -parameters["rho"]<-parameters["rho"]/100 -parameters["omega"]<-(1/(parameters["omega"]*365)) -parameters["gamma"]<-1/parameters["gamma"] -parameters["nui"]<-1/parameters["nui"] -parameters["report"]<-parameters["report"]/100 -parameters["reportc"]<-parameters["reportc"]/100 -parameters["reporth"]<-parameters["reporth"]/100 -parameters["nus"]<-1/parameters["nus"] -parameters["rhos"]<-parameters["rhos"]/100 -parameters["amp"]<-parameters["amp"]/100 -parameters["selfis_eff"]<-parameters["selfis_eff"]/100 -parameters["dist_eff"]<-parameters["dist_eff"]/100 -parameters["hand_eff"]<-parameters["hand_eff"]/100 -parameters["work_eff"]<-parameters["work_eff"]/100 -parameters["w2h"]<-parameters["w2h"]/100 -parameters["school_eff"]<-parameters["school_eff"]/100 -parameters["s2h"]<-parameters["s2h"]/100 -parameters["cocoon_eff"]<-parameters["cocoon_eff"]/100 -parameters["age_cocoon"]<-floor((parameters["age_cocoon"]/5)+1) -parameters["vaccine_eff"]<-parameters["vaccine_eff"]/100 -age_vaccine_min<-(parameters["age_vaccine_min"]) -# parameters["vaccine_cov"]<-parameters["vaccine_cov"]/100 -# parameters["vac_campaign"]<-parameters["vac_campaign"]*7 -parameters["screen_test_sens"]<-parameters["screen_test_sens"]/100 -parameters["quarantine_days"]<-parameters["quarantine_days"] -parameters["quarantine_effort"]<-1/parameters["quarantine_effort"] -parameters["quarantine_eff_home"]<-parameters["quarantine_eff_home"]/-100 -parameters["quarantine_eff_other"]<-parameters["quarantine_eff_other"]/100 -parameters["give"]<-parameters["give"]/100 -parameters["pdeath_h"]<-parameters["pdeath_h"]/100 -parameters["pdeath_hc"]<-parameters["pdeath_hc"]/100 -parameters["pdeath_icu"]<-parameters["pdeath_icu"]/100 -parameters["pdeath_icuc"]<-parameters["pdeath_icuc"]/100 -parameters["pdeath_vent"]<-parameters["pdeath_vent"]/100 -parameters["pdeath_ventc"]<-parameters["pdeath_ventc"]/100 -parameters["nusc"]<-1/parameters["nusc"] -parameters["nu_icu"]<-1/parameters["nu_icu"] -parameters["nu_icuc"]<-1/parameters["nu_icuc"] -parameters["nu_vent"]<-1/parameters["nu_vent"] -parameters["nu_ventc"]<-1/parameters["nu_ventc"] -parameters["pclin"]<-parameters["pclin"]/100 -parameters["prob_icu"]<-parameters["prob_icu"]/100 -parameters["prob_vent"]<-parameters["prob_vent"]/100 -parameters_noise<-c(1:5,19:20,22,24,26,32:39,43,45,47:49) -iterations<-parameters["iterations"] -noise<-parameters["noise"] -confidence<-parameters["confidence"]/100 -parameters["mass_test_sens"]<-parameters["mass_test_sens"]/100 -age_testing_min<-(parameters["age_testing_min"]) -age_testing_max<-(parameters["age_testing_max"]) -parameters["isolation_days"]<-parameters["isolation_days"] - -########################################################################### -# Define the indices for each variable -Sindex<-1:A -Eindex<-(A+1):(2*A) -Iindex<-(2*A+1):(3*A) -Rindex<-(3*A+1):(4*A) -Xindex<-(4*A+1):(5*A) -Hindex<-(5*A+1):(6*A) -HCindex<-(6*A+1):(7*A) -Cindex<-(7*A+1):(8*A) -CMindex<-(8*A+1):(9*A) -Vindex<-(9*A+1):(10*A) -QSindex<-(10*A+1):(11*A) -QEindex<-(11*A+1):(12*A) -QIindex<-(12*A+1):(13*A) -QRindex<-(13*A+1):(14*A) -CLindex<-(14*A+1):(15*A) -QCindex<-(15*A+1):(16*A) -ICUindex<-(16*A+1):(17*A) -ICUCindex<-(17*A+1):(18*A) -ICUCVindex<-(18*A+1):(19*A) -Ventindex<-(19*A+1):(20*A) -VentCindex<-(20*A+1):(21*A) -CMCindex<-(21*A+1):(22*A) -Zindex<-(22*A+1):(23*A) - -########################################################################### -# MODEL INITIAL CONDITIONS -initI<-0*popstruc[,2] # Infected and symptomatic -initE<-0*popstruc[,2] # Incubating -initE[aci]<-1 # place random index case in E compartment -initR<-0*popstruc[,2] # Immune -initX<-0*popstruc[,2] # Isolated -initV<-0*popstruc[,2] # Vaccinated -initQS<-0*popstruc[,2] # quarantined S -initQE<-0*popstruc[,2] # quarantined E -initQI<-0*popstruc[,2] # quarantined I -initQR<-0*popstruc[,2] # quarantined R -initH<-0*popstruc[,2] # hospitalised -initHC<-0*popstruc[,2] # hospital critical -initC<-0*popstruc[,2] # Cumulative cases (true) -initCM<-0*popstruc[,2] # Cumulative deaths (true) -initCL<-0*popstruc[,2] # symptomatic cases -initQC<-0*popstruc[,2] # quarantined C -initICU<-0*popstruc[,2] # icu -initICUC<-0*popstruc[,2] # icu critical -initICUCV<-0*popstruc[,2] # icu critical -initVent<-0*popstruc[,2] # icu vent -initVentC<-0*popstruc[,2] # icu vent crit -initCMC<-0*popstruc[,2] # Cumulative deaths (true) -initZ<-0*popstruc[,2] # Cumulative deaths (true) -initS<-popstruc[,2]-initE-initI-initR-initX-initZ-initV-initH-initHC-initQS-initQE-initQI-initQR-initCL-initQC-initICU-initICUC-initICUCV-initVent-initVentC # Susceptible (non-immune) - - -inp <- read_excel(file_path, sheet = "Interventions") -inputs<-function(inp, run){ - # cap intervention end dates with simulation end date - inp$`Date End` = pmin(stopdate, inp$`Date End`) - - tv<-which(inp$`Apply to`==run) - - si<-intersect(which(inp$Intervention=="Self-isolation if Symptomatic"),tv) - scr<-intersect(which(inp$Intervention=="Screening (when S.I.)"),tv) - sd<-intersect(which(inp$Intervention=="Social Distancing"),tv) - hw<-intersect(which(inp$Intervention=="Handwashing"),tv) - wah<-intersect(which(inp$Intervention=="Working at Home"),tv) - sc<-intersect(which(inp$Intervention=="School Closures"),tv) - cte<-intersect(which(inp$Intervention=="Shielding the Elderly"),tv) - q<-intersect(which(inp$Intervention=="Household Isolation (when S.I.)"),tv) - tb<-intersect(which(inp$Intervention=="International Travel Ban"),tv) - vc<-intersect(which(inp$Intervention=="Vaccination"),tv) - mt<-intersect(which(inp$Intervention=="Mass Testing"),tv) - minas<-intersect(which(inp$Intervention=="Age Testing Minimum"),tv) - maxas<-intersect(which(inp$Intervention=="Age Testing Maximum"),tv) - vc<-intersect(which(inp$Intervention=="Vaccination"),tv) - minav<-intersect(which(inp$Intervention=="Age Vaccine Minimum"),tv) - - v<-(format(as.POSIXct(inp$`Date Start`,format='%Y/%m/%d %H:%M:%S'),format="%d/%m/%y")) - v2<-as.Date(v,format="%d/%m/%y") - inp$`Date Start`<-v2 - - v<-(format(as.POSIXct(inp$`Date End`,format='%Y/%m/%d %H:%M:%S'),format="%d/%m/%y")) - v2<-as.Date(v,format="%d/%m/%y") - inp$`Date End`<-v2 - - ## self isolation - f<-c() - si_vector<-c() - isolation<-c() - if (length(si)>=1){ - for (i in 1:length(si)){ - f<-c(f,as.numeric(inp$`Date Start`[si[i]]-startdate),as.numeric(inp$`Date End`[si[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[si[i]]>startdate){ - si_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[si[i]],(f[i+1]-f[i])*20)) - isolation<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - si_vector<-c(rep(inp$`Value`[si[i]],(f[i+1])*20)) - isolation<-c(rep(1,(f[i+1])*20)) - } - } - else{ - si_vector<-c(si_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - si_vector<-c(si_vector,rep(inp$`Value`[si[i]],(f[i*2]-f[i*2-1])*20)) - isolation<-c(isolation,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - isolation<-c(isolation,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(si) && f[i*2]=1){ - for (i in 1:length(sd)){ - - f<-c(f,as.numeric(inp$`Date Start`[sd[i]]-startdate),as.numeric(inp$`Date End`[sd[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[sd[i]]>startdate){ - sd_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[sd[i]],(f[i+1]-f[i])*20)) - distancing<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - sd_vector<-c(rep(inp$`Value`[sd[i]],(f[i+1])*20)) - distancing<-c(rep(1,(f[i+1])*20)) - } - } - else{ - sd_vector<-c(sd_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - sd_vector<-c(sd_vector,rep(inp$`Value`[sd[i]],(f[i*2]-f[i*2-1])*20)) - distancing<-c(distancing,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - distancing<-c(distancing,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(sd)&& f[i*2]=1){ - for (i in 1:length(scr)){ - - f<-c(f,as.numeric(inp$`Date Start`[scr[i]]-startdate),as.numeric(inp$`Date End`[scr[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[scr[i]]>startdate){ - scr_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[scr[i]],(f[i+1]-f[i])*20)) - screen<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - scr_vector<-c(rep(inp$`Value`[scr[i]],(f[i+1])*20)) - screen<-c(rep(1,(f[i+1])*20)) - } - } - else{ - scr_vector<-c(scr_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - scr_vector<-c(scr_vector,rep(inp$`Value`[scr[i]],(f[i*2]-f[i*2-1])*20)) - screen<-c(screen,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - screen<-c(screen,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(scr)&& f[i*2]=1){ - for (i in 1:length(hw)){ - - f<-c(f,as.numeric(inp$`Date Start`[hw[i]]-startdate),as.numeric(inp$`Date End`[hw[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[hw[i]]>startdate){ - hw_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[hw[i]],(f[i+1]-f[i])*20)) - handwash<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - hw_vector<-c(rep(inp$`Value`[hw[i]],(f[i+1])*20)) - handwash<-c(rep(1,(f[i+1])*20)) - } - } - else{ - hw_vector<-c(hw_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - hw_vector<-c(hw_vector,rep(inp$`Value`[hw[i]],(f[i*2]-f[i*2-1])*20)) - handwash<-c(handwash,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - handwash<-c(handwash,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(hw)&& f[i*2]=1){ - for (i in 1:length(wah)){ - - f<-c(f,as.numeric(inp$`Date Start`[wah[i]]-startdate),as.numeric(inp$`Date End`[wah[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[wah[i]]>startdate){ - wah_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[wah[i]],(f[i+1]-f[i])*20)) - workhome<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - wah_vector<-c(rep(inp$`Value`[wah[i]],(f[i+1])*20)) - workhome<-c(rep(1,(f[i+1])*20)) - } - } - else{ - wah_vector<-c(wah_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - wah_vector<-c(wah_vector,rep(inp$`Value`[wah[i]],(f[i*2]-f[i*2-1])*20)) - workhome<-c(workhome,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - workhome<-c(workhome,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(wah)&& f[i*2]=1){ - for (i in 1:length(sc)){ - - f<-c(f,as.numeric(inp$`Date Start`[sc[i]]-startdate),as.numeric(inp$`Date End`[sc[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[sc[i]]>startdate){ - sc_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[sc[i]],(f[i+1]-f[i])*20)) - schoolclose<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - sc_vector<-c(rep(inp$`Value`[sc[i]],(f[i+1])*20)) - schoolclose<-c(rep(1,(f[i+1])*20)) - } - } - else{ - sc_vector<-c(sc_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - sc_vector<-c(sc_vector,rep(inp$`Value`[sc[i]],(f[i*2]-f[i*2-1])*20)) - schoolclose<-c(schoolclose,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - schoolclose<-c(schoolclose,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(sc)&& f[i*2]=1){ - for (i in 1:length(cte)){ - - f<-c(f,as.numeric(inp$`Date Start`[cte[i]]-startdate),as.numeric(inp$`Date End`[cte[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[cte[i]]>startdate){ - cte_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[cte[i]],(f[i+1]-f[i])*20)) - cocoon<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - cte_vector<-c(rep(inp$`Value`[cte[i]],(f[i+1])*20)) - cocoon<-c(rep(1,(f[i+1])*20)) - } - } - else{ - cte_vector<-c(cte_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - cte_vector<-c(cte_vector,rep(inp$`Value`[cte[i]],(f[i*2]-f[i*2-1])*20)) - cocoon<-c(cocoon,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - cocoon<-c(cocoon,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(cte)&& f[i*2]=1){ - for (i in 1:length(q)){ - - f<-c(f,as.numeric(inp$`Date Start`[q[i]]-startdate),as.numeric(inp$`Date End`[q[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[q[i]]>startdate){ - q_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[q[i]],(f[i+1]-f[i])*20)) - quarantine<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - q_vector<-c(rep(inp$`Value`[q[i]],(f[i+1])*20)) - quarantine<-c(rep(1,(f[i+1])*20)) - } - } - else{ - q_vector<-c(q_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - q_vector<-c(q_vector,rep(inp$`Value`[q[i]],(f[i*2]-f[i*2-1])*20)) - quarantine<-c(quarantine,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - quarantine<-c(quarantine,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(q)&& f[i*2]=1){ - for (i in 1:length(tb)){ - - f<-c(f,as.numeric(inp$`Date Start`[tb[i]]-startdate),as.numeric(inp$`Date End`[tb[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[tb[i]]>startdate){ - tb_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[tb[i]],(f[i+1]-f[i])*20)) - travelban<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - tb_vector<-c(rep(inp$`Value`[tb[i]],(f[i+1])*20)) - travelban<-c(rep(1,(f[i+1])*20)) - } - } - else{ - tb_vector<-c(tb_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - tb_vector<-c(tb_vector,rep(inp$`Value`[tb[i]],(f[i*2]-f[i*2-1])*20)) - travelban<-c(travelban,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - travelban<-c(travelban,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(tb)&& f[i*2]=1){ - for (i in 1:length(mt)){ - - f<-c(f,as.numeric(inp$`Date Start`[mt[i]]-startdate),as.numeric(inp$`Date End`[mt[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[mt[i]]>startdate){ - mt_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[mt[i]],(f[i+1]-f[i])*20)) - masstesting<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - mt_vector<-c(rep(inp$`Value`[mt[i]],(f[i+1])*20)) - masstesting<-c(rep(1,(f[i+1])*20)) - } - } - else{ - mt_vector<-c(mt_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - mt_vector<-c(mt_vector,rep(inp$`Value`[mt[i]],(f[i*2]-f[i*2-1])*20)) - masstesting<-c(masstesting,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - masstesting<-c(masstesting,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(mt)&& f[i*2]=1){ - for (i in 1:length(minas)){ - f<-c(f,as.numeric(inp$`Date Start`[minas[i]]-startdate),as.numeric(inp$`Date End`[minas[i]]-startdate)) - if(i==1){ - if (inp$`Date Start`[minas[i]]>startdate){ - minas_vector<-c(rep(age_testing_min,f[i]*20),rep(inp$`Value`[minas[i]],(f[i+1]-f[i])*20)) - } - else{ - minas_vector<-c(rep(inp$`Value`[minas[i]],(f[i+1])*20)) - } - } - else{ - minas_vector<-c(minas_vector,rep(age_testing_min,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - minas_vector<-c(minas_vector,rep(inp$`Value`[minas[i]],(f[i*2]-f[i*2-1])*20)) - } - if(i==length(minas)&& f[i*2]=1){ - for (i in 1:length(maxas)){ - f<-c(f,as.numeric(inp$`Date Start`[maxas[i]]-startdate),as.numeric(inp$`Date End`[maxas[i]]-startdate)) - if(i==1){ - if (inp$`Date Start`[maxas[i]]>startdate){ - maxas_vector<-c(rep(age_testing_max,f[i]*20),rep(inp$`Value`[maxas[i]],(f[i+1]-f[i])*20)) - } - else{ - maxas_vector<-c(rep(inp$`Value`[maxas[i]],(f[i+1])*20)) - } - } - else{ - maxas_vector<-c(maxas_vector,rep(age_testing_max,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - maxas_vector<-c(maxas_vector,rep(inp$`Value`[maxas[i]],(f[i*2]-f[i*2-1])*20)) - } - if(i==length(maxas)&& f[i*2]=1){ - for (i in 1:length(vc)){ - - f<-c(f,as.numeric(inp$`Date Start`[vc[i]]-startdate),as.numeric(inp$`Date End`[vc[i]]-startdate)) - - if(i==1){ - if (inp$`Date Start`[vc[i]]>startdate){ - vc_vector<-c(rep(0,f[i]*20),rep(inp$`Value`[vc[i]],(f[i+1]-f[i])*20)) - vaccine<-c(rep(0,f[i]*20),rep(1,(f[i+1]-f[i])*20)) - } - else{ - vc_vector<-c(rep(inp$`Value`[vc[i]],(f[i+1])*20)) - vaccine<-c(rep(1,(f[i+1])*20)) - } - } - else{ - vc_vector<-c(vc_vector,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - vc_vector<-c(vc_vector,rep(inp$`Value`[vc[i]],(f[i*2]-f[i*2-1])*20)) - vaccine<-c(vaccine,rep(0,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - vaccine<-c(vaccine,rep(1,(f[i*2]-f[i*2-1])*20)) - } - if(i==length(vc)&& f[i*2]=1){ - for (i in 1:length(minav)){ - f<-c(f,as.numeric(inp$`Date Start`[minav[i]]-startdate),as.numeric(inp$`Date End`[minav[i]]-startdate)) - if(i==1){ - if (inp$`Date Start`[minav[i]]>startdate){ - minav_vector<-c(rep(age_vaccine_min,f[i]*20),rep(inp$`Value`[minav[i]],(f[i+1]-f[i])*20)) - } - else{ - minav_vector<-c(rep(inp$`Value`[minav[i]],(f[i+1])*20)) - } - } - else{ - minav_vector<-c(minav_vector,rep(age_vaccine_min,(f[(i-1)*2+1]-f[(i-1)*2])*20)) - minav_vector<-c(minav_vector,rep(inp$`Value`[minav[i]],(f[i*2]-f[i*2-1])*20)) - } - if(i==length(minav)&& f[i*2]1){ - ratetestI<-mass_test_sens*testI/sum(I) - # print(paste('rateI: ',ratetestI)) - }else{ratetestI<-0} - if(sum(CL)>1){ - ratetestC<-mass_test_sens*testC/sum(CL) - # print(paste('rateC: ',ratetestC)) - }else{ratetestC<-0} - if(sum(E)>1){ - ratetestE<-mass_test_sens*testE/sum(E) - # print(paste('rateC: ',ratetestC)) - }else{ratetestE<-0} - - # print(mass_test_sens) - # print(ratetestI*sum(I) + ratetestC*sum(CL) - (1/isolation_days)*sum(Z) ) - # print(propC) - # print(testI) - # print(testC) - # - # cocooning the elderly - cocoon_mat<-matrix((1-cocoon_eff),nrow = length(popstruc$pop),ncol = length(popstruc$pop)) - cocoon_mat[1:(age_cocoon-1),1:(age_cocoon-1)]<-1 - - # contact matrices - cts<-(contact_home+distancing*(1-dist)*contact_other+(1-distancing)*contact_other - +(1-schoolclose)*contact_school # school on - +schoolclose*(1-school)*contact_school # school close - +schoolclose*contact_home*school*s2h # inflating contacts at home when school closes - +(1-workhome)*contact_work # normal work - +workhome*(1-work)*contact_work # people not working from home when homework is active - +contact_home*workhome*work*w2h # inflating contacts at home when working from home - ) - - # Final transmission related parameters - contacts <- (1-cocoon)*cts+cocoon*cts*cocoon_mat+cocoon*(1+schoolclose*(1-school_eff)+workhome*(1-work_eff))*contact_home*(1-cocoon_mat) - seas <- 1+amp*cos(2*3.14*(t-(phi*365.25/12))/365.25) - importation <- mean_imports*(1-trvban_eff) - HH<-H+ICU+Vent+ICUC+ICUCV+VentC - HHC<-HC - lam <- (1-hand)*p*seas*(contacts%*%((rho*E+(I+CL+importation)+(1-selfis_eff)*(X+HHC)+rhos*(HH))/P))+ - (1-hand)*p*seas*(1-quarantine*quarantine_eff_other)*(contact_other%*%((rho*QE+QI+QC)/P)) - # contacts under home quarantine - lamq<-(1-hand)*p*seas*((1-quarantine_eff_home)*contact_home%*%(((1-selfis_eff)*(X+HHC+rho*QE+QI+QC))/P))+ - (1-hand)*p*seas*(1-quarantine_eff_other)*(contact_other%*%((rho*E+(I+CL+importation)+(1-selfis_eff)*(X+HHC+rho*QE+QI+QC)+rhos*(HH))/P)) - - # birth/death - b1<-sum(popbirth[,2]*popstruc[,2]) - birth<-0*popbirth[,2] - birth[1]<-b1 - - # ODE system - dSdt <- -S*lam-vaccinate*age_vaccine_vector*S+omega*R+ageing%*%S-mort*S+birth-quarantine_rate*S +(1/quarantine_days)*QS - dEdt <- S*lam-gamma*E+ageing%*%E-mort*E + (1-vaccine_eff)*lam*V-quarantine_rate*E+(1/quarantine_days)*QE - dIdt <- gamma*(1-pclin)*(1-age_testing_vector*ratetestE)*(1-screen_eff)*(1-ihr[,2])*E-nui*I+ageing%*%I-mort*I + (1/quarantine_days)*QI - quarantine_rate*I - ratetestI*age_testing_vector*I - dCLdt<- gamma*pclin*(1-age_testing_vector*ratetestE)*(1-selfis)*(1-ihr[,2])*(1-quarantine_rate)*E-nui*CL+ageing%*%CL-mort*CL + (1/quarantine_days)*QC - ratetestC*age_testing_vector*CL - dRdt <- nui*I-omega*R+nui*X+nui*CL+ageing%*%R-mort*R + (1/isolation_days)*Z+(1/quarantine_days)*QR + nus*(1-pdeath_h*ifr[,2])*H + (1-pdeath_icu*ifr[,2])*nu_icu*ICU + (1-pdeath_icuc*ifr[,2])*nu_icuc*ICUC + (1-pdeath_ventc*ifr[,2])*nu_ventc*ICUCV + (1-pdeath_hc*ifr[,2])*nusc*HC + (1-pdeath_vent*ifr[,2])*nu_vent*Vent+ (1-pdeath_ventc*ifr[,2])*nu_ventc*VentC - dXdt <- gamma*selfis*(1-age_testing_vector*ratetestE)*pclin*(1-ihr[,2])*E+gamma*(1-pclin)*(1-age_testing_vector*ratetestE)*screen_eff*(1-ihr[,2])*E-nui*X+ageing%*%X-mort*X - dVdt <- vaccinate*age_vaccine_vector*S -(1-vaccine_eff)*lam*V +ageing%*%V - mort*V - - dQSdt <- quarantine_rate*S+ ageing%*%QS-mort*QS - (1/quarantine_days)*QS - lamq*QS - dQEdt <- quarantine_rate*E - gamma*QE + ageing%*%QE-mort*QE - (1/quarantine_days)*QE + lamq*QS - dQIdt <- quarantine_rate*I + gamma*(1-ihr[,2])*(1-pclin)*QE-nui*QI+ageing%*%QI-mort*QI - (1/quarantine_days)*QI - dQCdt <- gamma*pclin*(1-selfis)*(1-age_testing_vector*ratetestE)*(1-ihr[,2])*quarantine_rate*E+gamma*(1-ihr[,2])*pclin*QE-nui*QC+ageing%*%QC-mort*QC - (1/quarantine_days)*QC - dQRdt <- nui*QI+nui*QC+ageing%*%QR-mort*QR - (1/quarantine_days)*QR - - dHdt <- gamma*ihr[,2]*(1-prob_icu)*(1-critH)*reporth*E + gamma*ihr[,2]*(1-prob_icu)*(1-critH)*QE - nus*H + ageing%*%H-mort*H - dHCdt <- gamma*ihr[,2]*(1-prob_icu)*(1-critH)*(1-reporth)*E+gamma*ihr[,2]*(1-prob_icu)*critH*E + gamma*ihr[,2]*(1-prob_icu)*critH*QE - nusc*HC + ageing%*%HC-mort*HC - dICUdt <- gamma*ihr[,2]*prob_icu*(1-crit)*(1-prob_vent)*E + gamma*ihr[,2]*prob_icu*(1-crit)*(1-prob_vent)*QE - nu_icu*ICU +ageing%*%ICU - mort*ICU +(1-crit)*ICUC*1/2 - dICUCdt <- gamma*ihr[,2]*prob_icu*crit*(1-prob_vent)*E + gamma*ihr[,2]*prob_icu*crit*(1-prob_vent)*QE - - nu_icuc*ICUC -(1-crit)*ICUC*1/2 +ageing%*%ICUC - mort*ICUC - dICUCVdt <- gamma*ihr[,2]*prob_icu*prob_vent*crit*E +gamma*ihr[,2]*prob_icu*prob_vent*crit*QE -nu_ventc*ICUCV +ageing%*%ICUCV - mort*ICUCV - (1-critV)*ICUCV*1/2 - dVentdt <- gamma*ihr[,2]*prob_icu*(1-crit)*(1-critV)*prob_vent*E + gamma*ihr[,2]*prob_icu*(1-crit)*(1-critV)*prob_vent*QE +(1-critV)*VentC*1/2 +(1-critV)*ICUCV*1/2 -nu_vent*Vent +ageing%*%Vent - mort*Vent - dVentCdt <- gamma*ihr[,2]*prob_icu*prob_vent*(1-crit)*critV*E +gamma*ihr[,2]*prob_icu*prob_vent*(1-crit)*critV*QE - - (1-critV)*VentC*1/2 -nu_ventc*VentC +ageing%*%VentC - mort*VentC - - dCdt <- report*gamma*(1-age_testing_vector*ratetestE)*(1-pclin)*(1-ihr[,2])*(E+QE)+reportc*gamma*pclin*(1-age_testing_vector*ratetestE)*(1-ihr[,2])*(E+QE)+ - gamma*ihr[,2]*(1-critH)*(1-prob_icu)*(E+QE)+gamma*ihr[,2]*critH*reporth*(1-prob_icu)*(E+QE)+ - gamma*ihr[,2]*prob_icu*(E+QE)+ratetestI*age_testing_vector*I+ratetestC*age_testing_vector*CL+gamma*age_testing_vector*ratetestE*(1-ihr[,2])*E - dCMdt<- nus*pdeath_h*ifr[,2]*H + nusc*pdeath_hc*ifr[,2]*HC + nu_icu*pdeath_icu*ifr[,2]*ICU +nu_icuc*pdeath_icuc*ifr[,2]*ICUC +nu_vent*pdeath_vent*ifr[,2]*Vent +nu_ventc*pdeath_ventc*ifr[,2]*VentC +nu_ventc*pdeath_ventc*ifr[,2]*ICUCV+ - mort*H + mort*HC + mort*ICU + mort*ICUC + mort*ICUCV + mort*Vent + mort*VentC + mort*Z - dCMCdt <- nusc*pdeath_hc*ifr[,2]*HC+nu_icuc*pdeath_icuc*ifr[,2]*ICUC + nu_ventc*pdeath_ventc*ifr[,2]*VentC + nu_ventc*pdeath_ventc*ifr[,2]*ICUCV+ - mort*HC + mort*ICUC + mort*VentC + mort*ICUCV - - dZdt <- gamma*ratetestE*age_testing_vector*(1-ihr[,2])*E+ratetestI*age_testing_vector*I+ratetestC*age_testing_vector*CL-(1/isolation_days)*Z-mort*Z - - # return the rate of change - list(c(dSdt,dEdt,dIdt,dRdt,dXdt,dHdt,dHCdt,dCdt,dCMdt,dVdt,dQSdt,dQEdt,dQIdt,dQRdt,dCLdt,dQCdt,dICUdt,dICUCdt,dICUCVdt,dVentdt,dVentCdt,dCMCdt,dZdt)) - } - ) -} - -########### RUN BASELINE MODEL - start time for interventions is set to day 1e5, i.e. interventions are always off - -Y<-c(initS,initE,initI,initR,initX,initH,initHC,initC,initCM,initV, initQS, initQE, initQI, initQR, initCL, initQC, initICU, initICUC, initICUCV, initVent, initVentC, initCMC, initZ) # initial conditions for the main solution vector - - -process_ode_outcome <- function(out, iterations){ - out_min<-out$min - out_max<-out$max - out_mean<-out$mean - - critH<-c() - crit<-c() - critV<-c() - - for (i in 1:length(times)){ - critH[i]<-min(1-fH((sum(out_mean[i,(Hindex+1)]))+sum(out_mean[i,(ICUCindex+1)])+sum(out_mean[i,(ICUCVindex+1)])),1) - crit[i]<-min(1-fICU((sum(out_mean[i,(ICUindex+1)]))+(sum(out_mean[i,(Ventindex+1)]))+(sum(out_mean[i,(VentCindex+1)])))) - critV[i]<-min(1-fVent((sum(out_mean[i,(Ventindex+1)]))),1) - } - - # total population - pop1<-out_mean[,(Sindex+1)]+out_mean[,(Eindex+1)]+out_mean[,(Iindex+1)]+out_mean[,(CLindex+1)]+out_mean[,(Rindex+1)]+out_mean[,(Xindex+1)]+out_mean[,(Vindex+1)]+ - out_mean[,(Zindex+1)]+out_mean[,(QSindex+1)]+out_mean[,(QEindex+1)]+out_mean[,(QIindex+1)]+out_mean[,(QCindex+1)]+out_mean[,(QRindex+1)]+ - out_mean[,(Hindex+1)]+out_mean[,(HCindex+1)]+out_mean[,(ICUindex+1)]+out_mean[,(ICUCindex+1)]+out_mean[,(ICUCVindex+1)]+out_mean[,(Ventindex+1)]+out_mean[,(VentCindex+1)] - tpop1<-rowSums(pop1) - time<-as.Date(out_mean[,1]+startdate) - - dailyinc1<-out$mean_cases # daily incidence - cuminc1<-out$mean_cum_cases # cumulative incidence - previcureq1<-rowSums(out_mean[,(Hindex+1)])+ rowSums(out_mean[,(ICUCindex+1)])+rowSums(out_mean[,(ICUCVindex+1)]) # surge beds occupancy - previcureq21<-rowSums(out_mean[,(ICUindex+1)])+rowSums(out_mean[,(VentCindex+1)]) # icu beds occupancy - previcureq31<-rowSums(out_mean[,(Ventindex+1)]) # ventilator occupancy - cmortality1<-rowSums(out_mean[,(CMindex+1)]) # cumulative mortality - overloadH1<-rowSums(out_mean[,(HCindex+1)]) # requirement for beds - overloadICU1<-rowSums(out_mean[,(ICUCindex+1)]) # requirement for icu beds - overloadICUV1<-rowSums(out_mean[,(ICUCVindex+1)]) # requirement for ventilators - overloadVent1<-rowSums(out_mean[,(VentCindex+1)]) # requirement for ventilators - ccases1<-rowSums(out_mean[,(Cindex+1)]) # cumulative cases - reqsurge1<-rowSums(out_mean[,(Hindex+1)])+overloadH1 - reqicu1<-rowSums(out_mean[,(ICUindex+1)])+overloadICU1 - reqvent1<-rowSums(out_mean[,(Ventindex+1)])+overloadICUV1+overloadVent1 - - - ########################## CALCULATE MORTALITY - pdeath_hc<-parameters["pdeath_hc"] - prob_icu<-parameters["prob_icu"] - prob_vent<-parameters["prob_vent"] - pdeath_icuc<-parameters["pdeath_icuc"] - pdeath_ventc<-parameters["pdeath_ventc"] - - cinc_mort_H1 <- cumsum(rowSums(parameters["nus"]*parameters["pdeath_h"]*(out_mean[,(Hindex+1)]%*%ifr[,2]))) - cinc_mort_HC1 <- cumsum(rowSums(parameters["nusc"]*parameters["pdeath_hc"]*(out_mean[,(HCindex+1)]%*%ifr[,2]))) - cinc_mort_ICU1 <- cumsum(rowSums(parameters["nu_icu"]*parameters["pdeath_icu"]*out_mean[,(ICUindex+1)]%*%ifr[,2])) - cinc_mort_ICUC1 <- cumsum(rowSums(parameters["nu_icuc"]*parameters["pdeath_icuc"]*out_mean[,(ICUCindex+1)]%*%ifr[,2])) - cinc_mort_ICUCV1 <- cumsum(rowSums(parameters["nu_ventc"]*parameters["pdeath_ventc"]*out_mean[,(ICUCVindex+1)]%*%ifr[,2])) - cinc_mort_Vent1 <- cumsum(rowSums(parameters["nu_vent"]*parameters["pdeath_vent"]*out_mean[,(Ventindex+1)]%*%ifr[,2])) - cinc_mort_VentC1 <- cumsum(rowSums(parameters["nu_ventc"]*parameters["pdeath_ventc"]*out_mean[,(VentCindex+1)]%*%ifr[,2])) - base_mort_H1 <- cumsum(rowSums(out_mean[,(Hindex+1)]%*%mort)) - base_mort_HC1 <- cumsum(rowSums(out_mean[,(HCindex+1)]%*%mort)) - base_mort_ICU1 <- cumsum(rowSums(out_mean[,(ICUindex+1)]%*%mort)) - base_mort_ICUC1 <- cumsum(rowSums(out_mean[,(ICUCindex+1)]%*%mort)) - base_mort_ICUCV1 <- cumsum(rowSums(out_mean[,(ICUCVindex+1)]%*%mort)) - base_mort_Vent1 <- cumsum(rowSums(out_mean[,(Ventindex+1)]%*%mort)) - base_mort_VentC1 <- cumsum(rowSums(out_mean[,(VentCindex+1)]%*%mort)) - base_mort_S1 <- cumsum(rowSums(out_mean[,(Sindex+1)]%*%mort)) - base_mort_E1 <- cumsum(rowSums(out_mean[,(Eindex+1)]%*%mort)) - base_mort_I1 <- cumsum(rowSums(out_mean[,(Iindex+1)]%*%mort)) - base_mort_CL1 <- cumsum(rowSums(out_mean[,(CLindex+1)]%*%mort)) - base_mort_X1 <- cumsum(rowSums(out_mean[,(Xindex+1)]%*%mort)) - base_mort_QS1 <- cumsum(rowSums(out_mean[,(QSindex+1)]%*%mort)) - base_mort_QE1 <- cumsum(rowSums(out_mean[,(QEindex+1)]%*%mort)) - base_mort_QI1 <- cumsum(rowSums(out_mean[,(QIindex+1)]%*%mort)) - base_mort_QC1 <- cumsum(rowSums(out_mean[,(QCindex+1)]%*%mort)) - base_mort_QR1 <- cumsum(rowSums(out_mean[,(QRindex+1)]%*%mort)) - base_mort_R1 <- cumsum(rowSums(out_mean[,(Rindex+1)]%*%mort)) - - - # Export in a cohesive format ---- - results <- list() - results$time <- startdate + times # dates - results$Rt <- out$mean_Rt - results$cum_mortality <- round(cmortality1) # cumulative mortality - results$pct_total_pop_infected <- out$mean_infections - results$doubling_time <- round(log(2)*7 / (log(dailyinc1[2+7] / dailyinc1[2])), 2) # (Baseline only) to double the number of infections at inception - results$required_beds <- round(previcureq1) # required beds - results$saturation <- parameters["beds_available"] # saturation - results$daily_incidence <- round(dailyinc1) # daily incidence (Reported) - results$daily_total_cases <- round(out$mean_daily_infection) # daily incidence (Reported + Unreported) # daily incidence (Reported + Unreported) - results$hospital_surge_beds <- round(previcureq1) - results$icu_beds <- round(previcureq21) - results$ventilators <- round(previcureq31) - results$normal_bed_requirement <- round(reqsurge1) #real required beds. previcureq1 above is the occupancy - results$icu_bed_requirement <- round(reqicu1) - results$icu_ventilator_requirement <- round(reqvent1) - - results$death_natural_non_exposed <- round(base_mort_S1) - results$death_natural_exposed <- round(base_mort_E1 + base_mort_I1 + base_mort_CL1 + base_mort_X1 + base_mort_QS1 + - base_mort_QE1 + base_mort_QI1 + base_mort_QC1 + base_mort_QR1 + base_mort_R1+ - base_mort_H1+base_mort_HC1+base_mort_ICU1+base_mort_ICUC1+base_mort_ICUCV1+ - base_mort_Vent1+base_mort_VentC1) - results$death_treated_hospital <- round(cinc_mort_H1) - results$death_treated_icu <- round(cinc_mort_ICU1) - results$death_treated_ventilator <- round(cinc_mort_Vent1) - results$death_untreated_hospital <- round(cinc_mort_HC1) - results$death_untreated_icu <- round(cinc_mort_ICUC1) - results$death_untreated_ventilator <- round(cinc_mort_VentC1)+round(cinc_mort_ICUCV1) - results$attributable_deaths <- results$death_treated_hospital + results$death_treated_icu + results$death_treated_ventilator + - results$death_untreated_hospital + results$death_untreated_icu + results$death_untreated_ventilator - results$attributable_deaths_end <- last(results$attributable_deaths) - results$total_deaths <- results$attributable_deaths + results$death_natural_non_exposed + results$death_natural_exposed - results$total_deaths_end <- last(results$total_deaths) - results$total_reported_deaths_end <- last(results$cum_mortality) - results$base_mort_H <- base_mort_H1 - results$base_mort_HC <- base_mort_HC1 - results$base_mort_ICU <- base_mort_ICU1 - results$base_mort_ICUC <- base_mort_ICUC1 - results$base_mort_ICUCV <- base_mort_ICUCV1 - results$base_mort_Vent <- base_mort_Vent1 - results$base_mort_VentC <- base_mort_VentC1 - results$base_mort_S <- base_mort_S1 - results$base_mort_E <- base_mort_E1 - results$base_mort_I <- base_mort_I1 - results$base_mort_CL <- base_mort_CL1 - results$base_mort_X <- base_mort_X1 - results$base_mort_QS <- base_mort_QS1 - results$base_mort_QE <- base_mort_QE1 - results$base_mort_QI <- base_mort_QI1 - results$base_mort_QC <- base_mort_QC1 - results$base_mort_QR <- base_mort_QR1 - results$base_mort_R <- base_mort_R1 - - ## AGE DEPENDENT MORTALITY - cinc_mort_H1 <- parameters["nus"]*parameters["pdeath_h"]*(out_mean[,(Hindex+1)]) - cinc_mort_HC1 <- parameters["nusc"]*parameters["pdeath_hc"]*(out_mean[,(HCindex+1)]) - cinc_mort_ICU1 <- parameters["nu_icu"]*parameters["pdeath_icu"]*out_mean[,(ICUindex+1)] - cinc_mort_ICUC1 <- parameters["nu_icuc"]*parameters["pdeath_icuc"]*out_mean[,(ICUCindex+1)] - cinc_mort_ICUCV1 <- parameters["nu_ventc"]*parameters["pdeath_ventc"]*out_mean[,(ICUCVindex+1)] - cinc_mort_Vent1 <- parameters["nu_vent"]*parameters["pdeath_vent"]*out_mean[,(Ventindex+1)] - cinc_mort_VentC1 <- parameters["nu_ventc"]*parameters["pdeath_ventc"]*out_mean[,(VentCindex+1)] - totage1<-as.data.frame(cinc_mort_H1+cinc_mort_HC1+cinc_mort_ICU1+cinc_mort_ICUC1+cinc_mort_ICUCV1+cinc_mort_Vent1+cinc_mort_VentC1) - basemort_H1<-(out_mean[,(Hindex+1)]) - basemort_HC1<-(out_mean[,(HCindex+1)]) - basemort_ICU1<-(out_mean[,(ICUindex+1)]) - basemort_ICUC1<-(out_mean[,(ICUCindex+1)]) - basemort_ICUCV1<-(out_mean[,(ICUCVindex+1)]) - basemort_Vent1<-(out_mean[,(Ventindex+1)]) - basemort_VentC1<-(out_mean[,(VentCindex+1)]) - totbase1<-as.data.frame(basemort_H1+basemort_HC1+basemort_ICU1+basemort_ICUC1+basemort_ICUCV1+basemort_Vent1+basemort_VentC1) - tc<-c() - - for (i in 1:dim(cinc_mort_H1)[1]) { - for (j in 1:dim(cinc_mort_H1)[2]) { - tc<-rbind(tc,c(i, j, totage1[i,j]*ifr[j,2]+totbase1[i,j]*mort[j])) - } - } - tc<-as.data.frame(tc) - colnames(tc)<-c("Day","Age","value") - - results$tc <- tc %>% - mutate(Date = startdate + Day, - age_cat = case_when( - Age >= 1 & Age <= 6 ~ "≤ 30 y.o.", - Age > 6 & Age <= 8 ~ "30-40 y.o.", - Age > 8 & Age <= 10 ~ "40-50 y.o.", - Age > 10 & Age <= 12 ~ "50-60 y.o.", - Age > 12 & Age <= 14 ~ "60-70 y.o.", - Age >= 15 ~ "≥ 70 y.o.")) %>% - mutate(age_cat = factor(age_cat, levels = rev(c("≤ 30 y.o.", "30-40 y.o.", - "40-50 y.o.", "50-60 y.o.", "60-70 y.o.", "≥ 70 y.o.")))) - - mortality_lag <- data.frame(Age = popstruc$agefloor) - if(nrow(out_mean) >= 30) mortality_lag <- bind_cols(mortality_lag, - data.frame(day30 = out_mean[30,CMindex+1]/out_mean[30,Cindex+1]) %>% - mutate(day30 = ifelse(is.infinite(day30), 0, day30)) %>% - rename(`Day 30` = day30)) - if(nrow(out_mean) >= 60) mortality_lag <- bind_cols(mortality_lag, - data.frame(day60 = out_mean[60,CMindex+1]/out_mean[60,Cindex+1]) %>% - mutate(day60 = ifelse(is.infinite(day60), 0, day60)) %>% - rename(`Day 60` = day60)) - if(nrow(out_mean) >= 90) mortality_lag <- bind_cols(mortality_lag, - data.frame(day90 = out_mean[90,CMindex+1]/out_mean[90,Cindex+1]) %>% - mutate(day90 = ifelse(is.infinite(day90), 0, day90)) %>% - rename(`Day 90` = day90)) - if(nrow(out_mean) >= 120) mortality_lag <- bind_cols(mortality_lag, - data.frame(day120 = out_mean[120,CMindex+1]/out_mean[120,Cindex+1]) %>% - mutate(day120 = ifelse(is.infinite(day120), 0, day120)) %>% - rename(`Day 120` = day120)) - - results$mortality_lag <- mortality_lag - - - if(iterations>1){ - - previcureq1_max<-rowSums(out_max[,(Hindex+1)])+ rowSums(out_max[,(ICUCindex+1)])+rowSums(out_max[,(ICUCVindex+1)]) # surge beds occupancy - previcureq21_max<-rowSums(out_max[,(ICUindex+1)])+rowSums(out_max[,(VentCindex+1)]) # icu beds occupancy - previcureq31_max<-rowSums(out_max[,(Ventindex+1)]) # ventilator occupancy - cmortality1_max<-rowSums(out_max[,(CMindex+1)]) # cumulative mortality - overloadH1_max<-rowSums(out_max[,(HCindex+1)]) # requirement for beds - overloadICU1_max<-rowSums(out_max[,(ICUCindex+1)]) # requirement for icu beds - overloadICUV1_max<-rowSums(out_max[,(ICUCVindex+1)]) # requirement for ventilators - overloadVent1_max<-rowSums(out_max[,(VentCindex+1)]) # requirement for ventilators - ccases1_max<-rowSums(out_max[,(Cindex+1)]) # cumulative cases - reqsurge1_max<-rowSums(out_max[,(Hindex+1)])+overloadH1 # surge beds total requirements - reqicu1_max<-rowSums(out_max[,(ICUindex+1)])+overloadICU1 # ICU beds total requirements - reqvent1_max<-rowSums(out_max[,(Ventindex+1)])+overloadICUV1+overloadVent1 # ventilator beds total requirements - - previcureq1_min<-rowSums(out_min[,(Hindex+1)])+ rowSums(out_min[,(ICUCindex+1)])+rowSums(out_min[,(ICUCVindex+1)]) # surge beds occupancy - previcureq21_min<-rowSums(out_min[,(ICUindex+1)])+rowSums(out_min[,(VentCindex+1)]) # icu beds occupancy - previcureq31_min<-rowSums(out_min[,(Ventindex+1)]) # ventilator occupancy - cmortality1_min<-rowSums(out_min[,(CMindex+1)]) # cumulative mortality - overloadH1_min<-rowSums(out_min[,(HCindex+1)]) # requirement for beds - overloadICU1_min<-rowSums(out_min[,(ICUCindex+1)]) # requirement for icu beds - overloadICUV1_min<-rowSums(out_min[,(ICUCVindex+1)]) # requirement for ventilators - overloadVent1_min<-rowSums(out_min[,(VentCindex+1)]) # requirement for ventilators - ccases1_min<-rowSums(out_min[,(Cindex+1)]) # cumulative cases - reqsurge1_min<-rowSums(out_min[,(Hindex+1)])+overloadH1 # surge beds total requirements - reqicu1_min<-rowSums(out_min[,(ICUindex+1)])+overloadICU1 # ICU beds total requirements - reqvent1_min<-rowSums(out_min[,(Ventindex+1)])+overloadICUV1+overloadVent1 # ventilator beds total requirements - - results$Rt_max <- out$max_Rt - results$Rt_min <- out$min_Rt - - results$daily_incidence_max <- out$max_cases - results$daily_incidence_min <- out$min_cases - - results$daily_total_cases_max <- out$max_daily_infection - results$daily_total_cases_min <- out$min_daily_infection - - results$total_reported_deaths_end_min <- last(cmortality1_min) - results$total_reported_deaths_end_max <- last(cmortality1_max) - - results$pct_total_pop_infected_min <- out$min_infections # proportion of the population that has been infected at the end of the simulation - results$pct_total_pop_infected_max <- out$max_infections # proportion of the population that has been infected at the end of the simulation - } - return(results) -} - -# covidOdeCpp_reset() -# out <- ode(y = Y, times = times, func = covidOdeCpp, parms = parameters, -# input=vectors, A=A, -# contact_home=contact_home, contact_school=contact_school, -# contact_work=contact_work, contact_other=contact_other, -# popbirth_col2=popbirth[,2], popstruc_col2=popstruc[,2], -# ageing=ageing, -# ifr_col2=ifr[,2], ihr_col2=ihr[,2], mort_col=mort) - -multi_runs<-function(Y,times,parameters,input,iterations,noise,confidence){ - - results <- list() - aux<-array(0, dim=c(length(times),23*A+1,iterations)) - results$mean<-matrix(0,nrow = length(times),ncol = 23*A+1) - results$min<-matrix(0,nrow = length(times),ncol = 23*A+1) - results$max<-matrix(0,nrow = length(times),ncol = 23*A+1) - results$mean_cases<-matrix(0,nrow = length(times),ncol = 23*A+1) - results$min_cases<-matrix(0,nrow = length(times),ncol = 23*A+1) - results$max_cases<-matrix(0,nrow = length(times),ncol = 23*A+1) - results$mean_cum_cases<-matrix(0,nrow = length(times),ncol = 1) - results$min_cum_cases<-matrix(0,nrow = length(times),ncol = 1) - results$max_cum_cases<-matrix(0,nrow = length(times),ncol = 1) - results$mean_daily_infection<-matrix(0,nrow = length(times),ncol = 1) - results$min_daily_infection<-matrix(0,nrow = length(times),ncol = 1) - results$max_daily_infection<-matrix(0,nrow = length(times),ncol = 1) - cases<-matrix(0, nrow=length(times),ncol=iterations) - cum_cases<-matrix(0, nrow=length(times),ncol=iterations) - day_infections<-matrix(0, nrow=length(times),ncol=iterations) - Rt_aux<-matrix(0, nrow=length(times),ncol=iterations) - infections<-matrix(0, nrow=iterations,ncol=1) - Rt <- NULL - - param_vector<-parameters - if(iterations>1){ - for (i in 1:iterations){ - param_vector[parameters_noise]<-parameters[parameters_noise]+rnorm(length(parameters_noise),mean=0,sd=noise*abs(parameters[parameters_noise])) - out0 <- ode(y = Y, times = times, method = "euler", hini = 0.05, func = covid, parms = param_vector, input=input) - aux[,,i]<-out0 - - critH<-c() - crit<-c() - critV<-c() - for (ii in 1:length(times)){ - critH[ii]<-min(1-fH((sum(out0[ii,(Hindex+1)]))+sum(out0[ii,(ICUCindex+1)])+sum(out0[ii,(ICUCVindex+1)])),1) - crit[ii]<-min(1-fICU((sum(out0[ii,(ICUindex+1)]))+(sum(out0[ii,(Ventindex+1)]))+(sum(out0[ii,(VentCindex+1)])))) - critV[ii]<-min(1-fVent((sum(out0[ii,(Ventindex+1)]))),1) - } - - # daily incidence - incidence<-param_vector["report"]*param_vector["gamma"]*(1-param_vector["pclin"])*out0[,(Eindex+1)]%*%(1-ihr[,2])+ - param_vector["reportc"]*param_vector["gamma"]*param_vector["pclin"]*out0[,(Eindex+1)]%*%(1-ihr[,2])+ - param_vector["report"]*param_vector["gamma"]*(1-param_vector["pclin"])*out0[,(QEindex+1)]%*%(1-ihr[,2])+ - param_vector["reportc"]*param_vector["gamma"]*param_vector["pclin"]*out0[,(QEindex+1)]%*%(1-ihr[,2]) - - incidenceh<- param_vector["gamma"]*out0[,(Eindex+1)]%*%ihr[,2]*(1-critH)*(1-param_vector["prob_icu"])*param_vector["reporth"]+ - param_vector["gamma"]*out0[,(Eindex+1)]%*%ihr[,2]*(1-critH)*(1-param_vector["prob_icu"])*(1-param_vector["reporth"])+ - param_vector["gamma"]*out0[,(QEindex+1)]%*%ihr[,2]*(1-critH)*(1-param_vector["prob_icu"])+ - param_vector["gamma"]*out0[,(Eindex+1)]%*%ihr[,2]*critH*param_vector["reporth"]*(1-param_vector["prob_icu"])+ - param_vector["gamma"]*out0[,(QEindex+1)]%*%ihr[,2]*critH*param_vector["reporth"]*(1-param_vector["prob_icu"])+ - param_vector["gamma"]*out0[,(Eindex+1)]%*%ihr[,2]*param_vector["prob_icu"]+ - param_vector["gamma"]*out0[,(QEindex+1)]%*%ihr[,2]*param_vector["prob_icu"] - - cases[,i]<-(rowSums(incidence)+rowSums(incidenceh)) # daily incidence cases - cum_cases[,i]<-colSums(incidence)+colSums(incidenceh) # cumulative incidence cases - day_infections[,i]<- round(rowSums(param_vector["gamma"]*out0[,(Eindex+1)]+param_vector["gamma"]*out0[,(QEindex+1)])) - - # daily infections - infections[i] <- round(100*tail(cumsum(rowSums(param_vector["gamma"]*out0[,(Eindex+1)])),1)/sum(popstruc[,2]), 1) # proportion of the population that has been infected at the end of the simulation - for (w in (ceiling(1/param_vector["nui"])+1):length(times)){ - Rt_aux[w,i]<-cumsum(sum(param_vector["gamma"]*out0[w,(Eindex+1)]))/cumsum(sum(param_vector["gamma"]*out0[(w-1/param_vector["nui"]),(Eindex+1)])) - if(Rt_aux[w,i] >= 7) {Rt_aux[w,i] <- NA} - } - } - qq <- quantile(infections, c(confidence, 0.5, (1-confidence))) - results$mean_infections<-qq[2] - results$min_infections<-qq[1] - results$max_infections<-qq[3] - - for(i in 1:length(out0[,1])){ - qq <- quantile(cases[i,], c(confidence, 0.5, (1-confidence))) - results$mean_cases[i]<-qq[2] - results$min_cases[i]<-qq[1] - results$max_cases[i]<-qq[3] - - qq <- quantile(cum_cases[i,], c(confidence, 0.5, (1-confidence))) - results$mean_cum_cases[i]<-qq[2] - results$min_cum_cases[i]<-qq[1] - results$max_cum_cases[i]<-qq[3] - - qq <- quantile(day_infections[i,], c(confidence, 0.5, (1-confidence))) - results$mean_daily_infection[i]<-qq[2] - results$min_daily_infection[i]<-qq[1] - results$max_daily_infection[i]<-qq[3] - - qq <- quantile(Rt_aux[i,], c(confidence, 0.5, (1-confidence)),na.rm = T) - results$mean_Rt[i]<-qq[2] - results$min_Rt[i]<-qq[1] - results$max_Rt[i]<-qq[3] - - for (j in 1:length(out0[1,])){ - qq <- quantile(aux[i,j,], c(confidence, 0.5, (1-confidence))) - results$mean[i,j]<-qq[2] - results$min[i,j]<-qq[1] - results$max[i,j]<-qq[3] - } - } - }else{ - results$mean <- ode(y = Y, times = times, method = "euler", hini = 0.05, func = covid, parms = parameters, input=vectors0) - } - return(results) -} -out0 <-multi_runs(Y, times, parameters, vectors0, iterations, noise, confidence) -out0$min_infections -out0$max_infections - -plot(times,rowSums(out0$mean[,Iindex+1]),type = 'l') -polygon(c(times, rev(times)), c(rowSums(out0$max[,Iindex+1]), rev(rowSums(out0$min[,Iindex+1]))), - col=rgb(0, 0, 0,0.25), border = NA) - -plot(times,out0$mean_Rt,type = 'l') -polygon(c(times, rev(times)), c(out0$max_Rt, rev(out0$min_Rt)), - col=rgb(0, 0, 0,0.25), border = NA) - - -# out0 <- ode(y = Y, times = times, method = "euler", hini = 0.05, func = covid, parms = parameters, input=vectors0) -# out <- ode(y = Y, times = times, method = "euler", hini = 0.05, func = covid, parms = parameters, input=vectors) - -simul_baseline <- process_ode_outcome(out0,iterations) -# # write.csv(simul_baseline, paste0(hilo,"_baseline_",gsub(":|-","",Sys.time()),".csv")) -# -#future interventions -#extend travel ban, quarantine, hand washing, cocooning the elderly until 1st July -out <-multi_runs(Y, times, parameters, vectors, iterations, noise, confidence) -simul_interventions <- process_ode_outcome(out,iterations) -# write.csv(simul_interventions, paste0(hilo,"_futureIntv_",gsub(":|-","",Sys.time()),".csv")) - -pop1<-out$mean[,(Sindex+1)]+out$mean[,(Eindex+1)]+out$mean[,(Iindex+1)]+out$mean[,(CLindex+1)]+out$mean[,(Rindex+1)]+out$mean[,(Xindex+1)]+out$mean[,(Vindex+1)]+ - out$mean[,(Zindex+1)]+out$mean[,(QSindex+1)]+out$mean[,(QEindex+1)]+out$mean[,(QIindex+1)]+out$mean[,(QCindex+1)]+out$mean[,(QRindex+1)]+ - out$mean[,(Hindex+1)]+out$mean[,(HCindex+1)]+out$mean[,(ICUindex+1)]+out$mean[,(ICUCindex+1)]+out$mean[,(ICUCVindex+1)]+out$mean[,(Ventindex+1)]+out$mean[,(VentCindex+1)] -tpop1<-rowSums(pop1) - -############# PLOTTING -# Fitting tab -# fitting the intervention lines to the data to account for any historical interventions -time<-as.Date(out0$mean[,1]+startdate) -par(mfrow=c(1,2)) -# set up the axis limits -xmin<-min(as.Date(cases_rv[,1])) -xmax<-max(as.Date(cases_rv[,1])) -ymax<-max(cases_rv[,2],na.rm = T) -xtick<-seq(xmin, xmax, by=7) -plot(time,simul_interventions$daily_incidence,type='l',lwd=3, - main="New Reported Cases", xlab="Date", ylab="Cases per day", - xlim=c(xmin,xmax), ylim=c(0,ymax), col='blue',xaxt="n") -axis(side=1, labels = FALSE) -text(x=xtick, y=-250, labels = format(xtick,"%b-%d"), srt = 0, xpd = TRUE) -points(as.Date(cases_rv[,1]),cases_rv[,2],pch=19,col='red') - -# reset the maximum to the cumulative mortality -ymax<-max(cases_rv[,3],na.rm = T) -plot(time,simul_interventions$cum_mortality,type='l',lwd=3, - main="Cumulative Mortality", xlab="Date", ylab="Total deaths", - xlim=c(xmin,xmax), ylim=c(0,ymax), col='blue',xaxt="n") -text(x=xtick, y=-100, labels = format(xtick,"%b-%d"), srt = 0, xpd = TRUE) -points(as.Date(cases_rv[,1]),cases_rv[,3],pch=19,col='red') - - -### Predictions tab -par(mfrow=c(1,2)) -### Cases at baseline and intervention -ymax<-max(c(cases_rv[,2],simul_baseline$daily_incidence,simul_interventions$daily_incidence),na.rm=T) -plot(time,simul_baseline$daily_incidence,type='l',lwd=3,col='blue', - main="Baseline", xlab="Date", ylab="New cases per day",ylim=c(0,ymax)) -points(as.Date(cases_rv[,1]),cases_rv[,2],pch=19,col='red') -plot(time,simul_interventions$daily_incidence,type='l',lwd=3,col='blue', - main="Intervention", xlab="Date", ylab="New cases per day",ylim=c(0,ymax)) -points(as.Date(cases_rv[,1]),cases_rv[,2],pch=19,col='red') - - - -# # # Hospital prevalences stratified by H,ICU and Vent -ymax<-max(c((simul_baseline$hospital_surge_beds+simul_baseline$icu_beds+simul_baseline$ventilators),(simul_interventions$hospital_surge_beds+simul_interventions$icu_beds+simul_interventions$ventilators))) -time<-as.Date(out0$mean[,1]+startdate) -coul=c("#047883", "#24A9E2","#051A46") -DM<-as.data.frame(cbind(time,simul_baseline$hospital_surge_beds,simul_baseline$icu_beds,simul_baseline$ventilators)) -colnames(DM)<-c("Time","Hospital surge beds","ICU beds","Ventilators") -DM$Time<-as.Date(DM$Time,origin = "1970-01-01") -DMF<-melt(DM, id.vars="Time",measure.vars = c("Hospital surge beds","ICU beds","Ventilators")) -d0<-ggplot(DMF, aes(x = Time, y = value,fill=variable)) + - geom_area()+ - scale_fill_manual(values=coul) - -DM<-as.data.frame(cbind(time,simul_interventions$hospital_surge_beds,simul_interventions$icu_beds,simul_interventions$ventilators)) -colnames(DM)<-c("Time","Hospital surge beds","ICU beds","Ventilators") -DM$Time<-as.Date(DM$Time, origin = "1970-01-01") -DMF<-melt(DM, id.vars="Time",measure.vars = c("Hospital surge beds","ICU beds","Ventilators")) -d1<-ggplot(DMF, aes(x = Time, y = value,fill=variable)) + - geom_area()+ - scale_fill_manual(values=coul) - -grid.arrange(d0+ylab("Number of Patients")+ - ggtitle("Baseline")+ - ylim(0, ymax)+ - geom_hline(yintercept=(parameters["beds_available"]+parameters["icu_beds_available"]+parameters["ventilators_available"]), linetype="dashed", color = "#047883")+ - geom_hline(yintercept=(parameters["icu_beds_available"]+parameters["ventilators_available"]), linetype="dashed", color = "#24A9E2")+ - geom_hline(yintercept=parameters["ventilators_available"], linetype="dashed", color = "#051A46")+ - theme_bw(), - d1+ylab("Number of Patients")+ - ggtitle("Intervention")+ - ylim(0, ymax)+ - geom_hline(yintercept=(parameters["beds_available"]+parameters["icu_beds_available"]+parameters["ventilators_available"]), linetype="dashed", color = "#047883")+ - geom_hline(yintercept=(parameters["icu_beds_available"]+parameters["ventilators_available"]), linetype="dashed", color = "#24A9E2")+ - geom_hline(yintercept=parameters["ventilators_available"], linetype="dashed", color = "#051A46")+ - theme_bw(), - nrow = 1) - - -# # # Cumulative mortality at baseline and intervention stratified by hospital status -ymax<-max(c((simul_baseline$total_deaths),(simul_interventions$total_deaths))) -time<-as.Date(out$mean[,1]+startdate) -coul=c("#047883", "#24A9E2","#051A46","#E68029", "#D63304","#D1D604") -DM0<-as.data.frame(cbind(time,simul_baseline$base_mort_I+simul_baseline$base_mort_QI, - simul_baseline$base_mort_CL+simul_baseline$base_mort_QC, - simul_baseline$base_mort_X, - simul_baseline$base_mort_S+simul_baseline$base_mort_QS, - simul_baseline$base_mort_E+simul_baseline$base_mort_QE, - simul_baseline$base_mort_QR+simul_baseline$base_mort_R, - simul_baseline$death_treated_hospital, - simul_baseline$death_treated_icu, - simul_baseline$death_treated_ventilator, - simul_baseline$death_untreated_hospital, - simul_baseline$death_untreated_icu, - simul_baseline$death_untreated_ventilator)) -colnames(DM0)<-c("Time","Asymptomatic","Clnical","Self-Isolating","Susceptible","Exposed","Recovered", - "Treated: Hospital","Treated: ICU","Treated: Ventilator","Untreated: Hospital","Untreated: ICU","Untreated: Ventilator") -DM0$Time<-as.Date(DM0$Time, origin = "1970-01-01") -DMF0<-melt(DM0, id.vars="Time",measure.vars = c("Asymptomatic","Clnical","Self-Isolating","Susceptible","Exposed","Recovered", - "Treated: Hospital","Treated: ICU","Treated: Ventilator","Untreated: Hospital","Untreated: ICU","Untreated: Ventilator")) -m0<-ggplot(DMF0, aes(x = Time, y = value,fill=variable)) + - geom_area() - -DM<-as.data.frame(cbind(time,simul_interventions$base_mort_I+simul_interventions$base_mort_QI,simul_interventions$base_mort_CL+simul_interventions$base_mort_QC,simul_interventions$base_mort_X,simul_interventions$base_mort_S+ - simul_interventions$base_mort_QS,simul_interventions$base_mort_E+simul_interventions$base_mort_QE,simul_interventions$base_mort_QR+simul_interventions$base_mort_R, - simul_interventions$death_treated_hospital,simul_interventions$death_treated_icu,simul_interventions$death_treated_ventilator,simul_interventions$death_untreated_hospital,simul_interventions$death_untreated_icu,simul_interventions$death_untreated_ventilator)) -colnames(DM)<-c("Time","Asymptomatic","Clnical","Self-Isolating","Susceptible","Exposed","Recovered", - "Treated: Hospital","Treated: ICU","Treated: Ventilator","Untreated: Hospital","Untreated: ICU","Untreated: Ventilator") -DM$Time<-as.Date(DM$Time, origin = "1970-01-01") -DMF<-melt(DM, id.vars="Time",measure.vars = c("Asymptomatic","Clnical","Self-Isolating","Susceptible","Exposed","Recovered", - "Treated: Hospital","Treated: ICU","Treated: Ventilator","Untreated: Hospital","Untreated: ICU","Untreated: Ventilator")) -m1<-ggplot(DMF, aes(x = Time, y = value,fill=variable)) + - geom_area() -grid.arrange(m0+ylab("Cumulatice mortality")+ - ggtitle("Baseline")+ - ylim(0, ymax), - m1+ylab("Cumulatice mortality")+ - ggtitle("Intervention")+ - ylim(0, ymax), - nrow = 1) - - - -# Estimated basic reproduction number, R_t -par(mfrow=c(1,2)) -ymax<-max(c(simul_baseline$Rt[!is.na(simul_baseline$Rt)],simul_interventions$Rt[!is.na(simul_interventions$Rt)])) -plot(time,simul_baseline$Rt,type='l',lwd=3,col='black', - main="Baseline", xlab="Date", ylab="Reproduction number",ylim=c(0,ymax)) -lines(time,simul_baseline$Rt/simul_baseline$Rt,lwd=2,col='grey') -plot(time,simul_interventions$Rt,type='l',lwd=3,col='black', - main="Intervention", xlab="Date", ylab="Reproduction number",ylim=c(0,ymax)) -lines(time,simul_interventions$Rt/simul_interventions$Rt,lwd=2,col='grey') - - -# ## Predicted ifr -# ymax=max(c(simul_baseline$MORT1$value,simul_interventions$MORT1$value)) -# gm<-ggplot(data=simul_interventions$MORT1,aes(x=Age,y=value,fill=variable))+ -# geom_line(data=simul_interventions$MORT1,aes(x=Age,y=value,colour=variable),lwd=1.5)+ylim(0,ymax)+ylab("Mortality") -# gm0<-ggplot(data=simul_baseline$MORT1,aes(x=Age,y=value,fill=variable))+ -# geom_line(data=simul_baseline$MORT1,aes(x=Age,y=value,colour=variable),lwd=1.5)+ylim(0,ymax)+ylab("Mortality") -# -# grid.arrange(gm+theme_classic(), -# gm0+theme_classic(), -# nrow=1) - - -# ## AGE DEPENDENT MORTALITY -# cinc_mort_H1 <- parameters["nus"]*parameters["pdeath_h"]*(out$mean[,(Hindex+1)]) -# cinc_mort_HC1 <- parameters["nusc"]*parameters["pdeath_hc"]*(out$mean[,(HCindex+1)]) -# cinc_mort_ICU1 <- parameters["nu_icu"]*parameters["pdeath_icu"]*out$mean[,(ICUindex+1)] -# cinc_mort_ICUC1 <- parameters["nu_icuc"]*parameters["pdeath_icuc"]*out$mean[,(ICUCindex+1)] -# cinc_mort_Vent1 <- parameters["nu_vent"]*parameters["pdeath_vent"]*out$mean[,(Ventindex+1)] -# cinc_mort_VentC1 <- parameters["nu_ventc"]*parameters["pdeath_ventc"]*out$mean[,(VentCindex+1)] -# totage1<-as.data.frame(cinc_mort_H1+cinc_mort_HC1+cinc_mort_ICU1+cinc_mort_ICUC1+cinc_mort_Vent1+cinc_mort_VentC1) -# basemort_H1<-(out$mean[,(Hindex+1)]) -# basemort_HC1<-(out$mean[,(HCindex+1)]) -# basemort_ICU1<-(out$mean[,(ICUindex+1)]) -# basemort_ICUC1<-(out$mean[,(ICUCindex+1)]) -# basemort_Vent1<-(out$mean[,(Ventindex+1)]) -# basemort_VentC1<-(out$mean[,(VentCindex+1)]) -# totbase1<-as.data.frame(basemort_H1+basemort_HC1+basemort_ICU1+basemort_ICUC1+basemort_Vent1+basemort_VentC1) -# tc<-c() -# ages<-seq(0,100,by=5) -# for (i in 1:dim(cinc_mort_H1)[1]) { -# for (j in 1:dim(cinc_mort_H1)[2]) { -# tc<-rbind(tc,c(i,ages[j],totage1[i,j]*ifr[j,2]+totbase1[i,j]*mort[j])) -# } -# } -# tc<-as.data.frame(tc) -# colnames(tc)<-c("Day","Age","value") -# tc$Age<-as.factor(tc$Age) -# p6<-ggplot(data=tc, aes(x=Day,y=value,fill=Age))+ -# geom_bar(stat = "identity",position="fill", width=1)+ -# ylab("Proportion of deaths") -# -# inc_mort_H0 <- parameters["nus"]*parameters["pdeath_h"]*(out0$mean[,(Hindex+1)]) -# inc_mort_HC0 <- parameters["nusc"]*parameters["pdeath_hc"]*(out0$mean[,(HCindex+1)]) -# inc_mort_ICU0 <- parameters["nu_icu"]*parameters["pdeath_icu"]*out0$mean[,(ICUindex+1)] -# inc_mort_ICUC0 <- parameters["nu_icuc"]*parameters["pdeath_icuc"]*out0$mean[,(ICUCindex+1)] -# inc_mort_Vent0 <- parameters["nu_vent"]*parameters["pdeath_vent"]*out0$mean[,(Ventindex+1)] -# inc_mort_VentC0 <- parameters["nu_ventc"]*parameters["pdeath_ventc"]*out0$mean[,(VentCindex+1)] -# totage0<-as.data.frame(inc_mort_H0+inc_mort_HC0+inc_mort_ICU0+inc_mort_ICUC0+inc_mort_Vent0+inc_mort_VentC0) -# basemort_H0<-(out0$mean[,(Hindex+1)]) -# basemort_HC0<-(out0$mean[,(HCindex+1)]) -# basemort_ICU0<-(out0$mean[,(ICUindex+1)]) -# basemort_ICUC0<-(out0$mean[,(ICUCindex+1)]) -# basemort_Vent0<-(out0$mean[,(Ventindex+1)]) -# basemort_VentC0<-(out0$mean[,(VentCindex+1)]) -# totbase0<-as.data.frame(basemort_H0+basemort_HC0+basemort_ICU0+basemort_ICUC0+basemort_Vent0+basemort_VentC0) -# tc0<-c() -# for (i in 1:dim(cinc_mort_H1)[1]) { -# for (j in 1:dim(cinc_mort_H1)[2]) { -# tc0<-rbind(tc0,c(i,ages[j],totage0[i,j]*ifr[j,2]+totbase0[i,j]*mort[j])) -# } -# } -# tc0<-as.data.frame(tc0) -# colnames(tc0)<-c("Day","Age","value") -# tc0$Age<-as.factor(tc0$Age) -# p16<-ggplot(data=tc0, aes(x=Day,y=value,fill=Age))+ -# geom_bar(stat = "identity",position="fill", width=1)+ylab("Proportion of deaths") - -# grid.arrange(p16+theme_minimal(), -# p6+theme_minimal(), -# nrow=1) -# - - -# -# -# -# ######################################################################################################################### -# ##### SUMMARY METRICS ################################################################################################ -# ####################################################################################################################### -# -infected0<-tail((rowSums(out0$mean[,(Rindex+1)])),1)/sum(popstruc[,2]) -infected0 -infected1<-tail((rowSums(out$mean[,(Rindex+1)])),1)/sum(popstruc[,2]) -infected1 - -# # #Population size checks -# # tpop1 -# # tpop0 -# -# # PCR -# time_of_measurement<-40:49 -# # general population -# (rowSums(out$mean[time_of_measurement,Iindex+1])+rowSums(out$mean[time_of_measurement,CLindex+1])+rowSums(out$mean[time_of_measurement,QIindex+1])+ -# rowSums(out$mean[time_of_measurement,QCindex+1]))/sum(popstruc[,2]) -# # every infection including hospital infections -# (rowSums(out$mean[time_of_measurement,Iindex+1])+rowSums(out$mean[time_of_measurement,CLindex+1])+rowSums(out$mean[time_of_measurement,Hindex+1])+ -# rowSums(out$mean[time_of_measurement,ICUindex+1])+rowSums(out$mean[time_of_measurement,Ventindex+1])+rowSums(out$mean[time_of_measurement,HCindex+1])+ -# rowSums(out$mean[time_of_measurement,ICUCindex+1])+rowSums(out$mean[time_of_measurement,VentCindex+1])+rowSums(out$mean[time_of_measurement,QIindex+1])+ -# rowSums(out$mean[time_of_measurement,QCindex+1]))/sum(popstruc[,2]) -# -# SEROLOGY -tail((rowSums(out$mean[,(Rindex+1)])),1)/sum(popstruc[,2]) - -# IHR -sum(ihr$severe*popstruc[,2]/sum(popstruc[,2])) - - -# # PORPORTIONAL MORTALITY IN THE ELDEST -# m30<-out0$mean[30,CMindex+1]/(out0$mean[30,Cindex+1]) -# m30[is.infinite(m30)]<-0 -# m60<-out0$mean[60,CMindex+1]/out0$mean[60,Cindex+1] -# m60[is.infinite(m60)]<-0 -# m90<-out0$mean[90,CMindex+1]/out0$mean[90,Cindex+1] -# m90[is.infinite(m90)]<-0 -# m120<-out0$mean[120,CMindex+1]/out0$mean[120,Cindex+1] -# m120[is.infinite(m120)]<-0 -# -# ifr30<-sum(m30*popstruc[,2]/sum(popstruc[,2]),na.rm = T) -# ifr60<-sum(m60*popstruc[,2]/sum(popstruc[,2]),na.rm = T) -# ifr90<-sum(m90*popstruc[,2]/sum(popstruc[,2]),na.rm = T) -# ifr120<-sum(m120*popstruc[,2]/sum(popstruc[,2]),na.rm = T) -# cbind(ifr30,ifr60,ifr90,ifr120)*100 -# -# PMORTDF0<-as.data.frame(cbind(out0$mean[30,CMindex+1]/sum(out0$mean[30,CMindex+1]),out0$mean[60,CMindex+1]/sum(out0$mean[60,CMindex+1]), -# out0$mean[90,CMindex+1]/sum(out0$mean[90,CMindex+1]),out0$mean[120,CMindex+1]/sum(out0$mean[120,CMindex+1]))) -# PMORTDF<-as.data.frame(cbind(out$mean[30,CMindex+1]/sum(out$mean[30,CMindex+1]),out$mean[60,CMindex+1]/sum(out$mean[60,CMindex+1]), -# out$mean[90,CMindex+1]/sum(out$mean[90,CMindex+1]),out$mean[120,CMindex+1]/sum(out$mean[120,CMindex+1]))) -# sum(PMORTDF0$V2[15:21]) -# sum(PMORTDF$V2[15:21]) - - -# output doubling time over time first 7 days -# dd<-7 -# doub0<-log(2)*dd/(log(dailyinc0[2+dd]/dailyinc0[2])) -# doub0 -# -# -# - -