Merge pull request #3 from seroanalytics/scale

support transforming data to log scale

.github/workflows/docker.yaml

@@ -0,0 +1,37 @@
+name: 🚢 Docker
+
+on:
+  push:
+    branches:
+      - main
+  pull_request:
+
+env:
+  BRANCH_NAME: ${{ github.head_ref || github.ref_name }}
+
+concurrency:
+  group: ${{ github.workflow }}-${{ github.ref }}
+  cancel-in-progress: true
+
+jobs:
+  docker:
+    name: 🚢 Docker
+    runs-on: ubuntu-latest
+    steps:
+      - name: ⬇️ Checkout repo
+        uses: actions/checkout@v4
+
+      - name: 🔨 Build image
+        run: ./docker/build
+
+      - name: 🔥 Smoke test
+        run: ./docker/smoke-test
+
+      - name: Login to Docker Hub
+        uses: docker/login-action@v3
+        with:
+          username: ${{ secrets.DOCKERHUB_USERNAME }}
+          password: ${{ secrets.DOCKERHUB_TOKEN }}
+
+      - name: 🚢 Push image
+        run: ./docker/push

R/api.R

@@ -55,7 +55,7 @@ target_post_dataset <- function(req, res) {
 
 target_get_dataset <- function(name, req) {
   logger::log_info(paste("Requesting metadata for dataset:", name))
-  dataset <- read_dataset(req, name)
+  dataset <- read_dataset(req, name, "natural")
   logger::log_info(paste("Found dataset:", name))
   dat <- dataset$data
   xcol <- dataset$xcol
@@ -90,10 +90,11 @@ target_get_trace <- function(name,
                              biomarker,
                              req,
                              filter = NULL,
-                             disaggregate = NULL) {
+                             disaggregate = NULL,
+                             scale = "natural") {
   logger::log_info(paste("Requesting data from", name,
                          "with biomarker", biomarker))
-  dataset <- read_dataset(req, name)
+  dataset <- read_dataset(req, name, scale)
   dat <- dataset$data
   xcol <- dataset$xcol
   cols <- colnames(dat)
@@ -128,7 +129,8 @@ target_get_trace <- function(name,
   }
 }
 
-read_dataset <- function(req, name) {
+read_dataset <- function(req, name, scale) {
+  validate_scale(scale)
   session_id <- get_or_create_session_id(req)
   path <- file.path("uploads", session_id, name)
   if (!file.exists(path)) {
@@ -137,6 +139,12 @@ read_dataset <- function(req, name) {
   }
   dat <- utils::read.csv(file.path(path, "data"))
   dat$value <- as.numeric(dat$value)
+  if (scale == "log") {
+    dat$value <- log(dat$value)
+  }
+  if (scale == "log2") {
+    dat$value <- log2(dat$value)
+  }
   xcol <- readLines(file.path(path, "xcol"))
   list(data = dat, xcol = xcol)
 }
@@ -199,8 +207,7 @@ generate_session_id <- function() {
                                            replace = TRUE))))))
 }
 
-response_success <- function(data)
-{
+response_success <- function(data) {
   list(status = jsonlite::unbox("success"), errors = NULL,
        data = data)
-}
+}

R/router.R

@@ -78,7 +78,8 @@ get_trace <- function() {
     "/dataset/<name>/trace/<biomarker>/",
     target_get_trace,
     porcelain::porcelain_input_query(disaggregate = "string",
-                                     filter = "string"),
+                                     filter = "string",
+                                     scale = "string"),
     returning = porcelain::porcelain_returning_json("DataSeries"))
 }
 

R/utils.R

@@ -10,3 +10,11 @@ with_warnings <- function(expr) {
   list(output = val,
        warnings = my_warnings)
 }
+
+validate_scale <- function(scale) {
+  if (!(scale %in% c("log", "log2", "natural"))) {
+    porcelain::porcelain_stop(
+      "'scale' must be one of 'log', 'log2', or 'natural'"
+    )
+  }
+}

README.md

@@ -1,9 +1,11 @@
 # serovizr
 
 <!-- badges: start -->
