diff --git a/.gitignore b/.gitignore index e0fae85..64aa346 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,4 @@ .Rproj.user .idea +uploads + diff --git a/DESCRIPTION b/DESCRIPTION index be3dbd1..1f8d8c7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: serovizr Title: R API for seroviz app -Version: 0.0.0.9000 +Version: 0.0.0 Authors@R: person("Alex", "Hill", , "alex.hill@gmail.com", role = c("aut", "cre"), comment = c(ORCID = "0009-0003-8104-1890")) @@ -12,8 +12,10 @@ RoxygenNote: 7.3.1 Imports: docopt, porcelain, - logger + logger, + Rook Remotes: reside-ic/porcelain, Suggests: - lintr (>= 3.1.2), \ No newline at end of file + lintr (>= 3.1.2), + testthat diff --git a/R/api.R b/R/api.R index ce41b1e..75355ca 100644 --- a/R/api.R +++ b/R/api.R @@ -3,12 +3,86 @@ target_get_root <- function() { } target_get_version <- function() { - jsonlite::toJSON(as.character(utils::packageVersion("serovizr")), auto_unbox= TRUE) + jsonlite::toJSON(as.character(utils::packageVersion("serovizr")), auto_unbox = TRUE) } +target_post_dataset <- function(req, res) { + parsed <- Rook::Multipart$parse(req) + file_body <- read.csv(parsed$file$tempfile) + filename <- parsed$file$filename + filename <- stringr::str_remove_all(filename, paste0(".", tools::file_ext(filename))) + path <- file.path("uploads", filename) + if (file.exists(path)) { + res$status <- 400L + error <- list(error = "BAD_REQUEST", detail = paste("A dataset called", filename, + "already exists. Please choose a unique name for this dataset.")) + return(list(status = "failure", errors = list(error), data = NULL)) + } + required_cols <- c("value", "biomarker") + missing_cols <- required_cols[!(required_cols %in% colnames(file_body))] + if (length(missing_cols) > 0) { + res$status <- 400L + error <- list(error = "BAD_REQUEST", + detail = paste("Missing required columns:", paste(missing_cols, collapse = ", "))) + return(list(status = "failure", errors = list(error), data = NULL)) + } + + write.csv(file_body, path, row.names = FALSE) + return(filename) +} + +target_get_dataset <- function(name) { + dat <- read_dataset(name) + cols <- setdiff(colnames(dat), c("value", "biomarker", "day")) + list(variables = cols, data = jsonlite::toJSON(dat)) +} + +target_get_datasets <- function() { + files <- list.files("uploads") + jsonlite::toJSON(files) +} -target_post_dataset <- function() { - function(data) { - # validate CSV and save to file +target_get_trace <- function(name, biomarker, facet, trace = "age") { + dat <- read_dataset(name) + cols <- colnames(dat) + # facet_def <- strsplit(facet, ":") + # facet_var <- facet_def[[1]][1] + # facet_level <- facet_def[[1]][2] + # if (!(facet_var %in% cols)) { + # porcelain::porcelain_stop(paste("Column", facet_var, "not found in data"), + # code = "BAD_REQUEST", status_code = 400L) + # } + # dat <- dat[dat[facet_var] == facet_level & dat["biomarker"] == biomarker,] + dat <- dat[dat["biomarker"] == biomarker,] + dat$value <- log(dat$value) + groups <- split(dat, eval(parse(text = paste("~", trace)))) + model_result <- lapply(groups, model_out) + raw <- lapply(groups, data_out) + list(model = model_result, raw = raw) +} + +read_dataset <- function(name) { + path <- file.path("uploads", name) + if (!file.exists(path)) { + porcelain::porcelain_stop(paste("Did not find dataset with name ", name), + code = "BAD_REQUEST", status_code = 404L) } + dat <- read.csv(path) + dat$value <- as.numeric(dat$value) + dat +} + +model_out <- function(dat) { + if (nrow(dat) > 1000) { + m <- mgcv::gam(value ~ s(day, bs = "cs"), data = dat, method = "REML") + } else { + m <- stats::loess(value ~ day, data = dat, span = 0.75) + } + range <- range(dat$day, na.rm = TRUE) + xseq <- range[1]:range[2] + list(x = xseq, y = predict(m, tibble::data_frame(day = xseq))) +} + +data_out <- function(dat) { + list(x = dat$day, y = dat$value) } diff --git a/R/router.R b/R/router.R index df723c6..000ecef 100644 --- a/R/router.R +++ b/R/router.R @@ -1,10 +1,20 @@ build_routes <- function() { pr <- porcelain::porcelain$new(validate = TRUE) + pr$registerHook(stage = "preserialize", function(data, req, res, value) { + res$setHeader("Access-Control-Allow-Origin", "http://localhost:3000") + value + }) + pr$handle(get_root()) pr$handle(get_version()) - pr$handle(post_dataset()) + pr$handle("POST", "/dataset/", function(req, res) target_post_dataset(req, res), + serializer = plumber::serializer_unboxed_json()) + pr$handle(get_dataset()) + pr$handle(get_datasets()) + pr$handle(get_trace()) } + get_root <- function() { porcelain::porcelain_endpoint$new("GET", "/", @@ -19,10 +29,23 @@ get_version <- function() { returning = porcelain::porcelain_returning_json("Version")) } -post_dataset <- function() { +get_dataset <- function() { + porcelain::porcelain_endpoint$new( + "GET", "/dataset/", + target_get_dataset, + returning = porcelain::porcelain_returning_json()) +} + +get_datasets <- function() { + porcelain::porcelain_endpoint$new( + "GET", "/datasets/", + target_get_datasets, + returning = porcelain::porcelain_returning_json("Datasets")) +} + +get_trace <- function() { porcelain::porcelain_endpoint$new( - "POST", "/dataset/", - target_post_dataset(), - porcelain::porcelain_input_body_binary("data", "application/csv"), - returning = porcelain::porcelain_returning_json("Data")) + "GET", "/dataset///", + target_get_trace, + returning = porcelain::porcelain_returning_json()) } diff --git a/README.md b/README.md index 3ceb8f3..ed798ba 100644 --- a/README.md +++ b/README.md @@ -9,15 +9,27 @@ R API for the SeroViz app. Based on the [porcelain](https://github.com/reside-ic/porcelain) framework. ## Developing - Install dependencies with: -``` r +```r remotes::install_deps(".", dependencies = TRUE) ``` -## Deploying +Start the API locally by running: + +```r +devtools::load_all() +serovizr:::main() +``` +## Testing +Run tests with: + +```r +devtools::test() +``` + +## Deploying To build a Docker image: ``` r diff --git a/inst/schema/Data.schema.json b/inst/schema/Data.schema.json index 7fae97e..c384621 100644 --- a/inst/schema/Data.schema.json +++ b/inst/schema/Data.schema.json @@ -1,20 +1,36 @@ { "$schema": "http://json-schema.org/draft-04/schema#", - "type": "array", - "items": { - "type": "object", - "properties": { - "biomarker": { + "type": "object", + "properties": { + "variables": { + "type": "array", + "items": { "type": "string" - }, - "value": { - "type": "number" } }, - "additionalProperties": true, - "required": [ - "biomarker", - "value" - ] - } + "data": { + "type": "array", + "items": { + "type": "object", + "properties": { + "biomarker": { + "type": "string" + }, + "value": { + "type": "number" + } + }, + "additionalProperties": true, + "required": [ + "biomarker", + "value" + ] + } + } + }, + "additionalProperties": false, + "required": [ + "data", + "variables" + ] } diff --git a/inst/schema/Datasets.schema.json b/inst/schema/Datasets.schema.json new file mode 100644 index 0000000..b202eb8 --- /dev/null +++ b/inst/schema/Datasets.schema.json @@ -0,0 +1,7 @@ +{ + "$schema": "http://json-schema.org/draft-04/schema#", + "type": "array", + "items": { + "type": "string" + } +} diff --git a/tests/testthat/test-router.R b/tests/testthat/test-router.R new file mode 100644 index 0000000..6771ac3 --- /dev/null +++ b/tests/testthat/test-router.R @@ -0,0 +1,26 @@ +test_that("root endpoint", { + res <- target_get_root() + expect_equal(res, jsonlite::unbox("Welcome to serovizr")) + + endpoint <- get_root() + res_endpoint <- endpoint$run() + expect_equal(res_endpoint$status_code, 200) + expect_equal(res_endpoint$content_type, "application/json") + expect_equal(res_endpoint$data, res) + + router <- build_routes() + res_api <- router$request("GET", "/") + expect_equal(res_api$status, 200) + expect_equal(res_api$body, res_endpoint$body) +}) + +test_that("version endpoint", { + res <- jsonlite::fromJSON(target_get_version()) + expect_equal(res, as.character(packageVersion("serovizr"))) + + router <- build_routes() + res_api <- router$request("GET", "/version") + expect_equal(res_api$status, 200) + body <- jsonlite::fromJSON(res_api$body) + expect_equal(res, body$data) +}) diff --git a/tests/testthat/test-upload-dataset.R b/tests/testthat/test-upload-dataset.R new file mode 100644 index 0000000..117188b --- /dev/null +++ b/tests/testthat/test-upload-dataset.R @@ -0,0 +1,10 @@ +test_that("returns error", { + res <- jsonlite::fromJSON(target_post_dataset()) + expect_equal(res, as.character(packageVersion("serovizr"))) + + router <- build_routes() + res_api <- router$request("POST", "/dataset/") + expect_equal(res_api$status, 200) + body <- jsonlite::fromJSON(res_api$body) + expect_equal(res, body$data) +}) diff --git a/tests/testtthat.R b/tests/testtthat.R new file mode 100644 index 0000000..17a59bb --- /dev/null +++ b/tests/testtthat.R @@ -0,0 +1,4 @@ +library(testthat) +library(serovizr) + +test_check("mintr")