From 33e832b564a22d4f458faf6281ed10dd8bbe94e9 Mon Sep 17 00:00:00 2001
From: "alex.hill@gmail.com" <alex.hill@gmail.com>
Date: Wed, 21 Aug 2024 16:27:52 +0100
Subject: [PATCH] filtering working

---
 R/api.R                    | 36 ++++++++++++++++++++++--------------
 tests/testthat/helper.R    |  2 +-
 tests/testthat/test-read.R | 26 +++++++++++++++++++++++---
 3 files changed, 46 insertions(+), 18 deletions(-)

diff --git a/R/api.R b/R/api.R
index 63c186b..9fa5157 100644
--- a/R/api.R
+++ b/R/api.R
@@ -86,27 +86,21 @@ target_get_trace <- function(name,
                              biomarker,
                              filter = NULL,
                              disaggregate = NULL) {
-  str(disaggregate)
   logger::log_info(paste("Requesting data from", name,
                          "with biomarker", biomarker))
-  logger::log_info(paste("Filtering by variables:", filter))
   dataset <- read_dataset(name)
   dat <- dataset$data
   xcol <- dataset$xcol
   cols <- colnames(dat)
   if (!is.null(filter)) {
-    filter_def <- strsplit(filter, ":")
-    filter_var <- filter_def[[1]][1]
-    filter_level <- filter_def[[1]][2]
-    if (!(filter_var %in% cols)) {
-      porcelain::porcelain_stop(paste("Column",
-                                      filter_var,
-                                      "not found in data"),
-                                code = "BAD_REQUEST", status_code = 400L)
-    }
-    dat <- dat[dat[filter_var] == filter_level, ]
+    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 <- dat[dat["biomarker"] == biomarker,]
   if (length(disaggregate) > 0) {
     logger::log_info(paste("Disaggregating by variables:", disaggregate))
     groups <- split(dat, eval(parse(text = paste("~", disaggregate))))
@@ -121,7 +115,8 @@ target_get_trace <- function(name,
   } else {
     logger::log_info("Returning single trace")
     model <- with_warnings(model_out(dat, xcol))
-    return(list(list(name = jsonlite::unbox("all"),
+    nm <- ifelse(is.null(filter), "all", filter)
+    return(list(list(name = jsonlite::unbox(nm),
                      model = model$output,
                      raw = data_out(dat, xcol),
                      warnings = model$warnings)))
@@ -161,3 +156,16 @@ model_out <- function(dat, xcol) {
 data_out <- function(dat, xcol) {
   list(x = dat[, xcol], y = dat$value)
 }
+
+apply_filter <- function(filter, dat, cols) {
+  filter_def <- strsplit(filter, ":")
+  filter_var <- filter_def[[1]][1]
+  filter_level <- filter_def[[1]][2]
+  if (!(filter_var %in% cols)) {
+    porcelain::porcelain_stop(paste("Column",
+                                    filter_var,
+                                    "not found in data"),
+                              code = "BAD_REQUEST", status_code = 400L)
+  }
+  dat[dat[filter_var] == filter_level,]
+}
diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R
index 1dbcda4..16f5a37 100644
--- a/tests/testthat/helper.R
+++ b/tests/testthat/helper.R
@@ -59,7 +59,7 @@ local_POST_dataset_request_bad_file <- function(env = parent.frame()) {
                          "1234", EOL,
                          boundary, EOL,
                          "Content-Disposition: form-data; name=\"xcol\"", EOL, EOL,
-                         xcol, EOL,
+                         "day", EOL,
                          boundary, "--")
   filepath <- file.path("uploads", filename)
   withr::defer({
diff --git a/tests/testthat/test-read.R b/tests/testthat/test-read.R
index 798fa23..26c7298 100644
--- a/tests/testthat/test-read.R
+++ b/tests/testthat/test-read.R
@@ -80,7 +80,7 @@ test_that("can get disgagregated traces", {
   expect_equal(data$model[2, "y"], list(rep(1, 9)))
 })
 
-test_that("can get filtered traces", {
+test_that("can get filtered trace", {
   dat <- data.frame(biomarker = "ab",
                     value = rep(c(0, 1, 2, 3), 5),
                     day = 1:20,
@@ -95,12 +95,32 @@ test_that("can get filtered traces", {
   body <- jsonlite::fromJSON(res$body)
   data <- body$data
   expect_equal(nrow(data), 1)
-  expect_equal(data$name, "all")
+  expect_equal(data$name, "sex:M")
   expect_equal(data$raw[1, "x"], list(c(1, 3, 5, 7, 9, 11, 13, 15, 17, 19)))
   expect_equal(data$raw[1, "y"], list(c(0, 2, 0, 2, 0, 2, 0, 2, 0, 2)))
 })
 
-test_that("can get disgagregated and filtered traces", {
+test_that("can get trace filtered by multiple variables", {
+  dat <- data.frame(biomarker = "ab",
+                    value = rep(c(0, 1, 2, 3), 5),
+                    day = 1:20,
+                    age = rep(c("0-5", "0-5", "5+", "5+"), 5),
+                    sex = c("M", "F"))
+  local_add_dataset(dat,
+                    "testdataset")
+  router <- build_routes()
+  res <- router$request("GET", "/dataset/testdataset/trace/ab/",
+                        query = list(filter = "sex%3AM%2Bage%3A0-5"))
+  expect_equal(res$status, 200)
+  body <- jsonlite::fromJSON(res$body)
+  data <- body$data
+  expect_equal(nrow(data), 1)
+  expect_equal(data$name, "sex:M+age:0-5")
+  expect_equal(data$raw[1, "x"], list(c(1, 5, 9, 13, 17)))
+  expect_equal(data$raw[1, "y"], list(c(0, 0, 0, 0, 0)))
+})
+
+test_that("can get disaggregated and filtered traces", {
   dat <- data.frame(biomarker = "ab",
                     value = rep(c(0, 1, 2, 3), 5),
                     day = 1:20,