Enable tests on CI

.github/workflows/check.yaml

@@ -6,55 +6,55 @@ on:
     branches:
       - main
 
-name: check
-
 jobs:
-  check:
-    runs-on: ${{ matrix.config.os }}
-
-    name: ${{ matrix.config.os }} (${{ matrix.config.r }})
+  R-CMD-check:
+    name: R CMD check (${{ matrix.os }})
+    runs-on: ${{ matrix.os }}
 
     strategy:
       fail-fast: false
       matrix:
-        config:
-          - {os: macOS-latest,   r: 'release'}
-          - {os: windows-latest, r: 'release'}
-          - {os: ubuntu-latest,  r: 'devel', http-user-agent: 'release'}
-          - {os: ubuntu-latest,  r: 'release'}
-          - {os: ubuntu-latest,  r: 'oldrel-1'}
-
-    env:
-      R_REMOTES_NO_ERRORS_FROM_WARNINGS: true
-      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
-      R_KEEP_PKG_SOURCE: yes
+         os: ['ubuntu-latest']
 
     steps:
-      - uses: actions/checkout@v2
-
-      - uses: r-lib/actions/setup-tinytex@v2
-      - run: tlmgr --version
-
-      - uses: r-lib/actions/setup-pandoc@v2
-
-      - uses: r-lib/actions/setup-r@v2
-        with:
-          r-version: ${{ matrix.config.r }}
-          http-user-agent: ${{ matrix.config.http-user-agent }}
-          use-public-rspm: true
-
-      - uses: r-lib/actions/setup-r-dependencies@v2
+      - uses: actions/checkout@v4
+      - name: Set up Conda env
+        uses: mamba-org/provision-with-micromamba@e2b397b12d0a38069451664382b769c9456e3d6d
         with:
-          extra-packages: |
-            any::rcmdcheck
-            eth-mds/mimic-demo
-            eth-mds/eicu-demo
-            nbenn/mockthat
-
-      - uses: r-lib/actions/check-r-package@v2
+          cache-env: true
+      - name: Install TinyTex
+        shell: bash -l {0}
+        run: |
+          Rscript -e 'tinytex::install_tinytex()'
+      - name: Install demo datasets
+        shell: bash -l {0}
+        run: |
+          Rscript -e 'install.packages("eicu.demo", repos="https://eth-mds.github.io/physionet-demo")'
+      - name: Run R CMD check
+        shell: bash -l {0}
+        run: |
+          R CMD build . && R CMD check --no-manual --as-cran $(ls -t . | head -n1)
         env:
           _R_CHECK_CRAN_INCOMING_: false
           _R_CHECK_FORCE_SUGGESTS_: false
-          _R_CHECK_DOC_SIZES_: false
-        with:
-          upload-snapshots: true
+      # R CMD check raises a warning by qpdf that the generated docs PDF is large and
+      # should be compressed. Currently we ignore this warning via the grep below.
+      - name: Check for warnings
+        shell: bash -l {0}
+        run: |
+          CHECK_LOG_FILE=ricu.Rcheck/00check.log
+          CHECK_INSTALL_FILE=ricu.Rcheck/00install.out
+          if ! [[ -f "$CHECK_LOG_FILE" ]]; then
+            echo "Log-file not found."
+            exit 1
+          fi
+          if cat $CHECK_LOG_FILE | grep -q "ERROR"; then
+            cat $CHECK_INSTALL_FILE
+            cat $CHECK_LOG_FILE
+            exit 1
+          fi
+          if cat $CHECK_LOG_FILE | grep -q "WARNING" | grep -q -v -e "checking sizes of PDF files under ‘inst/doc’ ... WARNING"; then
+            echo "Found warnings, treated as errors."
+            cat $CHECK_LOG_FILE
+            exit 1
+          fi

DESCRIPTION

@@ -70,7 +70,7 @@ Suggests:
     pdftools,
     magick,
     pillar
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 Additional_repositories: https://eth-mds.github.io/physionet-demo
 VignetteBuilder: knitr
 Config/testthat/edition: 3

