Merge pull request #6 from bogaotory/dev

v16.2.1

.gitignore

@@ -8,4 +8,5 @@
 *.o
 *.so
 *.Rcheck
-temp_out/
+temp_out/
+r_versions/

.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")

.travis.yml

@@ -2,19 +2,21 @@ language: r
 r: 3.6.3
 
 cache: packages
+warnings_are_errors: false
 
 r_packages:
   - covr
+  - lintr
 
 before_install:
   - cd comoOdeCpp
 
 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()'

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)
 
 

comoOdeCpp/DESCRIPTION

@@ -1,19 +1,19 @@
 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 <bo.gao@ndm.ox.ac.uk>
 Description: Cpp version of CoMo Consortium's COVID-19 transmission model
 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

comoOdeCpp/NAMESPACE

@@ -1,5 +1,5 @@
 importFrom(stats, splinefun)
 importFrom(Rcpp, evalCpp)
+importFrom(dplyr, arrange)
 useDynLib(comoOdeCpp, .registration=TRUE)
 exportPattern("^[[:alpha:]]+")
-

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)
+}

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
+  )
+}