-[![Project Status: Concept – Minimal or no implementation has been done yet, or the repository is only intended to be a limited example, demo, or proof-of-concept.](https://www.repostatus.org/badges/latest/concept.svg)](https://www.repostatus.org/#concept)
+[![Project Status: WIP – Initial development is in progress, but there has not yet been a stable, usable release suitable for the public.](https://www.repostatus.org/badges/latest/wip.svg)](https://www.repostatus.org/#wip)
 [![R-CMD-check.yaml](https://github.com/seroanalytics/serovizr/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/seroanalytics/serovizr/actions/workflows/R-CMD-check.yaml)
 [![codecov](https://codecov.io/gh/seroanalytics/serovizr/graph/badge.svg?token=oFACWrbYep)](https://codecov.io/gh/seroanalytics/serovizr)
+![Docker Image Version](https://img.shields.io/docker/v/seroanalytics/serovizr?logo=docker)
+![GitHub License](https://img.shields.io/github/license/seroanalytics/serovizr)
 <!-- badges: end -->
 
 R API for the SeroViz app. Based on the [porcelain](https://github.com/reside-ic/porcelain) framework.
@@ -37,11 +39,23 @@ To build a Docker image:
 ./docker/build
 ```
 
+To push to Dockerhub:
+
+``` r
+./docker/push
+```
+
+
 To run a built image:
 
 ``` r
  docker run -p 8888:8888 seroanalytics/serovizr:<branch-name>
 ```
 
+These steps are run on CI.
+
 For a complete list of available tags, see Dockerhub: 
 https://hub.docker.com/repository/docker/seroanalytics/serovizr/tags
+
+The API is deployed along with the SeroViz app itself; see:
+https://github.com/seroanalytics/seroviz?tab=readme-ov-file#deployment

docker/smoke-test

@@ -0,0 +1,34 @@
+#!/usr/bin/env bash
+
+HERE=$(realpath  "$(dirname $0)")
+. $HERE/common
+
+wait_for()
+{
+    echo "waiting up to $TIMEOUT seconds for app"
+    start_ts=$(date +%s)
+    for i in $(seq $TIMEOUT); do
+        result="$(curl --write-out %{http_code} --silent --output /dev/null http://localhost:8888 2>/dev/null)"
+        if [[ $result -eq "200" ]]; then
+            end_ts=$(date +%s)
+            echo "App available after $((end_ts - start_ts)) seconds"
+            break
+        fi
+        sleep 1
+        echo "...still waiting"
+    done
+    return $result
+}
+
+docker run -d -p 8888:8888 $DOCKER_COMMIT_TAG
+
+# The variable expansion below is 60s by default, or the argument provided
+# to this script
+TIMEOUT="${1:-60}"
+wait_for
+RESULT=$?
+if [[ $RESULT -ne 200 ]]; then
+  echo "App did not become available in time"
+  exit 1
+fi
+exit 0

tests/testthat/test-read.R

@@ -71,6 +71,25 @@ test_that("can get trace for uploaded dataset with xcol", {
   expect_equal(body$data, jsonlite::fromJSON(expected))
 })
 
+test_that("GET /trace/<biomarker>?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/trace/ab/",
+                              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 disgagregated traces", {
   dat <- data.frame(biomarker = "ab",
                     value = 1,
@@ -163,3 +182,48 @@ test_that("can get disaggregated and filtered traces", {
   expect_equal(data$raw[2, "x"], list(c(3, 7, 11, 15, 19)))
   expect_equal(data$raw[2, "y"], list(c(2, 2, 2, 2, 2)))
 })
+
+test_that("can get log data", {
+  dat <- data.frame(biomarker = "ab",
+                    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/trace/ab/",
+                              qs = "scale=log",
+                              HTTP_COOKIE = cookie))
+  expect_equal(res$status, 200)
+  body <- jsonlite::fromJSON(res$body)
+  data <- body$data
+  expect_equal(nrow(data), 1)
+  expect_equal(data$name, "all")
+  expect_equal(data$raw[1, "x"], list(1:5))
+  expect_equal(unlist(data$raw[1, "y"]),
+               jsonlite::fromJSON(
+                 jsonlite::toJSON(log(1:5)) # convert to/from json for consistent rounding
+               ))
+})
+
+test_that("can get log2 data", {
+  dat <- data.frame(biomarker = "ab",
+                    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/trace/ab/",
+                              qs = "scale=log2",
+                              HTTP_COOKIE = cookie))
+  expect_equal(res$status, 200)
+  body <- jsonlite::fromJSON(res$body)
+  data <- body$data
+  expect_equal(nrow(data), 1)
+  expect_equal(data$name, "all")
+  expect_equal(data$raw[1, "x"], list(1:5))
+  expect_equal(unlist(data$raw[1, "y"]),
+               jsonlite::fromJSON(
+                 jsonlite::toJSON(log2(1:5)) # convert to/from json for consistent rounding
+               ))
+})
+