NAMESPACE

@@ -92,12 +92,14 @@ S3method(do_callback,fun_itm)
 S3method(do_callback,hrd_itm)
 S3method(do_callback,itm)
 S3method(do_callback,rec_cncpt)
+S3method(do_callback,sic_itm)
 S3method(do_itm_load,col_itm)
 S3method(do_itm_load,default)
 S3method(do_itm_load,fun_itm)
 S3method(do_itm_load,hrd_itm)
 S3method(do_itm_load,itm)
 S3method(do_itm_load,nul_itm)
+S3method(do_itm_load,sic_itm)
 S3method(downgrade_id,default)
 S3method(downgrade_id,id_tbl)
 S3method(downgrade_id,ts_tbl)
@@ -126,6 +128,7 @@ S3method(id_map_helper,default)
 S3method(id_map_helper,src_env)
 S3method(id_orig_helper,default)
 S3method(id_orig_helper,miiv_env)
+S3method(id_orig_helper,sic_env)
 S3method(id_orig_helper,src_env)
 S3method(id_vars,col_cfg)
 S3method(id_vars,default)
@@ -139,6 +142,7 @@ S3method(id_win_helper,eicu_env)
 S3method(id_win_helper,hirid_env)
 S3method(id_win_helper,miiv_env)
 S3method(id_win_helper,mimic_env)
+S3method(id_win_helper,picdb_env)
 S3method(id_win_helper,sic_env)
 S3method(import_src,aumc_cfg)
 S3method(import_src,character)
@@ -164,6 +168,7 @@ S3method(init_itm,hrd_itm)
 S3method(init_itm,itm)
 S3method(init_itm,rgx_itm)
 S3method(init_itm,sel_itm)
+S3method(init_itm,sic_itm)
 S3method(interval,default)
 S3method(interval,difftime)
 S3method(interval,itm)
@@ -188,6 +193,7 @@ S3method(load_difftime,eicu_tbl)
 S3method(load_difftime,hirid_tbl)
 S3method(load_difftime,miiv_tbl)
 S3method(load_difftime,mimic_tbl)
+S3method(load_difftime,picdb_tbl)
 S3method(load_difftime,sic_tbl)
 S3method(load_id,character)
 S3method(load_id,default)
@@ -232,6 +238,7 @@ S3method(prepare_query,default)
 S3method(prepare_query,hrd_itm)
 S3method(prepare_query,rgx_itm)
 S3method(prepare_query,sel_itm)
+S3method(prepare_query,sic_itm)
 S3method(print,cncpt)
 S3method(print,id_tbl)
 S3method(print,itm)

R/callback-itm.R

@@ -43,6 +43,25 @@ mimic_sampling <- function(x, val_var, aux_time, ...) {
   set(x, j = val_var, value = !is.na(x[[val_var]]))
 }
 
+picdb_sampling <- function(x, val_var, aux_time, ...) {
+  x <- combine_date_time(x, aux_time, hours(12L))
+
+  # These identifiers indicate that the culture showed no growth
+  # of the respective organism
+  no_growth_identifiers <- c('MIC1008', 'MIC2123', 'MIC2287', 'MIC2291', 'MIC2293',
+    'MIC2370', 'MIC2408', 'MIC2421', 'MIC575',
+    'MIC585', 'MIC593', 'MIC629', 'MIC631',
+    'MIC635', 'MIC637', 'MIC645', 'MIC648',
+    'MIC874', 'MIC941', 'MIC979'
+  )
+
+  # Assign:
+  # - 0 if NA or in no_growth_identifiers
+  # - 1 otherwise, indicating growth
+  bool_value <- !is.na(x[[val_var]]) & !(x[[val_var]] %in% no_growth_identifiers)
+  set(x, j = val_var, value = bool_value)
+}
+
 #' Item callback utilities
 #'
 #' For concept loading, item callback functions are used in order to handle
