Merge pull request #22 from seroanalytics/seriestype

add time series type
seroanalytics · Dec 11, 2024 · 7f44d11 · 7f44d11
2 parents 14b0afb + ec3b4ec
commit 7f44d11
Show file tree

Hide file tree

Showing 5 changed files with 39 additions and 8 deletions.
diff --git a/R/api.R b/R/api.R
@@ -13,6 +13,7 @@ target_post_dataset <- function(req, res) {
   logger::log_info("Parsing multipart form request")
   parsed <- mime::parse_multipart(req)
   xcol <- get_xcol(parsed)
+  series_type <- parsed$series_type
   name <- get_dataset_name(parsed)
   if (is.null(parsed$file$type) || parsed$file$type != "text/csv") {
     return(invalid_file_type(res))
@@ -35,17 +36,18 @@ target_post_dataset <- function(req, res) {
   }
 
   logger::log_info(paste("Saving dataset", name, "to disk"))
-  save_dataset(path, file_body, xcol)
+  save_dataset(path, file_body, xcol, series_type)
 
   response_success(jsonlite::unbox(name))
 }
 
-save_dataset <- function(path, file_body, xcol) {
+save_dataset <- function(path, file_body, xcol, series_type) {
   xtype <- get_xtype(file_body[, xcol])
   dir.create(path, recursive = TRUE)
   utils::write.csv(file_body, file.path(path, "data"), row.names = FALSE)
   write(xcol, file.path(path, "xcol"))
   write(xtype, file.path(path, "xtype"))
+  write(series_type, file.path(path, "series_type"))
 }
 
 get_parsed_values <- function(raw_values) {
@@ -111,6 +113,7 @@ target_get_dataset <- function(name, req) {
   logger::log_info(paste("Found dataset:", name))
   dat <- dataset$data
   xcol <- dataset$xcol
+  series_type <- dataset$series_type
   cols <- setdiff(colnames(dat), c("value", "biomarker", xcol))
   if (length(cols) == 0) {
     logger::log_info("No covariates detected")
@@ -128,7 +131,8 @@ target_get_dataset <- function(name, req) {
   }
   list(variables = unname(variables),
        biomarkers = biomarkers,
-       xcol = jsonlite::unbox(xcol))
+       xcol = jsonlite::unbox(xcol),
+       type = jsonlite::unbox(series_type))
 }
 
 target_get_datasets <- function(req) {
@@ -293,11 +297,12 @@ read_dataset <- function(req, name, scale) {
   }
   xcol <- readLines(file.path(path, "xcol"))
   xtype <- readLines(file.path(path, "xtype"))
+  series_type <- readLines(file.path(path, "series_type"))
   logger::log_info("Parsing x column values")
   if (xtype == "date") {
     dat[, xcol] <- as.Date(dat[, xcol], origin = "1970-01-01")
   }
-  list(data = dat, xcol = xcol, xtype = xtype)
+  list(data = dat, xcol = xcol, xtype = xtype, series_type = series_type)
 }
 
 model_out <- function(dat, xcol,

diff --git a/inst/schema/DatasetMetadata.schema.json b/inst/schema/DatasetMetadata.schema.json
@@ -16,12 +16,16 @@
     },
     "xcol": {
       "type": "string"
+    },
+    "type": {
+      "enum": ["surveillance", "post-exposure"]
     }
   },
   "additionalProperties": false,
   "required": [
     "variables",
     "biomarkers",
-    "xcol"
+    "xcol",
+    "type"
   ]
 }
diff --git a/inst/spec.yaml b/inst/spec.yaml
@@ -142,6 +142,7 @@ paths:
                         - ab_unit
                         - ab_spike
                       xcol: day_of_study
+                      type: surveillance
         '404':
           description: Dataset with the given name not found
           content:

diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R
@@ -23,6 +23,7 @@ local_add_dataset <- function(dat, name, session = session_id, env = parent.fram
   write.csv(dat, file.path(filepath, "data"), row.names = FALSE)
   write("day", file.path(filepath, "xcol"))
   write("number", file.path(filepath, "xtype"))
+  write("surveillance", file.path(filepath, "series_type"))
   withr::defer({
     if (dir.exists(filepath)) {
       fs::dir_delete(filepath)
@@ -33,6 +34,7 @@ local_add_dataset <- function(dat, name, session = session_id, env = parent.fram
 
 local_POST_dataset_request <- function(dat, filename,
                                        xcol = "day",
+                                       series_type = "surveillance",
                                        env = parent.frame(),
                                        session = session_id,
                                        cookie = "") {
@@ -44,6 +46,9 @@ local_POST_dataset_request <- function(dat, filename,
                          "Content-Type: text/csv", EOL, EOL,
                          readr::format_csv(dat, eol = EOL), EOL,
                          boundary, EOL,
+                         "Content-Disposition: form-data; name=\"series_type\"", EOL, EOL,
+                         series_type, EOL,
+                         boundary, EOL,
                          "Content-Disposition: form-data; name=\"xcol\"", EOL, EOL,
                          xcol, EOL,
                          boundary, "--")
@@ -70,6 +75,9 @@ local_POST_dataset_request_no_xcol <- function(dat, filename,
                          EOL,
                          "Content-Type: text/csv", EOL, EOL,
                          readr::format_csv(dat, eol = EOL), EOL,
+                         boundary, EOL,
+                         "Content-Disposition: form-data; name=\"series_type\"", EOL, EOL,
+                         "surveillance", EOL,
                          boundary, "--")
   filepath <- file.path("uploads", session_id, filename)
   withr::defer({
@@ -88,6 +96,7 @@ local_POST_dataset_request_with_name <- function(dat,
                                                  filename,
                                                  name,
                                                  xcol = "day",
+                                                 series_type = "surveillance",
                                                  env = parent.frame(),
                                                  cookie = cookie) {
   EOL <- "\r\n"
@@ -101,6 +110,9 @@ local_POST_dataset_request_with_name <- function(dat,
                          "Content-Disposition: form-data; name=\"xcol\"", EOL, EOL,
                          xcol, EOL,
                          boundary, EOL,
+                         "Content-Disposition: form-data; name=\"series_type\"", EOL, EOL,
+                         series_type, EOL,
+                         boundary, EOL,
                          "Content-Disposition: form-data; name=\"name\"", EOL, EOL,
                          name, EOL,
                          boundary, "--")
@@ -128,6 +140,9 @@ local_POST_dataset_request_bad_file <- function(env = parent.frame()) {
                          "Content-Type: image/png", EOL, EOL,
                          "1234", EOL,
                          boundary, EOL,
+                         "Content-Disposition: form-data; name=\"series_type\"", EOL, EOL,
+                         "surveillance", EOL,
+                         boundary, EOL,
                          "Content-Disposition: form-data; name=\"xcol\"", EOL, EOL,
                          "day", EOL,
                          boundary, "--")

diff --git a/tests/testthat/test-upload.R b/tests/testthat/test-upload.R
@@ -100,13 +100,14 @@ test_that("uploading wrong file type returns 400", {
                "Invalid file type; please upload file of type text/csv.")
 })
 
-test_that("saves file and xcol", {
+test_that("saves file, xcol and series_type", {
   router <- build_routes(cookie_key)
   request <- local_POST_dataset_request(data.frame(biomarker = "ab",
                                                    time = 1:10,
                                                    value = 1),
                                         filename = "testdataset",
                                         xcol = "time",
+                                        series_type = "surveillance",
                                         cookie = cookie)
   res <- router$call(request)
   expect_equal(res$status, 200)
@@ -115,6 +116,8 @@ test_that("saves file and xcol", {
   expect_equal(nrow(dat), 10)
   xcol <- readLines(file.path("uploads", session_id, "/testdataset/xcol"))
   expect_equal(xcol, "time")
+  xcol <- readLines(file.path("uploads", session_id, "/testdataset/series_type"))
+  expect_equal(xcol, "surveillance")
 })
 
 test_that("can get uploaded dataset metadata with default xcol", {
@@ -140,14 +143,16 @@ test_that("can get uploaded dataset metadata with default xcol", {
   expect_equal(body$data$xcol, "day")
 })
 
-test_that("can get uploaded dataset metadata with xcol", {
+test_that("can get uploaded dataset metadata with xcol and series_type", {
   request <- local_POST_dataset_request(data.frame(biomarker = c("ab", "ba"),
                                                    value = 1,
                                                    time = 1:10,
                                                    age = "0-5",
                                                    sex = c("M", "F")),
                                         "testdata",
-                                        xcol = "time", cookie = cookie)
+                                        xcol = "time",
+                                        series_type = "post-exposure",
+                                        cookie = cookie)
   router <- build_routes(cookie_key)
   res <- router$call(request)
   expect_equal(res$status, 200)
@@ -160,6 +165,7 @@ test_that("can get uploaded dataset metadata with xcol", {
   expect_equal(body$data$variables$levels, list(c("0-5"), c("M", "F")))
   expect_equal(body$data$biomarkers, c("ab", "ba"))
   expect_equal(body$data$xcol, "time")
+  expect_equal(body$data$type, "post-exposure")
 })
 
 test_that("can get uploaded dataset without covariates", {