From 2e4ee539707dafe836b376617b3150090dc42628 Mon Sep 17 00:00:00 2001 From: "alex.hill@gmail.com" Date: Thu, 19 Sep 2024 15:24:18 +0100 Subject: [PATCH 1/7] add endpoint for individual plot --- R/api.R | 105 +++++++++++++++++++++++++++++++++++++++++++---------- R/router.R | 13 +++++++ 2 files changed, 99 insertions(+), 19 deletions(-) diff --git a/R/api.R b/R/api.R index 13b67a4..8dc9547 100644 --- a/R/api.R +++ b/R/api.R @@ -90,9 +90,7 @@ target_get_dataset <- function(name, req) { variables <- list() for (col in cols) { lvls <- unique(dat[, col]) - if (length(lvls) < 25) { - variables[[col]] <- list(name = jsonlite::unbox(col), levels = lvls) - } + variables[[col]] <- list(name = jsonlite::unbox(col), levels = lvls) } list(variables = unname(variables), biomarkers = biomarkers, @@ -113,23 +111,15 @@ target_get_trace <- function(name, method = "auto", span = 0.75, k = 10) { - biomarker <- httpuv::decodeURIComponent(biomarker) + biomarker <- httpuv::decodeURIComponent(biomarker) logger::log_info(paste("Requesting data from", name, "with biomarker", biomarker)) dataset <- read_dataset(req, name, scale) dat <- dataset$data xcol <- dataset$xcol xtype <- dataset$xtype - cols <- colnames(dat) - if (!is.null(filter)) { - filters <- strsplit(filter, "+", fixed = TRUE)[[1]] - logger::log_info(paste("Filtering by variables:", paste(filters, - collapse = ", "))) - for (f in filters) { - dat <- apply_filter(f, dat, cols) - } - } - dat <- dat[dat["biomarker"] == biomarker, ] + dat <- apply_filters(dat, filter) + dat <- dat[dat["biomarker"] == biomarker,] if (length(disaggregate) > 0) { logger::log_info(paste("Disaggregating by variables:", disaggregate)) groups <- split(dat, eval(parse(text = paste("~", disaggregate)))) @@ -162,6 +152,70 @@ target_get_trace <- function(name, } } +target_get_individual <- function(req, name, pid, + scale, + filter = NULL, + color = NULL, + linetype = NULL, + page = 1) { + + data <- read_dataset(req, name, scale) + dat <- data$data + xcol <- data$xcol + dat <- apply_filters(dat, filter) + if (is.null(color)) { + if (is.null(linetype)) { + aes <- ggplot2::aes(x = .data[[xcol]], y = value) + } else { + aes <- ggplot2::aes(x = .data[[xcol]], y = value, + linetype = .data[[linetype]]) + } + } else { + if (is.null(linetype)) { + aes <- ggplot2::aes(x = .data[[xcol]], y = value, + color = .data[[color]]) + } else { + aes <- ggplot2::aes(x = .data[[xcol]], y = value, + color = .data[[color]], + linetype = .data[[linetype]]) + } + } + + warnings <- NULL + ids <- unique(dat[[pid]]) + if (length(ids) > 20) { + warnings <- c(warnings, paste(length(ids), "individuals identified; only the first 20 will be shown")) + dat <- dat[dat[[pid]] %in% ids[1:20], ] + } + + p <- with_warnings(ggplot2::ggplot(dat) + + ggplot2::geom_line(aes) + + ggplot2::facet_wrap(pid) + + ggplot2::theme_bw() + + ggplot2::labs(x = xcol, y = "Antibody titre", + linetype = linetype, + color = color)) + warnings <- c(warnings, p$warnings) + + q <- plotly::ggplotly(p$output) + jsonlite::toJSON( + list(data = as.list(q$x$data), + layout = as.list(q$x$layout), + warnings = warnings), + auto_unbox = TRUE, null = "null") +} + +get_raw <- function(name, dat, disaggregate, xcol) { + groups <- split(dat, eval(parse(text = paste("~", disaggregate)))) + nms <- names(groups) + return(lapply(seq_along(groups), function(i) { + list(title = name, + name = jsonlite::unbox(nms[[i]]), + raw = data_out(groups[[i]], xcol)) + })) +} + + read_dataset <- function(req, name, scale) { validate_scale(scale) session_id <- get_or_create_session_id(req) @@ -188,10 +242,10 @@ read_dataset <- function(req, name, scale) { } model_out <- function(dat, xcol, - xtype = "number", - method = "auto", - span = 0.75, - k = 10) { + xtype = "number", + method = "auto", + span = 0.75, + k = 10) { n <- nrow(dat) if (n == 0) { return(list(x = list(), y = list())) @@ -229,7 +283,7 @@ apply_filter <- function(filter, dat, cols) { "not found in data"), code = "BAD_REQUEST", status_code = 400L) } - dat[dat[filter_var] == filter_level, ] + dat[dat[filter_var] == filter_level,] } bad_request_response <- function(msg) { @@ -259,3 +313,16 @@ response_success <- function(data) { list(status = jsonlite::unbox("success"), errors = NULL, data = data) } + +apply_filters <- function(dat, filter) { + if (!is.null(filter)) { + filters <- strsplit(filter, "+", fixed = TRUE)[[1]] + logger::log_info(paste("Filtering by variables:", paste(filters, + collapse = ", "))) + cols <- colnames(dat) + for (f in filters) { + dat <- apply_filter(f, dat, cols) + } + } + return(dat) +} diff --git a/R/router.R b/R/router.R index 0e9f86b..e1986f6 100644 --- a/R/router.R +++ b/R/router.R @@ -38,6 +38,7 @@ build_routes <- function(cookie_key = plumber::random_cookie_key(), pr$handle(get_dataset()) pr$handle(get_datasets()) pr$handle(get_trace()) + pr$handle(get_individual()) } get_root <- function() { @@ -85,6 +86,18 @@ get_trace <- function() { returning = porcelain::porcelain_returning_json("DataSeries")) } +get_individual <- function() { + porcelain::porcelain_endpoint$new( + "GET", + "/dataset//individual//", + target_get_individual, + porcelain::porcelain_input_query(scale = "string", + color = "string", + filter = "string", + linetype = "string"), + returning = porcelain::porcelain_returning_json()) +} + prune_inactive_sessions <- function(cache) { active_sessions <- cache$keys() subdirectories <- list.files("uploads") From f9bac7b88484292ff3a1fa48370fb3e2f9d91d01 Mon Sep 17 00:00:00 2001 From: "alex.hill@gmail.com" Date: Thu, 19 Sep 2024 16:12:08 +0100 Subject: [PATCH 2/7] tests --- R/api.R | 58 +++-- R/router.R | 2 +- tests/testthat/test-read-individuals.R | 236 ++++++++++++++++++ tests/testthat/test-read-metadata.R | 22 ++ .../{test-read.R => test-read-trace.R} | 23 -- 5 files changed, 293 insertions(+), 48 deletions(-) create mode 100644 tests/testthat/test-read-individuals.R create mode 100644 tests/testthat/test-read-metadata.R rename tests/testthat/{test-read.R => test-read-trace.R} (93%) diff --git a/R/api.R b/R/api.R index 8dc9547..0ffd9dc 100644 --- a/R/api.R +++ b/R/api.R @@ -152,16 +152,23 @@ target_get_trace <- function(name, } } -target_get_individual <- function(req, name, pid, - scale, - filter = NULL, - color = NULL, - linetype = NULL, - page = 1) { +target_get_individual <- function(req, + name, + pidcol, + scale = "natural", + filter = NULL, + color = NULL, + linetype = NULL, + page = 1) { data <- read_dataset(req, name, scale) dat <- data$data xcol <- data$xcol + + if (!(pidcol %in% colnames(dat))){ + porcelain::porcelain_stop(sprintf("Id column '%s' not found.", pidcol)) + } + dat <- apply_filters(dat, filter) if (is.null(color)) { if (is.null(linetype)) { @@ -182,15 +189,19 @@ target_get_individual <- function(req, name, pid, } warnings <- NULL - ids <- unique(dat[[pid]]) + ids <- unique(dat[[pidcol]]) if (length(ids) > 20) { - warnings <- c(warnings, paste(length(ids), "individuals identified; only the first 20 will be shown")) - dat <- dat[dat[[pid]] %in% ids[1:20], ] + warnings <- c(warnings, paste(length(ids), "individuals identified; only the first 20 will be shown.")) + dat <- dat[dat[[pidcol]] %in% ids[1:20],] } + # Facets in plotlyjs are quite a pain. Using ggplot2 and plotly R + # packages to generate the plotly data and layout objects is a bit slower + # than just generating data series in R and letting the front-end handle the + # presentation logic, but is much easier to get right! p <- with_warnings(ggplot2::ggplot(dat) + ggplot2::geom_line(aes) + - ggplot2::facet_wrap(pid) + + ggplot2::facet_wrap(pidcol) + ggplot2::theme_bw() + ggplot2::labs(x = xcol, y = "Antibody titre", linetype = linetype, @@ -215,7 +226,6 @@ get_raw <- function(name, dat, disaggregate, xcol) { })) } - read_dataset <- function(req, name, scale) { validate_scale(scale) session_id <- get_or_create_session_id(req) @@ -273,6 +283,19 @@ data_out <- function(dat, xcol) { list(x = dat[, xcol], y = dat$value) } +apply_filters <- function(dat, filter) { + if (!is.null(filter)) { + filters <- strsplit(filter, "+", fixed = TRUE)[[1]] + logger::log_info(paste("Filtering by variables:", paste(filters, + collapse = ", "))) + cols <- colnames(dat) + for (f in filters) { + dat <- apply_filter(f, dat, cols) + } + } + return(dat) +} + apply_filter <- function(filter, dat, cols) { filter_def <- strsplit(filter, ":") filter_var <- filter_def[[1]][1] @@ -313,16 +336,3 @@ response_success <- function(data) { list(status = jsonlite::unbox("success"), errors = NULL, data = data) } - -apply_filters <- function(dat, filter) { - if (!is.null(filter)) { - filters <- strsplit(filter, "+", fixed = TRUE)[[1]] - logger::log_info(paste("Filtering by variables:", paste(filters, - collapse = ", "))) - cols <- colnames(dat) - for (f in filters) { - dat <- apply_filter(f, dat, cols) - } - } - return(dat) -} diff --git a/R/router.R b/R/router.R index e1986f6..f8e743b 100644 --- a/R/router.R +++ b/R/router.R @@ -89,7 +89,7 @@ get_trace <- function() { get_individual <- function() { porcelain::porcelain_endpoint$new( "GET", - "/dataset//individual//", + "/dataset//individual//", target_get_individual, porcelain::porcelain_input_query(scale = "string", color = "string", diff --git a/tests/testthat/test-read-individuals.R b/tests/testthat/test-read-individuals.R new file mode 100644 index 0000000..f4f2105 --- /dev/null +++ b/tests/testthat/test-read-individuals.R @@ -0,0 +1,236 @@ +test_that("GET /individual/ returns 404 if dataset not found", { + router <- build_routes(cookie_key) + res <- router$call(make_req("GET", + "/dataset/testdataset/individual/pid/", + HTTP_COOKIE = cookie)) + expect_equal(res$status, 404) + validate_failure_schema(res$body) + body <- jsonlite::fromJSON(res$body) + expect_equal(body$errors[1, "detail"], + "Did not find dataset with name: testdataset") +}) + +test_that("GET /individual/ returns 400 if pidcol not found", { + dat <- data.frame(biomarker = "ab", + value = 1, + day = 1:10) + local_add_dataset(dat, name = "testdataset") + router <- build_routes(cookie_key) + res <- router$call(make_req("GET", + "/dataset/testdataset/individual/pid/", + HTTP_COOKIE = cookie)) + expect_equal(res$status, 400) + validate_failure_schema(res$body) + body <- jsonlite::fromJSON(res$body) + str(body) + expect_equal(body$errors[1, "detail"], + "Id column 'pid' not found.") +}) + +test_that("can get individual trajectories for uploaded dataset with xcol", { + dat <- data.frame(biomarker = c("ab", "ba"), + pid = c(1, 2), + value = 11:20, + time = 1:10, + age = "0-5", + sex = c("M", "F")) + router <- build_routes(cookie_key) + post_request <- local_POST_dataset_request(dat, + "testdataset", + xcol = "time", + cookie = cookie) + expect_equal(router$call(post_request)$status, 200) + + res <- router$call(make_req("GET", + "/dataset/testdataset/individual/pid/", + HTTP_COOKIE = cookie)) + expect_equal(res$status, 200) + body <- jsonlite::fromJSON(res$body) + expect_equal(nrow(body$data$data), 2) + expect_equal(body$data$data$x[[1]], c(1, 3, 5, 7, 9)) + expect_equal(body$data$data$y[[1]], c(11, 13, 15, 17, 19)) + expect_equal(body$data$data$x[[2]], c(2, 4, 6, 8, 10)) + expect_equal(body$data$data$y[[2]], c(12, 14, 16, 18, 20)) +}) + +test_that("GET /individual/?scale= returns 400 if invalid scale", { + dat <- data.frame(biomarker = "ab", + value = 1, + day = 1:10, + age = "0-5", + sex = c("M", "F")) + local_add_dataset(dat, name = "testdataset") + router <- build_routes(cookie_key) + res <- router$call(make_req("GET", + "/dataset/testdataset/individual/pid/", + qs = "scale=bad", + HTTP_COOKIE = cookie)) + expect_equal(res$status, 400) + validate_failure_schema(res$body) + body <- jsonlite::fromJSON(res$body) + expect_equal(body$errors[1, "detail"], + "'scale' must be one of 'log', 'log2', or 'natural'") +}) + +test_that("can get trajectories with color", { + dat <- data.frame(pid = c(1, 2), + value = 1, + day = 1:10, + age = "0-5", + sex = c("M", "F")) + local_add_dataset(dat, name = "testdataset") + router <- build_routes(cookie_key) + res <- router$call(make_req("GET", + "/dataset/testdataset/individual/pid/", + qs = "color=sex", + HTTP_COOKIE = cookie)) + expect_equal(res$status, 200) + body <- jsonlite::fromJSON(res$body) + data <- body$data$data + expect_equal(nrow(data), 2) + expect_equal(data$name, c("F", "M")) + expect_false(data[1, "line"]$color == data[2, "line"]$color) + + expect_equal(data[1, "x"], list(c(2, 4, 6, 8, 10))) + expect_equal(data[1, "y"], list(c(1, 1, 1, 1, 1))) + expect_equal(data[1, "line"]$dash, "solid") + + + expect_equal(data[2, "x"], list(c(1, 3, 5, 7, 9))) + expect_equal(data[2, "y"], list(c(1, 1, 1, 1, 1))) + expect_equal(data[2, "line"]$dash, "solid") +}) + +test_that("can get trajectoriees with linetype", { + dat <- data.frame(pid = 1, + value = c(1, 2), + day = 1:10, + subtype = c("M", "F")) + router <- build_routes(cookie_key) + local_add_dataset(dat, name = "testdataset") + res <- router$call(make_req("GET", + "/dataset/testdataset/individual/pid/", + qs = "linetype=subtype", + HTTP_COOKIE = cookie)) + expect_equal(res$status, 200) + body <- jsonlite::fromJSON(res$body) + data <- body$data$data + expect_equal(nrow(data), 2) + expect_equal(data$name, c("F", "M")) + expect_equal(data[1, "line"]$color, data[2, "line"]$color) + + expect_equal(data[1, "x"], list(c(2, 4, 6, 8, 10))) + expect_equal(data[1, "y"], list(rep(2, 5))) + expect_equal(data[1, "line"]$dash, "solid") + + expect_equal(data[2, "x"], list(c(1, 3, 5, 7, 9))) + expect_equal(data[2, "y"], list(rep(1, 5))) + expect_equal(data[2, "line"]$dash, "dash") +}) + +test_that("can get trajectoriees with linetype and color", { + dat <- data.frame(pid = 1, + value = c(1, 2), + day = 1:10, + biomarker = rep(c("ab", "ba"), 5), + subtype = c("M", "F")) + router <- build_routes(cookie_key) + local_add_dataset(dat, name = "testdataset") + res <- router$call(make_req("GET", + "/dataset/testdataset/individual/pid/", + qs = "linetype=subtype&color=biomarker", + HTTP_COOKIE = cookie)) + expect_equal(res$status, 200) + body <- jsonlite::fromJSON(res$body) + data <- body$data$data + expect_equal(nrow(data), 2) + expect_equal(data$name, c("(ab,M)", "(ba,F)")) + expect_false(data[1, "line"]$color == data[2, "line"]$color) + expect_equal(data[1, "line"]$dash, "dash") + expect_equal(data[2, "line"]$dash, "solid") +}) + +test_that("can get filtered individual trajectories", { + dat <- data.frame(pid = 1, + value = 1:10, + day = 1:10, + sex = c("M", "F")) + router <- build_routes(cookie_key) + local_add_dataset(dat, name = "testdataset") + res <- router$call(make_req("GET", + "/dataset/testdataset/individual/pid/", + qs = "filter=sex%3AM", + HTTP_COOKIE = cookie)) + expect_equal(res$status, 200) + body <- jsonlite::fromJSON(res$body) + data <- body$data$data + expect_equal(nrow(data), 1) + expect_equal(data[1, "x"], list(c(1, 3, 5, 7, 9))) + expect_equal(data[1, "y"], list(c(1, 3, 5, 7, 9))) +}) + +test_that("can get log data", { + dat <- data.frame(biomarker = "ab", + pid = 1, + value = 1:5, + day = 1:5) + router <- build_routes(cookie_key) + local_add_dataset(dat, name = "testdataset") + res <- router$call(make_req("GET", + "/dataset/testdataset/individual/pid/", + qs = "scale=log", + HTTP_COOKIE = cookie)) + expect_equal(res$status, 200) + body <- jsonlite::fromJSON(res$body) + data <- body$data$data + expect_equal(nrow(data), 1) + expect_equal(data[1, "x"], list(1:5)) + expect_equal(unlist(data[1, "y"]), + jsonlite::fromJSON( + jsonlite::toJSON(log(1:5)) # convert to/from json for consistent rounding + )) +}) + +test_that("can get dataset with dates", { + dates <- c("2023/15/01", "2023/16/01", "2023/17/01", "2023/18/01", "2023/20/01") + dat <- data.frame(biomarker = "ab", + pid = 1, + value = 1:5, + day = dates) + router <- build_routes(cookie_key) + post_request <- local_POST_dataset_request(dat, + "testdataset", + cookie = cookie) + expect_equal(router$call(post_request)$status, 200) + res <- router$call(make_req("GET", + "/dataset/testdataset/individual/pid/", + HTTP_COOKIE = cookie)) + expect_equal(res$status, 200) + body <- jsonlite::fromJSON(res$body) + data <- body$data$data + expect_equal(nrow(data), 1) + expect_equal(unlist(data[1, "x"]), as.numeric(ydm(dates))) + expect_equal(unlist(data[1, "y"]), 1:5) +}) + +test_that("only first 20 individuals are returned", { + dat <- data.frame(biomarker = "ab", + pid = 1:25, + value = 1, + day = 1:25) + router <- build_routes(cookie_key) + post_request <- local_POST_dataset_request(dat, + "testdataset", + cookie = cookie) + expect_equal(router$call(post_request)$status, 200) + res <- router$call(make_req("GET", + "/dataset/testdataset/individual/pid/", + HTTP_COOKIE = cookie)) + expect_equal(res$status, 200) + body <- jsonlite::fromJSON(res$body) + warnings <- body$data$warnings + expect_equal(warnings, "25 individuals identified; only the first 20 will be shown.") + + data <- body$data$data + expect_equal(nrow(data), 20) +}) diff --git a/tests/testthat/test-read-metadata.R b/tests/testthat/test-read-metadata.R new file mode 100644 index 0000000..91c822e --- /dev/null +++ b/tests/testthat/test-read-metadata.R @@ -0,0 +1,22 @@ +test_that("GET /dataset returns 404 if no session cookie present", { + router <- build_routes(cookie_key) + res <- router$call(make_req("GET", + "/dataset/testdataset/")) + expect_equal(res$status, 404) + validate_failure_schema(res$body) + body <- jsonlite::fromJSON(res$body) + expect_equal(body$errors[1, "detail"], + "Did not find dataset with name: testdataset") +}) + +test_that("GET /dataset returns 404 if dataset not found", { + router <- build_routes(cookie_key) + res <- router$call(make_req("GET", + "/dataset/testdataset/", + HTTP_COOKIE = cookie)) + expect_equal(res$status, 404) + validate_failure_schema(res$body) + body <- jsonlite::fromJSON(res$body) + expect_equal(body$errors[1, "detail"], + "Did not find dataset with name: testdataset") +}) diff --git a/tests/testthat/test-read.R b/tests/testthat/test-read-trace.R similarity index 93% rename from tests/testthat/test-read.R rename to tests/testthat/test-read-trace.R index 1638003..100d1bb 100644 --- a/tests/testthat/test-read.R +++ b/tests/testthat/test-read-trace.R @@ -1,26 +1,3 @@ -test_that("GET /dataset returns 404 if no session cookie present", { - router <- build_routes(cookie_key) - res <- router$call(make_req("GET", - "/dataset/testdataset/")) - expect_equal(res$status, 404) - validate_failure_schema(res$body) - body <- jsonlite::fromJSON(res$body) - expect_equal(body$errors[1, "detail"], - "Did not find dataset with name: testdataset") -}) - -test_that("GET /dataset returns 404 if dataset not found", { - router <- build_routes(cookie_key) - res <- router$call(make_req("GET", - "/dataset/testdataset/", - HTTP_COOKIE = cookie)) - expect_equal(res$status, 404) - validate_failure_schema(res$body) - body <- jsonlite::fromJSON(res$body) - expect_equal(body$errors[1, "detail"], - "Did not find dataset with name: testdataset") -}) - test_that("GET /trace/ returns 404 if dataset not found", { router <- build_routes(cookie_key) res <- router$call(make_req("GET", From a10e48bbc939694e3687782cfc403866e3dd3ea1 Mon Sep 17 00:00:00 2001 From: "alex.hill@gmail.com" Date: Thu, 19 Sep 2024 16:13:39 +0100 Subject: [PATCH 3/7] update deps --- DESCRIPTION | 2 ++ docker/Dockerfile | 2 ++ 2 files changed, 4 insertions(+) diff --git a/DESCRIPTION b/DESCRIPTION index d302e5b..376e3c3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -14,12 +14,14 @@ Imports: cachem, docopt, fs, + ggplot2, httpuv, jsonlite, logger, lubridate, mgcv, mime, + plotly, plumber, porcelain, rlang, diff --git a/docker/Dockerfile b/docker/Dockerfile index 883dd43..097c1c6 100644 --- a/docker/Dockerfile +++ b/docker/Dockerfile @@ -16,10 +16,12 @@ RUN install_packages --repo=https://mrc-ide.r-universe.dev \ callr \ docopt \ fs \ + ggplot2 \ logger \ lubridate \ jsonlite \ jsonvalidate \ + plotly \ plumber \ remotes \ Rook \ From 1f2e963f542a00f8c2be03c154768c0523dc3bfd Mon Sep 17 00:00:00 2001 From: "alex.hill@gmail.com" Date: Thu, 19 Sep 2024 16:15:36 +0100 Subject: [PATCH 4/7] suppress warnings --- R/api.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/api.R b/R/api.R index 0ffd9dc..e3e5fe5 100644 --- a/R/api.R +++ b/R/api.R @@ -160,6 +160,7 @@ target_get_individual <- function(req, color = NULL, linetype = NULL, page = 1) { + .data <- value <- NULL data <- read_dataset(req, name, scale) dat <- data$data From c00690daa1cf82c5fbe1f94e4d4a79c10d9b195d Mon Sep 17 00:00:00 2001 From: "alex.hill@gmail.com" Date: Thu, 19 Sep 2024 16:16:24 +0100 Subject: [PATCH 5/7] namespace function call --- tests/testthat/test-read-individuals.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-read-individuals.R b/tests/testthat/test-read-individuals.R index f4f2105..1e851f8 100644 --- a/tests/testthat/test-read-individuals.R +++ b/tests/testthat/test-read-individuals.R @@ -209,7 +209,7 @@ test_that("can get dataset with dates", { body <- jsonlite::fromJSON(res$body) data <- body$data$data expect_equal(nrow(data), 1) - expect_equal(unlist(data[1, "x"]), as.numeric(ydm(dates))) + expect_equal(unlist(data[1, "x"]), as.numeric(lubridate::ydm(dates))) expect_equal(unlist(data[1, "y"]), 1:5) }) From fa36d0e6308eb08b3cfe97aae23262b1d12fb769 Mon Sep 17 00:00:00 2001 From: "alex.hill@gmail.com" Date: Thu, 19 Sep 2024 16:23:19 +0100 Subject: [PATCH 6/7] lint --- R/api.R | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/R/api.R b/R/api.R index e3e5fe5..6677d9b 100644 --- a/R/api.R +++ b/R/api.R @@ -119,7 +119,7 @@ target_get_trace <- function(name, xcol <- dataset$xcol xtype <- dataset$xtype dat <- apply_filters(dat, filter) - dat <- dat[dat["biomarker"] == biomarker,] + dat <- dat[dat["biomarker"] == biomarker, ] if (length(disaggregate) > 0) { logger::log_info(paste("Disaggregating by variables:", disaggregate)) groups <- split(dat, eval(parse(text = paste("~", disaggregate)))) @@ -166,7 +166,7 @@ target_get_individual <- function(req, dat <- data$data xcol <- data$xcol - if (!(pidcol %in% colnames(dat))){ + if (!(pidcol %in% colnames(dat))) { porcelain::porcelain_stop(sprintf("Id column '%s' not found.", pidcol)) } @@ -192,8 +192,10 @@ target_get_individual <- function(req, warnings <- NULL ids <- unique(dat[[pidcol]]) if (length(ids) > 20) { - warnings <- c(warnings, paste(length(ids), "individuals identified; only the first 20 will be shown.")) - dat <- dat[dat[[pidcol]] %in% ids[1:20],] + msg <- paste(length(ids), + "individuals identified; only the first 20 will be shown.") + warnings <- c(warnings, msg) + dat <- dat[dat[[pidcol]] %in% ids[1:20], ] } # Facets in plotlyjs are quite a pain. Using ggplot2 and plotly R @@ -307,7 +309,7 @@ apply_filter <- function(filter, dat, cols) { "not found in data"), code = "BAD_REQUEST", status_code = 400L) } - dat[dat[filter_var] == filter_level,] + dat[dat[filter_var] == filter_level, ] } bad_request_response <- function(msg) { From 221188e1258fedf8a38e9e7653eb4acc1bcd1aa0 Mon Sep 17 00:00:00 2001 From: "alex.hill@gmail.com" Date: Thu, 19 Sep 2024 16:29:39 +0100 Subject: [PATCH 7/7] remove unused method --- R/api.R | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/R/api.R b/R/api.R index 6677d9b..d4cb828 100644 --- a/R/api.R +++ b/R/api.R @@ -219,16 +219,6 @@ target_get_individual <- function(req, auto_unbox = TRUE, null = "null") } -get_raw <- function(name, dat, disaggregate, xcol) { - groups <- split(dat, eval(parse(text = paste("~", disaggregate)))) - nms <- names(groups) - return(lapply(seq_along(groups), function(i) { - list(title = name, - name = jsonlite::unbox(nms[[i]]), - raw = data_out(groups[[i]], xcol)) - })) -} - read_dataset <- function(req, name, scale) { validate_scale(scale) session_id <- get_or_create_session_id(req)