paging implemented

R/api.R

@@ -205,32 +205,14 @@ target_get_individual <- function(req,
   }
 
   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]])
-    }
-  }
+  aes <- get_aes(color, linetype, xcol)
 
   warnings <- NULL
   ids <- unique(dat[[pidcol]])
-  if (length(ids) > 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], ]
-  }
+  page_length <- 20
+  num_pages <- ceiling(length(ids) / page_length)
+  paged_ids <- get_paged_ids(ids, page, page_length)
+  dat <- dat[dat[[pidcol]] %in% paged_ids, ]
 
   # 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
@@ -249,10 +231,39 @@ target_get_individual <- function(req,
   jsonlite::toJSON(
     list(data = as.list(q$x$data),
          layout = as.list(q$x$layout),
+         page = page,
+         numPages = num_pages,
          warnings = warnings),
     auto_unbox = TRUE, null = "null")
 }
 
+get_paged_ids <- function(ids, current_page, page_length) {
+  page_start <- ((current_page - 1) * page_length) + 1
+  page_end <- min(length(ids), page_start + (page_length - 1))
+  ids[page_start:page_end]
+}
+
+get_aes <- function(color, linetype, xcol) {
+  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]])
+    }
+  }
+  return(aes)
+}
+
 read_dataset <- function(req, name, scale) {
   validate_scale(scale)
   session_id <- get_or_create_session_id(req)

R/router.R

@@ -119,7 +119,8 @@ get_individual <- function() {
     porcelain::porcelain_input_query(scale = "string",
                                      color = "string",
                                      filter = "string",
-                                     linetype = "string"),
+                                     linetype = "string",
+                                     page = "numeric"),
     returning = porcelain::porcelain_returning_json("Plotly"))
 }
 

inst/schema/Plotly.schema.json

@@ -26,8 +26,14 @@
       "items": {
         "type": "string"
       }
+    },
+    "numPages": {
+      "type": "number"
+    },
+    "page": {
+      "type": "number"
     }
   },
-  "required": ["data", "layout", "warnings"],
+  "required": ["data", "layout", "warnings", "numPages", "page"],
   "additionalProperties": false
 }

tests/testthat/test-paging.R

@@ -0,0 +1,71 @@
+test_that("page 1 is first n ids if n < length(ids)", {
+  ids <- c("a", "b", "c", "d", "e")
+  result <- get_paged_ids(ids, 1, 2)
+  expect_equal(result, c("a", "b"))
+})
+
+test_that("page 1 is all ids if n >= length(ids)", {
+  ids <- c("a", "b", "c", "d", "e")
+  result <- get_paged_ids(ids, 1, 10)
+  expect_equal(result, ids)
+})
+
+test_that("page 2 is second n ids", {
+  ids <- c("a", "b", "c", "d", "e")
+  result <- get_paged_ids(ids, 2, 2)
+  expect_equal(result, c("c", "d"))
+})
+
+test_that("last page is last m ids where m <= n", {
+  ids <- c("a", "b", "c", "d", "e")
+  result <- get_paged_ids(ids, 3, 2)
+  expect_equal(result, c("e"))
+})
+
+test_that("first page of results returned by default", {
+  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)
+  expect_equal(body$data$page, 1)
+  expect_equal(body$data$numPages, 2)
+
+  data <- body$data$data
+  expect_equal(nrow(data), 20)
+})
+
+test_that("correct page of results 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/",
+                              qs = "page=2",
+                              HTTP_COOKIE = cookie))
+
+  expect_equal(res$status, 200)
+  body <- jsonlite::fromJSON(res$body)
+  expect_equal(body$data$page, 2)
+  expect_equal(body$data$numPages, 2)
+
+  data <- body$data$data
+  expect_equal(nrow(data), 5)
+})

tests/testthat/test-read-individual.R

@@ -213,25 +213,3 @@ test_that("can get dataset with dates", {
   expect_equal(unlist(data[1, "x"]), as.numeric(lubridate::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)
-})