@@ -610,18 +629,24 @@ aumc_rate_units <- function(mcg_to_units) {
 }
 
 sic_dur <- function (x, val_var, stop_var, grp_var = NULL, ...) {
-
   calc_dur(x, val_var, index_var(x), stop_var, grp_var)
 }
 
-sic_rate_kg <- function (x, val_var, stop_var, env, ...) {
-
-  res <- add_weight(x, env, "weight")
-  wgh_var <- "weight"
-  res[, c(val_var) := get(val_var) * 10^3 / get(wgh_var)]
-  expand(res, index_var(x), stop_var, keep_vars = c(id_vars(x), val_var))
+sic_rate_kg <- function(x, val_var, unit_var, stop_var, env, ...) {
+
+  g_to_mcg <- convert_unit(binary_op(`*`, 1000000), "mcg", "g")
+
+  res <- g_to_mcg(x, val_var, unit_var)
+  res <- add_weight(res, env, "weight")
+
+  res <- res[, c(val_var) := get(val_var) / get("weight")]
+  res <- res[, c(unit_var) := paste(get(unit_var), "min", sep = "/kg/")]
+
+  expand(res, index_var(x), stop_var,
+         keep_vars = c(id_vars(x), val_var, unit_var))
 }
 
+
 eicu_duration <- function(gap_length) {
 
   assert_that(is_interval(gap_length), is_scalar(gap_length))
@@ -643,6 +668,15 @@ aumc_dur <- function(x, val_var, stop_var, grp_var, ...) {
   calc_dur(x, val_var, index_var(x), stop_var, grp_var)
 }
 
+default_duration <- function(x, val_var, stop_var, grp_var, ...) {
+  calc_dur(x, val_var, index_var(x), stop_var, grp_var)
+}
+
+no_duration <- function(x, val_var, grp_var, ...) {
+  calc_dur(x, val_var, index_var(x), index_var(x), grp_var)
+}
+
+
 #' Used for determining vasopressor durations, `calc_dur()` will calculate
 #' durations by taking either per ID or per combination of ID and `grp_var`
 #' the minimum for `min_var` and the maximum of `max_var` and returning the
@@ -759,6 +793,13 @@ aumc_death <- function(x, val_var, ...) {
   x
 }
 
+sic_death <- function(x, val_var, adm_time, ...) {
+  idx <- index_var(x)
+
+  x <- x[, c(val_var) := is_true(get(idx) - (get(adm_time) + secs(get(val_var))) < hours(72L))]
+  x
+}
+
 aumc_bxs <- function(x, val_var, dir_var, ...) {
   x <- x[get(dir_var) == "-", c(val_var) := -1L * get(val_var)]
   x

R/callback-tbl.R

@@ -0,0 +1,36 @@
+
+sic_data_float_h <- function(dat, ...) {
+
+   hexstring_to_float <- function(x) {
+     if (is.na(x)) {
+       return(NA_real_)
+     }
+     hexstring <- substring(x, seq(1, 482, 2), seq(2, 482, 2))
+     bytes <- as.raw(strtoi(hexstring[-1], base = 16))
+     floats <- readBin(bytes, numeric(), length(bytes) %/% 4, 4, endian = "little")
+     ifelse(floats == 0, NA_real_, floats)
+   }
+
+   setDT(dat)
+
+   # TODO: remove hard coding of rawdata and derive from JSON config
+   dat[, c("rawdata") := lapply(get("rawdata"), hexstring_to_float)]
+   dat <- dat[, .(
+       Offset = Offset + 60 * (0:(sapply(rawdata, length)-1)),
+       Val = Val,
+       cnt = cnt,
+       rawdata = unlist(rawdata),
+       rawdata_present = !is.na(rawdata)
+     ),
+     by = .(id, CaseID, DataID)
+   ]
+
+    # Fix measurements that only have one value
+   dat[rawdata_present == FALSE, rawdata := Val]
+   dat[, rawdata_present := NULL]
+
+   return(dat)
+
+}
+
+