From c72dc118cde3c57d48dfdf711adb91471ed49691 Mon Sep 17 00:00:00 2001
From: Tim Cadman <41470917+timcadman@users.noreply.github.com>
Date: Tue, 31 Mar 2026 13:40:39 +0200
Subject: [PATCH 01/12] refactor: replace eval(parse()) with
 .loadServersideObject()

---
 R/classDS.R         |  8 +-------
 R/completeCasesDS.R |  5 ++---
 R/namesDS.R         | 12 ++++++------
 R/uniqueDS.R        | 17 +----------------
 4 files changed, 10 insertions(+), 32 deletions(-)

diff --git a/R/classDS.R b/R/classDS.R
index 16720b80..db8a907a 100644
--- a/R/classDS.R
+++ b/R/classDS.R
@@ -8,15 +8,9 @@
 #' @export
 #'
 classDS <- function(x){
-
-  x.val <- eval(parse(text=x), envir = parent.frame())
-
-  # find the class of the input object
+  x.val <- .loadServersideObject(x)
   out <- class(x.val)
-
-  # return the class
   return(out)
-
 }
 #AGGREGATE FUNCTION
 # classDS
diff --git a/R/completeCasesDS.R b/R/completeCasesDS.R
index 6e1837f6..a85222cd 100644
--- a/R/completeCasesDS.R
+++ b/R/completeCasesDS.R
@@ -111,10 +111,9 @@ completeCasesDS <- function(x1.transmit){
   }
 
   #Activate target object
-  #x1.transmit is the name of a serverside data.frame, matrix or vector
-  x1.use <- eval(parse(text=x1.transmit), envir = parent.frame())
+  x1.use <- .loadServersideObject(x1.transmit)
   complete.rows <- stats::complete.cases(x1.use)
-  
+
   if(is.matrix(x1.use) || is.data.frame(x1.use)){
     output.object <- x1.use[complete.rows,]
   }else if(is.atomic(x1.use) || is.factor(x1.use)){
diff --git a/R/namesDS.R b/R/namesDS.R
index 144c7270..6193817f 100644
--- a/R/namesDS.R
+++ b/R/namesDS.R
@@ -50,14 +50,14 @@ nfilter.stringShort<-as.numeric(thr$nfilter.stringShort)                #
     stop(studysideMessage, call. = FALSE)
   }
 
-  list.obj<-eval(parse(text=xname.transmit), envir = parent.frame())
-
-  trace.message<-class(list.obj)
-
+  list.obj <- .loadServersideObject(xname.transmit)
 
   if(!is.list(list.obj)){
-    error.message <- "The input object is not of class <list>"
-    stop(paste0(error.message,trace.message), call. = FALSE)
+    stop(
+      "The input object is not of class <list>. '", xname.transmit, "' is type ",
+      paste(class(list.obj), collapse = ", "),
+      call. = FALSE
+    )
   }
 
 
diff --git a/R/uniqueDS.R b/R/uniqueDS.R
index 6834ff8a..2b8f0095 100644
--- a/R/uniqueDS.R
+++ b/R/uniqueDS.R
@@ -9,23 +9,8 @@
 #' @export
 #'
 uniqueDS <- function(x.name.transmit = NULL){
-    # Check 'x.name.transmit' contains a name
-    if (is.null(x.name.transmit))
-        stop("Variable's name can't be NULL", call. = FALSE)
-
-    if ((! is.character(x.name.transmit)) || (length(x.name.transmit) != 1))
-        stop("Variable's name isn't a single character vector", call. = FALSE)
-
-    # Check object exists
-    x.value <- eval(parse(text=x.name.transmit), envir = parent.frame())
-
-    if (is.null(x.value))
-        stop("Variable can't be NULL", call. = FALSE)
-
-    # Compute the unique's value
+    x.value <- .loadServersideObject(x.name.transmit)
     out <- base::unique(x.value)
-
-    # assign the outcome to the data servers
     return(out)
 }
 # ASSIGN FUNCTION

From 4b67c4a746587311999e8f9d642f6b4f9594ccdd Mon Sep 17 00:00:00 2001
From: Tim Cadman <41470917+timcadman@users.noreply.github.com>
Date: Tue, 31 Mar 2026 13:40:55 +0200
Subject: [PATCH 02/12] refactor: dimDS/lengthDS return class for client-side
 consistency check

---
 R/dimDS.R       | 15 +++++----------
 R/lengthDS.R    | 16 ++++++----------
 man/dimDS.Rd    |  3 ++-
 man/lengthDS.Rd |  4 +++-
 4 files changed, 16 insertions(+), 22 deletions(-)

diff --git a/R/dimDS.R b/R/dimDS.R
index 3b51ed49..74f16df4 100644
--- a/R/dimDS.R
+++ b/R/dimDS.R
@@ -3,20 +3,15 @@
 #' @description This function is similar to R function \code{dim}.
 #' @details The function returns the dimension of the input dataframe or matrix
 #' @param x a string character, the name of a dataframe or matrix
-#' @return the dimension of the input object
+#' @return a list with two elements: \code{dim} (the dimension of the input object)
+#'   and \code{class} (the class of the input object, for client-side consistency checking)
 #' @author Demetris Avraam, for DataSHIELD Development Team
 #' @export
 #'
 dimDS <- function(x){
-
-  x.var <- eval(parse(text=x), envir = parent.frame())
-
-  # find the dim of the input dataframe or matrix
-  out <- dim(x.var)
-
-  # return the dimension
-  return(out)
-
+  x.val <- .loadServersideObject(x)
+  .checkClass(obj = x.val, obj_name = x, permitted_classes = c("data.frame", "matrix"))
+  list(dim = dim(x.val), class = class(x.val))
 }
 #AGGREGATE FUNCTION
 # dimDS
diff --git a/R/lengthDS.R b/R/lengthDS.R
index 7e4b8997..fe1c22d6 100644
--- a/R/lengthDS.R
+++ b/R/lengthDS.R
@@ -3,20 +3,16 @@
 #' @description This function is similar to R function \code{length}.
 #' @details The function returns the length of the input vector or list.
 #' @param x a string character, the name of a vector or list
-#' @return a numeric, the number of elements of the input vector or list.
+#' @return a list with two elements: \code{length} (the number of elements of the input
+#'   vector or list) and \code{class} (the class of the input object, for client-side
+#'   consistency checking)
 #' @author Demetris Avraam, for DataSHIELD Development Team
 #' @export
 #'
 lengthDS <- function(x){
-
-  x.var <- eval(parse(text=x), envir = parent.frame())
-
-  # find the length of the input vector or list
-  out <- length(x.var)
-
-  # return output length
-  return(out)
-
+  x.val <- .loadServersideObject(x)
+  .checkClass(obj = x.val, obj_name = x, permitted_classes = c("character", "factor", "integer", "logical", "numeric", "list"))
+  list(length = length(x.val), class = class(x.val))
 }
 #AGGREGATE FUNCTION
 # lengthDS
diff --git a/man/dimDS.Rd b/man/dimDS.Rd
index c14d82af..1fbac2bf 100644
--- a/man/dimDS.Rd
+++ b/man/dimDS.Rd
@@ -10,7 +10,8 @@ dimDS(x)
 \item{x}{a string character, the name of a dataframe or matrix}
 }
 \value{
-the dimension of the input object
+a list with two elements: \code{dim} (the dimension of the input object)
+  and \code{class} (the class of the input object, for client-side consistency checking)
 }
 \description{
 This function is similar to R function \code{dim}.
diff --git a/man/lengthDS.Rd b/man/lengthDS.Rd
index 75498994..bfadf14f 100644
--- a/man/lengthDS.Rd
+++ b/man/lengthDS.Rd
@@ -10,7 +10,9 @@ lengthDS(x)
 \item{x}{a string character, the name of a vector or list}
 }
 \value{
-a numeric, the number of elements of the input vector or list.
+a list with two elements: \code{length} (the number of elements of the input
+  vector or list) and \code{class} (the class of the input object, for client-side
+  consistency checking)
 }
 \description{
 This function is similar to R function \code{length}.

From 2c2c9f52da9acc7b9dfc0bec489bbe2ad3fe72c4 Mon Sep 17 00:00:00 2001
From: Tim Cadman <41470917+timcadman@users.noreply.github.com>
Date: Tue, 31 Mar 2026 13:41:02 +0200
Subject: [PATCH 03/12] refactor: isNaDS/numNaDS/levelsDS accept string name
 via .loadServersideObject()

---
 R/isNaDS.R     | 17 +++++++++--------
 R/levelsDS.R   | 21 ++++++++-------------
 R/numNaDS.R    | 15 +++++++--------
 man/isNaDS.Rd  |  8 ++++----
 man/numNaDS.Rd |  6 +++---
 5 files changed, 31 insertions(+), 36 deletions(-)

diff --git a/R/isNaDS.R b/R/isNaDS.R
index 917c420b..f1c2c461 100644
--- a/R/isNaDS.R
+++ b/R/isNaDS.R
@@ -1,17 +1,18 @@
-#' 
-#' @title Checks if a vector is empty 
-#' @description this function is similar to R function \code{is.na} but instead of a vector 
+#'
+#' @title Checks if a vector is empty
+#' @description this function is similar to R function \code{is.na} but instead of a vector
 #' of booleans it returns just one boolean to tell if all the element are missing values.
-#' @param xvect a numerical or character vector
-#' @return the integer '1' if the vector contains on NAs and '0'  otherwise
+#' @param x a character string, the name of a server-side vector
+#' @return TRUE if the vector contains only NAs, FALSE otherwise
 #' @author Gaye, A.
 #' @export
 #'
-isNaDS <- function(xvect){
-  
+isNaDS <- function(x){
+  xvect <- .loadServersideObject(x)
+  .checkClass(obj = xvect, obj_name = x, permitted_classes = c("character", "factor", "integer", "logical", "numeric", "data.frame", "matrix"))
   out <- is.na(xvect)
   total <- sum(out, na.rm=TRUE)
-  if(total==(1*length(out))){
+  if(total == (1 * length(out))){
     return(TRUE)
   }else{
     return(FALSE)
diff --git a/R/levelsDS.R b/R/levelsDS.R
index bdb374d5..5e827f1e 100644
--- a/R/levelsDS.R
+++ b/R/levelsDS.R
@@ -8,27 +8,22 @@
 #' @export
 #'
 levelsDS <- function(x){
-  
+
+  x.val <- .loadServersideObject(x)
+  .checkClass(obj = x.val, obj_name = x, permitted_classes = "factor")
+
   # Check Permissive Privacy Control Level.
   dsBase::checkPermissivePrivacyControlLevel(c('permissive', 'banana', 'carrot'))
-  
+
   ##################################################################
   #MODULE 1: CAPTURE THE nfilter SETTINGS                          #
   thr <- dsBase::listDisclosureSettingsDS()                        #
-  #nfilter.tab <- as.numeric(thr$nfilter.tab)                      #
-  #nfilter.glm <- as.numeric(thr$nfilter.glm)                      #
-  #nfilter.subset <- as.numeric(thr$nfilter.subset)                #
-  #nfilter.string <- as.numeric(thr$nfilter.string)                #
-  #nfilter.stringShort <- as.numeric(thr$nfilter.stringShort)      #
-  #nfilter.kNN <- as.numeric(thr$nfilter.kNN)                      #
-  #nfilter.noise <- as.numeric(thr$nfilter.noise)                  #
   nfilter.levels.density <- as.numeric(thr$nfilter.levels.density) #
-  #nfilter.levels.max <- as.numeric(thr$nfilter.levels.max)        #
   ##################################################################
-  
+
   # find the levels of the input vector
-  out <- levels(x)
-  input.length     <- length(x)
+  out <- levels(x.val)
+  input.length     <- length(x.val)
   output.length    <- length(out)
   studysideMessage <- "VALID ANALYSIS"
 
diff --git a/R/numNaDS.R b/R/numNaDS.R
index 5f369b90..4c85c5bc 100644
--- a/R/numNaDS.R
+++ b/R/numNaDS.R
@@ -1,15 +1,14 @@
-#' 
+#'
 #' @title Counts the number of missing values
-#' @description this function just counts the number of missing entries 
-#' in a vector. 
-#' @param xvect a vector
+#' @description this function just counts the number of missing entries
+#' in a vector.
+#' @param x a character string, the name of a server-side vector
 #' @return an integer, the number of missing values
 #' @author Gaye, A.
 #' @export
 #'
-numNaDS <- function(xvect){
-  
+numNaDS <- function(x){
+  xvect <- .loadServersideObject(x)
   out <- length(which(is.na(xvect)))
-  return (out)
-  
+  return(out)
 }
diff --git a/man/isNaDS.Rd b/man/isNaDS.Rd
index b4954850..6ed52393 100644
--- a/man/isNaDS.Rd
+++ b/man/isNaDS.Rd
@@ -4,16 +4,16 @@
 \alias{isNaDS}
 \title{Checks if a vector is empty}
 \usage{
-isNaDS(xvect)
+isNaDS(x)
 }
 \arguments{
-\item{xvect}{a numerical or character vector}
+\item{x}{a character string, the name of a server-side vector}
 }
 \value{
-the integer '1' if the vector contains on NAs and '0'  otherwise
+TRUE if the vector contains only NAs, FALSE otherwise
 }
 \description{
-this function is similar to R function \code{is.na} but instead of a vector 
+this function is similar to R function \code{is.na} but instead of a vector
 of booleans it returns just one boolean to tell if all the element are missing values.
 }
 \author{
diff --git a/man/numNaDS.Rd b/man/numNaDS.Rd
index 0162a630..cc5256f3 100644
--- a/man/numNaDS.Rd
+++ b/man/numNaDS.Rd
@@ -4,16 +4,16 @@
 \alias{numNaDS}
 \title{Counts the number of missing values}
 \usage{
-numNaDS(xvect)
+numNaDS(x)
 }
 \arguments{
-\item{xvect}{a vector}
+\item{x}{a character string, the name of a server-side vector}
 }
 \value{
 an integer, the number of missing values
 }
 \description{
-this function just counts the number of missing entries 
+this function just counts the number of missing entries
 in a vector.
 }
 \author{

From ac3747ef577199059ffdb4eee5534c9ece058f01 Mon Sep 17 00:00:00 2001
From: Tim Cadman <41470917+timcadman@users.noreply.github.com>
Date: Tue, 31 Mar 2026 14:46:40 +0200
Subject: [PATCH 04/12] test: update batch 2 tests for refactored server
 functions

---
 tests/testthat/test-arg-uniqueDS.R        | 20 ++++------
 tests/testthat/test-smk-classDS.R         |  7 ++++
 tests/testthat/test-smk-completeCasesDS.R |  7 ++++
 tests/testthat/test-smk-dimDS.R           | 41 ++++++++++++++++----
 tests/testthat/test-smk-isNaDS.R          | 19 ++++++---
 tests/testthat/test-smk-lengthDS.R        | 47 +++++++++++++----------
 tests/testthat/test-smk-levelsDS.R        | 17 +++++++-
 tests/testthat/test-smk-namesDS.R         | 15 ++++++++
 tests/testthat/test-smk-numNaDS.R         | 13 +++++--
 9 files changed, 135 insertions(+), 51 deletions(-)

diff --git a/tests/testthat/test-arg-uniqueDS.R b/tests/testthat/test-arg-uniqueDS.R
index 48d6bd48..bff02d5d 100644
--- a/tests/testthat/test-arg-uniqueDS.R
+++ b/tests/testthat/test-arg-uniqueDS.R
@@ -19,25 +19,19 @@
 # Tests
 #
 
-# context("uniqueDS::arg::simple null argument")
-test_that("simple uniqueDS for NULL", {
-    expect_error(uniqueDS(NULL), "Variable's name can't be NULL", fixed = TRUE)
-})
-
-# context("uniqueDS::arg::null value")
-test_that("simple uniqueDS for NULL", {
-    input <- NULL
-    expect_error(uniqueDS("input"), "Variable can't be NULL", fixed = TRUE)
+# context("uniqueDS::arg::null argument")
+test_that("uniqueDS errors for NULL argument", {
+    expect_error(uniqueDS(NULL), "must be a single character string", fixed = TRUE)
 })
 
 # context("uniqueDS::arg::not character value")
-test_that("simple uniqueDS for NULL", {
-  expect_error(uniqueDS(17), "Variable's name isn't a single character vector", fixed = TRUE)
+test_that("uniqueDS errors for non-character argument", {
+    expect_error(uniqueDS(17), "must be a single character string", fixed = TRUE)
 })
 
 # context("uniqueDS::arg::missing value")
-test_that("simple uniqueDS for NULL", {
-    expect_error(uniqueDS("input"), "object 'input' not found", fixed = TRUE)
+test_that("uniqueDS errors for nonexistent object", {
+    expect_error(uniqueDS("nonexistent_object"), "does not exist")
 })
 
 #
diff --git a/tests/testthat/test-smk-classDS.R b/tests/testthat/test-smk-classDS.R
index d2efcf40..a3eb79d3 100644
--- a/tests/testthat/test-smk-classDS.R
+++ b/tests/testthat/test-smk-classDS.R
@@ -230,6 +230,13 @@ test_that("special classDS, NULL", {
     expect_equal(res, "NULL")
 })
 
+test_that("classDS throws error when object does not exist", {
+    expect_error(
+        classDS("nonexistent_object"),
+        regexp = "does not exist"
+    )
+})
+
 #
 # Done
 #
diff --git a/tests/testthat/test-smk-completeCasesDS.R b/tests/testthat/test-smk-completeCasesDS.R
index 2ba7b913..81ca9e29 100644
--- a/tests/testthat/test-smk-completeCasesDS.R
+++ b/tests/testthat/test-smk-completeCasesDS.R
@@ -190,6 +190,13 @@ test_that("simple completeCasesDS, data.matrix, with NAs", {
     expect_equal(res.colnames[2], "v2")
 })
 
+test_that("completeCasesDS throws error when object does not exist", {
+    expect_error(
+        completeCasesDS("nonexistent_object"),
+        regexp = "does not exist"
+    )
+})
+
 #
 # Done
 #
diff --git a/tests/testthat/test-smk-dimDS.R b/tests/testthat/test-smk-dimDS.R
index 7915e9a1..c45d07fb 100644
--- a/tests/testthat/test-smk-dimDS.R
+++ b/tests/testthat/test-smk-dimDS.R
@@ -25,10 +25,10 @@ test_that("numeric dimDS", {
 
     res <- dimDS("input")
 
-    expect_length(res, 2)
-    expect_equal(class(res), "integer")
-    expect_equal(res[1], 5)
-    expect_equal(res[2], 2)
+    expect_equal(class(res), "list")
+    expect_equal(res$dim[1], 5)
+    expect_equal(res$dim[2], 2)
+    expect_equal(res$class, "data.frame")
 })
 
 # context("dimDS::smk::character")
@@ -37,10 +37,35 @@ test_that("character dimDS", {
 
     res <- dimDS("input")
 
-    expect_length(res, 2)
-    expect_equal(class(res), "integer")
-    expect_equal(res[1], 5)
-    expect_equal(res[2], 2)
+    expect_equal(class(res), "list")
+    expect_equal(res$dim[1], 5)
+    expect_equal(res$dim[2], 2)
+    expect_equal(res$class, "data.frame")
+})
+
+test_that("dimDS with matrix", {
+    input <- matrix(1:6, nrow = 2, ncol = 3)
+
+    res <- dimDS("input")
+
+    expect_equal(res$dim[1], 2)
+    expect_equal(res$dim[2], 3)
+    expect_true("matrix" %in% res$class)
+})
+
+test_that("dimDS throws error when object does not exist", {
+    expect_error(
+        dimDS("nonexistent_object"),
+        regexp = "does not exist"
+    )
+})
+
+test_that("dimDS throws error when object is not data.frame or matrix", {
+    bad_input <- c(1, 2, 3)
+    expect_error(
+        dimDS("bad_input"),
+        regexp = "must be of type data.frame or matrix"
+    )
 })
 
 #
diff --git a/tests/testthat/test-smk-isNaDS.R b/tests/testthat/test-smk-isNaDS.R
index 766d513c..0cbdecd8 100644
--- a/tests/testthat/test-smk-isNaDS.R
+++ b/tests/testthat/test-smk-isNaDS.R
@@ -23,7 +23,7 @@
 test_that("numeric vector isNaDS", {
     input <- c(0.1, 1.1, 2.1, 3.1, 4.1)
 
-    res <- isNaDS(input)
+    res <- isNaDS("input")
 
     expect_length(res, 1)
     expect_equal(class(res), "logical")
@@ -33,7 +33,7 @@ test_that("numeric vector isNaDS", {
 test_that("numeric vector isNaDS - with NA single", {
     input <- c(0.1, NA, 2.1, 3.1, 4.1)
 
-    res <- isNaDS(input)
+    res <- isNaDS("input")
 
     expect_length(res, 1)
     expect_equal(class(res), "logical")
@@ -43,7 +43,7 @@ test_that("numeric vector isNaDS - with NA single", {
 test_that("numeric vector isNaDS - with NA all", {
     input <- c(NA, NA, NA, NA, NA)
 
-    res <- isNaDS(input)
+    res <- isNaDS("input")
 
     expect_length(res, 1)
     expect_equal(class(res), "logical")
@@ -54,7 +54,7 @@ test_that("numeric vector isNaDS - with NA all", {
 test_that("character vector isNaDS", {
     input <- c("101", "202", "303", "404", "505")
 
-    res <- isNaDS(input)
+    res <- isNaDS("input")
 
     expect_length(res, 1)
     expect_equal(class(res), "logical")
@@ -64,7 +64,7 @@ test_that("character vector isNaDS", {
 test_that("character vector isNaDS - with NA single", {
     input <- c("101", NA, "303", "404", "505")
 
-    res <- isNaDS(input)
+    res <- isNaDS("input")
 
     expect_length(res, 1)
     expect_equal(class(res), "logical")
@@ -74,13 +74,20 @@ test_that("character vector isNaDS - with NA single", {
 test_that("character vector isNaDS - with NA all", {
     input <- c(NA, NA, NA, NA, NA)
 
-    res <- isNaDS(input)
+    res <- isNaDS("input")
 
     expect_length(res, 1)
     expect_equal(class(res), "logical")
     expect_equal(res, TRUE)
 })
 
+test_that("isNaDS throws error when object does not exist", {
+    expect_error(
+        isNaDS("nonexistent_object"),
+        regexp = "does not exist"
+    )
+})
+
 #
 # Done
 #
diff --git a/tests/testthat/test-smk-lengthDS.R b/tests/testthat/test-smk-lengthDS.R
index b5fad0e7..67454a8b 100644
--- a/tests/testthat/test-smk-lengthDS.R
+++ b/tests/testthat/test-smk-lengthDS.R
@@ -19,42 +19,49 @@
 # Tests
 #
 
-# context("lengthDS::smk::data.frame")
-test_that("simple lengthDS, numeric data.frame", {
-    input <- data.frame(v1 = c(0.0, 1.0, 2.0, 3.0, 4.0), v2 = c(4.0, 3.0, 2.0, 1.0, 0.0))
+# context("lengthDS::smk::vector")
+test_that("simple lengthDS, numeric vector", {
+    input <- c(0.0, 1.0, 2.0, 3.0, 4.0)
 
     res <- lengthDS("input")
 
-    expect_equal(class(res), "integer")
-    expect_equal(res, 2)
+    expect_equal(class(res), "list")
+    expect_equal(res$length, 5)
+    expect_equal(res$class, "numeric")
 })
 
-test_that("simple lengthDS, character data.frame", {
-    input <- data.frame(v1 = c("0.0", "1.0", "2.0", "3.0", "4.0"), v2 = c("4.0", "3.0", "2.0", "1.0", "0.0"), stringsAsFactors = FALSE)
+test_that("simple lengthDS, character vector", {
+    input <- c("0.0", "1.0", "2.0", "3.0", "4.0")
 
     res <- lengthDS("input")
 
-    expect_equal(class(res), "integer")
-    expect_equal(res, 2)
+    expect_equal(class(res), "list")
+    expect_equal(res$length, 5)
+    expect_equal(res$class, "character")
 })
 
-# context("lengthDS::smk::vector")
-test_that("simple lengthDS, numeric vector", {
-    input <- c(0.0, 1.0, 2.0, 3.0, 4.0)
+test_that("simple lengthDS, list", {
+    input <- list(a = 1, b = 2, c = 3)
 
     res <- lengthDS("input")
 
-    expect_equal(class(res), "integer")
-    expect_equal(res, 5)
+    expect_equal(res$length, 3)
+    expect_equal(res$class, "list")
 })
 
-test_that("simple lengthDS, character vector", {
-    input <- c("0.0", "1.0", "2.0", "3.0", "4.0")
-
-    res <- lengthDS("input")
+test_that("lengthDS throws error when object does not exist", {
+    expect_error(
+        lengthDS("nonexistent_object"),
+        regexp = "does not exist"
+    )
+})
 
-    expect_equal(class(res), "integer")
-    expect_equal(res, 5)
+test_that("lengthDS throws error when object is not a permitted type", {
+    bad_input <- data.frame(a = 1:3)
+    expect_error(
+        lengthDS("bad_input"),
+        regexp = "must be of type"
+    )
 })
 
 #
diff --git a/tests/testthat/test-smk-levelsDS.R b/tests/testthat/test-smk-levelsDS.R
index 5ba10980..28949677 100644
--- a/tests/testthat/test-smk-levelsDS.R
+++ b/tests/testthat/test-smk-levelsDS.R
@@ -25,7 +25,7 @@ set.standard.disclosure.settings()
 test_that("numeric vector levelsDS", {
     input <- as.factor(c(0, 1, 2, 1, 2, 3, 1, 2, 1, 0, 1, 2, 0))
 
-    res <- levelsDS(input)
+    res <- levelsDS("input")
 
     expect_length(res, 2)
     expect_equal(class(res), "list")
@@ -39,6 +39,21 @@ test_that("numeric vector levelsDS", {
     expect_equal(res$ValidityMessage, "VALID ANALYSIS")
 })
 
+test_that("levelsDS throws error when object does not exist", {
+    expect_error(
+        levelsDS("nonexistent_object"),
+        regexp = "does not exist"
+    )
+})
+
+test_that("levelsDS throws error when object is not a factor", {
+    bad_input <- c(1, 2, 3)
+    expect_error(
+        levelsDS("bad_input"),
+        regexp = "must be of type factor"
+    )
+})
+
 #
 # Done
 #
diff --git a/tests/testthat/test-smk-namesDS.R b/tests/testthat/test-smk-namesDS.R
index dbc5f3b1..fe1134d5 100644
--- a/tests/testthat/test-smk-namesDS.R
+++ b/tests/testthat/test-smk-namesDS.R
@@ -45,6 +45,21 @@ test_that("simple namesDS, data.matrix", {
     expect_true("v2" %in% res)
 })
 
+test_that("namesDS throws error when object does not exist", {
+    expect_error(
+        namesDS("nonexistent_object"),
+        regexp = "does not exist"
+    )
+})
+
+test_that("namesDS throws error when object is not a list", {
+    bad_input <- c(1, 2, 3)
+    expect_error(
+        namesDS("bad_input"),
+        regexp = "not of class <list>"
+    )
+})
+
 #
 # Done
 #
diff --git a/tests/testthat/test-smk-numNaDS.R b/tests/testthat/test-smk-numNaDS.R
index c77db4ed..f050d3d8 100644
--- a/tests/testthat/test-smk-numNaDS.R
+++ b/tests/testthat/test-smk-numNaDS.R
@@ -23,23 +23,30 @@
 test_that("simple numNaDS", {
     input <- c(NA, 1, NA, 2, NA)
 
-    res <- numNaDS(input)
+    res <- numNaDS("input")
 
     expect_equal(class(res), "integer")
     expect_length(res, 1)
     expect_equal(res, 3)
 })
 
-test_that("simple numNaDS", {
+test_that("simple numNaDS, single NA", {
     input <- NA
 
-    res <- numNaDS(input)
+    res <- numNaDS("input")
 
     expect_equal(class(res), "integer")
     expect_length(res, 1)
     expect_equal(res, 1)
 })
 
+test_that("numNaDS throws error when object does not exist", {
+    expect_error(
+        numNaDS("nonexistent_object"),
+        regexp = "does not exist"
+    )
+})
+
 #
 # Done
 #

From 48b374a79042011cd1bc11e9dd9ecdc6289d2a68 Mon Sep 17 00:00:00 2001
From: Tim Cadman <41470917+timcadman@users.noreply.github.com>
Date: Mon, 13 Apr 2026 10:40:24 +0200
Subject: [PATCH 05/12] refactor: also return class for client-side consistency
 checks

---
 R/ihen_outcome.R | 64 ++++++++++++++++++++++++++++++++++++++++++++++++
 R/isNaDS.R       | 11 ++++-----
 R/levelsDS.R     |  6 +++--
 R/numNaDS.R      |  6 +++--
 4 files changed, 77 insertions(+), 10 deletions(-)
 create mode 100644 R/ihen_outcome.R

diff --git a/R/ihen_outcome.R b/R/ihen_outcome.R
new file mode 100644
index 00000000..4af38652
--- /dev/null
+++ b/R/ihen_outcome.R
@@ -0,0 +1,64 @@
+library(dplyr)
+library(tidyr)
+library(ggplot2)
+
+# --- Simplified Web Table 7 (with INMA + EDEN collapsed) ---
+bmi_data <- data.frame(
+  Cohort = c("RHEA","CHOP","SWS","GECKO","Raine","INMA","EDEN","GENR",
+             "ALSPAC","ABCD","NFBC66","NFBC86","BiB","ELFE","DNBC","MoBa"),
+  n0_1  = c(974,1668,2942,2738,2303,1910,1760,7230,1420,5669,7379,5141,12959,17795,56821,85079),
+  n2_3  = c(684,938,2701,2212,614,1177,1521,6466,1221,4763,5809,4739,6225,10773,0,45673),
+  n4_7  = c(887,1092,2166,2309,2088,1634,1278,6572,5682,4754,7268,7110,10539,10192,43164,49728),
+  n8_13 = c(334,755,1209,2180,1988,1043,904,5723,9585,3603,7239,4750,5592,3360,44177,33473),
+  n14_17= c(NA,NA,NA,NA,1623,NA,NA,NA,7675,NA,7035,5760,NA,NA,6508,NA)
+)
+
+# --- Reshape ---
+bmi_long <- bmi_data %>%
+  pivot_longer(cols = starts_with("n"), names_to = "Age_group", values_to = "n") %>%
+  mutate(Age_group = factor(Age_group,
+                            levels = c("n0_1", "n2_3", "n4_7", "n8_13", "n14_17"),
+                            labels = c("0–1 years", "2–3 years", "4–7 years", "8–13 years", "14–17 years"))) %>%
+  drop_na(n)
+
+# --- Order cohorts by total contribution ---
+bmi_long <- bmi_long %>%
+  group_by(Cohort) %>%
+  mutate(total_n = sum(n, na.rm = TRUE)) %>%
+  ungroup() %>%
+  arrange(total_n)
+
+# --- Split into 5 cumulative stages ---
+n_cohorts <- n_distinct(bmi_long$Cohort)
+stage_breaks <- round(seq(1, n_cohorts, length.out = 5))  # 5 roughly equal steps
+
+# --- Fixed axis limits for identical scaling ---
+ymax <- bmi_long %>%
+  group_by(Age_group) %>%
+  summarise(total = sum(n)) %>%
+  summarise(max_total = max(total)) %>%
+  pull(max_total)
+
+# --- Loop to create 5 plots ---
+for (i in seq_along(stage_breaks)) {
+  
+  included <- unique(bmi_long$Cohort)[1:stage_breaks[i]]
+  plot_data <- bmi_long %>% filter(Cohort %in% included)
+  
+  p <- ggplot(plot_data, aes(x = Age_group, y = n, fill = Cohort)) +
+    geom_bar(stat = "identity", width = 0.7, color = "white") +
+    scale_y_continuous(labels = scales::comma, limits = c(0, ymax)) +
+    scale_fill_viridis_d(option = "turbo", direction = -1) +
+    labs(
+      x = "Child age group",
+      y = "Number of BMI z-score observations",
+      fill = "Cohort"
+    ) +
+    theme_minimal(base_size = 13) +
+    theme(
+      legend.position = "right",
+      plot.title = element_blank()
+    )
+  
+  ggsave(sprintf("bmi_stacked_stage_%02d.png", i), p, width = 7, height = 5, dpi = 300)
+}
diff --git a/R/isNaDS.R b/R/isNaDS.R
index f1c2c461..6fc25940 100644
--- a/R/isNaDS.R
+++ b/R/isNaDS.R
@@ -3,7 +3,9 @@
 #' @description this function is similar to R function \code{is.na} but instead of a vector
 #' of booleans it returns just one boolean to tell if all the element are missing values.
 #' @param x a character string, the name of a server-side vector
-#' @return TRUE if the vector contains only NAs, FALSE otherwise
+#' @return a list with two elements: \code{is.na} (TRUE if the vector contains
+#'   only NAs, FALSE otherwise) and \code{class} (the class of the input object,
+#'   for client-side consistency checking)
 #' @author Gaye, A.
 #' @export
 #'
@@ -12,9 +14,6 @@ isNaDS <- function(x){
   .checkClass(obj = xvect, obj_name = x, permitted_classes = c("character", "factor", "integer", "logical", "numeric", "data.frame", "matrix"))
   out <- is.na(xvect)
   total <- sum(out, na.rm=TRUE)
-  if(total == (1 * length(out))){
-    return(TRUE)
-  }else{
-    return(FALSE)
-  }
+  is_na <- total == (1 * length(out))
+  list(is.na = is_na, class = class(xvect))
 }
diff --git a/R/levelsDS.R b/R/levelsDS.R
index 5e827f1e..6874ad1d 100644
--- a/R/levelsDS.R
+++ b/R/levelsDS.R
@@ -3,7 +3,9 @@
 #' @description This function is similar to R function \code{levels}.
 #' @details The function returns the levels of the input vector or list.
 #' @param x a factor vector
-#' @return a list, the factor levels present in the vector
+#' @return a list with three elements: \code{Levels} (the factor levels present
+#'   in the vector), \code{ValidityMessage}, and \code{class} (the class of the
+#'   input object, for client-side consistency checking)
 #' @author Alex Westerberg, for DataSHIELD Development Team
 #' @export
 #'
@@ -33,7 +35,7 @@ levelsDS <- function(x){
     stop(studysideMessage, call. = FALSE)
   }
   
-  out.obj <- list(Levels=out,ValidityMessage=studysideMessage)
+  out.obj <- list(Levels=out, ValidityMessage=studysideMessage, class=class(x.val))
   return(out.obj)
 }
 #AGGREGATE FUNCTION
diff --git a/R/numNaDS.R b/R/numNaDS.R
index 4c85c5bc..334bf49f 100644
--- a/R/numNaDS.R
+++ b/R/numNaDS.R
@@ -3,12 +3,14 @@
 #' @description this function just counts the number of missing entries
 #' in a vector.
 #' @param x a character string, the name of a server-side vector
-#' @return an integer, the number of missing values
+#' @return a list with two elements: \code{numNA} (an integer, the number of
+#'   missing values) and \code{class} (the class of the input object, for
+#'   client-side consistency checking)
 #' @author Gaye, A.
 #' @export
 #'
 numNaDS <- function(x){
   xvect <- .loadServersideObject(x)
   out <- length(which(is.na(xvect)))
-  return(out)
+  list(numNA = out, class = class(xvect))
 }

From fa49156b652f992d368206f4001d139f1111682c Mon Sep 17 00:00:00 2001
From: Tim Cadman <41470917+timcadman@users.noreply.github.com>
Date: Mon, 13 Apr 2026 10:48:09 +0200
Subject: [PATCH 06/12] refactor: remove validity message as inconsistent with
 other functions

---
 R/levelsDS.R | 15 ++++++---------
 1 file changed, 6 insertions(+), 9 deletions(-)

diff --git a/R/levelsDS.R b/R/levelsDS.R
index 6874ad1d..4b62978f 100644
--- a/R/levelsDS.R
+++ b/R/levelsDS.R
@@ -3,9 +3,9 @@
 #' @description This function is similar to R function \code{levels}.
 #' @details The function returns the levels of the input vector or list.
 #' @param x a factor vector
-#' @return a list with three elements: \code{Levels} (the factor levels present
-#'   in the vector), \code{ValidityMessage}, and \code{class} (the class of the
-#'   input object, for client-side consistency checking)
+#' @return a list with two elements: \code{Levels} (the factor levels present
+#'   in the vector) and \code{class} (the class of the input object, for
+#'   client-side consistency checking)
 #' @author Alex Westerberg, for DataSHIELD Development Team
 #' @export
 #'
@@ -27,15 +27,12 @@ levelsDS <- function(x){
   out <- levels(x.val)
   input.length     <- length(x.val)
   output.length    <- length(out)
-  studysideMessage <- "VALID ANALYSIS"
 
   if((input.length * nfilter.levels.density) < output.length) {
-    out <- NA
-    studysideMessage <- "FAILED: Result length less than nfilter.levels.density of input length."
-    stop(studysideMessage, call. = FALSE)
+    stop("FAILED: Result length less than nfilter.levels.density of input length.", call. = FALSE)
   }
-  
-  out.obj <- list(Levels=out, ValidityMessage=studysideMessage, class=class(x.val))
+
+  out.obj <- list(Levels=out, class=class(x.val))
   return(out.obj)
 }
 #AGGREGATE FUNCTION

From 97e2687468b08f802d869ad8b2bcdbd2f20a66d4 Mon Sep 17 00:00:00 2001
From: Tim Cadman <41470917+timcadman@users.noreply.github.com>
Date: Mon, 13 Apr 2026 10:48:19 +0200
Subject: [PATCH 07/12] docs: redocumented

---
 man/isNaDS.Rd   | 4 +++-
 man/levelsDS.Rd | 4 +++-
 man/numNaDS.Rd  | 4 +++-
 3 files changed, 9 insertions(+), 3 deletions(-)

diff --git a/man/isNaDS.Rd b/man/isNaDS.Rd
index 6ed52393..13fe1d25 100644
--- a/man/isNaDS.Rd
+++ b/man/isNaDS.Rd
@@ -10,7 +10,9 @@ isNaDS(x)
 \item{x}{a character string, the name of a server-side vector}
 }
 \value{
-TRUE if the vector contains only NAs, FALSE otherwise
+a list with two elements: \code{is.na} (TRUE if the vector contains
+  only NAs, FALSE otherwise) and \code{class} (the class of the input object,
+  for client-side consistency checking)
 }
 \description{
 this function is similar to R function \code{is.na} but instead of a vector
diff --git a/man/levelsDS.Rd b/man/levelsDS.Rd
index 7046a117..87ab11a1 100644
--- a/man/levelsDS.Rd
+++ b/man/levelsDS.Rd
@@ -10,7 +10,9 @@ levelsDS(x)
 \item{x}{a factor vector}
 }
 \value{
-a list, the factor levels present in the vector
+a list with two elements: \code{Levels} (the factor levels present
+  in the vector) and \code{class} (the class of the input object, for
+  client-side consistency checking)
 }
 \description{
 This function is similar to R function \code{levels}.
diff --git a/man/numNaDS.Rd b/man/numNaDS.Rd
index cc5256f3..0d213261 100644
--- a/man/numNaDS.Rd
+++ b/man/numNaDS.Rd
@@ -10,7 +10,9 @@ numNaDS(x)
 \item{x}{a character string, the name of a server-side vector}
 }
 \value{
-an integer, the number of missing values
+a list with two elements: \code{numNA} (an integer, the number of
+  missing values) and \code{class} (the class of the input object, for
+  client-side consistency checking)
 }
 \description{
 this function just counts the number of missing entries

From 0f5814a23bf0fed4bcd7e86626838150a56644df Mon Sep 17 00:00:00 2001
From: Tim Cadman <41470917+timcadman@users.noreply.github.com>
Date: Mon, 13 Apr 2026 10:54:44 +0200
Subject: [PATCH 08/12] docs: updated authorship

---
 R/classDS.R            | 1 +
 R/completeCasesDS.R    | 1 +
 R/dimDS.R              | 1 +
 R/isNaDS.R             | 1 +
 R/lengthDS.R           | 1 +
 R/levelsDS.R           | 1 +
 R/namesDS.R            | 1 +
 R/numNaDS.R            | 1 +
 R/uniqueDS.R           | 1 +
 man/classDS.Rd         | 2 ++
 man/completeCasesDS.Rd | 2 ++
 man/dimDS.Rd           | 2 ++
 man/isNaDS.Rd          | 2 ++
 man/lengthDS.Rd        | 2 ++
 man/levelsDS.Rd        | 2 ++
 man/namesDS.Rd         | 2 ++
 man/numNaDS.Rd         | 2 ++
 man/uniqueDS.Rd        | 2 ++
 18 files changed, 27 insertions(+)

diff --git a/R/classDS.R b/R/classDS.R
index db8a907a..a33e49a3 100644
--- a/R/classDS.R
+++ b/R/classDS.R
@@ -5,6 +5,7 @@
 #' @param x a string character, the name of an object
 #' @return the class of the input object
 #' @author Stuart Wheater, for DataSHIELD Development Team
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @export
 #'
 classDS <- function(x){
diff --git a/R/completeCasesDS.R b/R/completeCasesDS.R
index a85222cd..25e6e1b5 100644
--- a/R/completeCasesDS.R
+++ b/R/completeCasesDS.R
@@ -31,6 +31,7 @@
 #' without problems no studysideMessage will have been saved and ds.message("newobj")
 #' will return the message: "ALL OK: there are no studysideMessage(s) on this datasource".
 #' @author Paul Burton for DataSHIELD Development Team
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @export
 #' 
 completeCasesDS <- function(x1.transmit){
diff --git a/R/dimDS.R b/R/dimDS.R
index 74f16df4..c27db5b5 100644
--- a/R/dimDS.R
+++ b/R/dimDS.R
@@ -6,6 +6,7 @@
 #' @return a list with two elements: \code{dim} (the dimension of the input object)
 #'   and \code{class} (the class of the input object, for client-side consistency checking)
 #' @author Demetris Avraam, for DataSHIELD Development Team
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @export
 #'
 dimDS <- function(x){
diff --git a/R/isNaDS.R b/R/isNaDS.R
index 6fc25940..3c73f019 100644
--- a/R/isNaDS.R
+++ b/R/isNaDS.R
@@ -7,6 +7,7 @@
 #'   only NAs, FALSE otherwise) and \code{class} (the class of the input object,
 #'   for client-side consistency checking)
 #' @author Gaye, A.
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @export
 #'
 isNaDS <- function(x){
diff --git a/R/lengthDS.R b/R/lengthDS.R
index fe1c22d6..5aefca58 100644
--- a/R/lengthDS.R
+++ b/R/lengthDS.R
@@ -7,6 +7,7 @@
 #'   vector or list) and \code{class} (the class of the input object, for client-side
 #'   consistency checking)
 #' @author Demetris Avraam, for DataSHIELD Development Team
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @export
 #'
 lengthDS <- function(x){
diff --git a/R/levelsDS.R b/R/levelsDS.R
index 4b62978f..6fca2b14 100644
--- a/R/levelsDS.R
+++ b/R/levelsDS.R
@@ -7,6 +7,7 @@
 #'   in the vector) and \code{class} (the class of the input object, for
 #'   client-side consistency checking)
 #' @author Alex Westerberg, for DataSHIELD Development Team
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @export
 #'
 levelsDS <- function(x){
diff --git a/R/namesDS.R b/R/namesDS.R
index 6193817f..a32aa916 100644
--- a/R/namesDS.R
+++ b/R/namesDS.R
@@ -16,6 +16,7 @@
 #' @return \code{namesDS} returns to the client-side the names
 #' of a list object stored on the server-side.
 #' @author Amadou Gaye, updated by Paul Burton 25/06/2020
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @export
 #'
 namesDS <- function(xname.transmit){
diff --git a/R/numNaDS.R b/R/numNaDS.R
index 334bf49f..95011e25 100644
--- a/R/numNaDS.R
+++ b/R/numNaDS.R
@@ -7,6 +7,7 @@
 #'   missing values) and \code{class} (the class of the input object, for
 #'   client-side consistency checking)
 #' @author Gaye, A.
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @export
 #'
 numNaDS <- function(x){
diff --git a/R/uniqueDS.R b/R/uniqueDS.R
index 2b8f0095..23290d3b 100644
--- a/R/uniqueDS.R
+++ b/R/uniqueDS.R
@@ -6,6 +6,7 @@
 #' @return the object specified by the \code{newobj} argument
 #' which is written to the server-side.
 #' @author Stuart Wheater for DataSHIELD Development Team
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @export
 #'
 uniqueDS <- function(x.name.transmit = NULL){
diff --git a/man/classDS.Rd b/man/classDS.Rd
index c1a51f83..030958cf 100644
--- a/man/classDS.Rd
+++ b/man/classDS.Rd
@@ -20,4 +20,6 @@ The function returns the class of an object
 }
 \author{
 Stuart Wheater, for DataSHIELD Development Team
+
+Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 }
diff --git a/man/completeCasesDS.Rd b/man/completeCasesDS.Rd
index 792c73a0..8bc0ed08 100644
--- a/man/completeCasesDS.Rd
+++ b/man/completeCasesDS.Rd
@@ -47,4 +47,6 @@ under help("complete.cases") in native R.
 }
 \author{
 Paul Burton for DataSHIELD Development Team
+
+Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 }
diff --git a/man/dimDS.Rd b/man/dimDS.Rd
index 1fbac2bf..f7119f68 100644
--- a/man/dimDS.Rd
+++ b/man/dimDS.Rd
@@ -21,4 +21,6 @@ The function returns the dimension of the input dataframe or matrix
 }
 \author{
 Demetris Avraam, for DataSHIELD Development Team
+
+Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 }
diff --git a/man/isNaDS.Rd b/man/isNaDS.Rd
index 13fe1d25..faae7cfb 100644
--- a/man/isNaDS.Rd
+++ b/man/isNaDS.Rd
@@ -20,4 +20,6 @@ of booleans it returns just one boolean to tell if all the element are missing v
 }
 \author{
 Gaye, A.
+
+Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 }
diff --git a/man/lengthDS.Rd b/man/lengthDS.Rd
index bfadf14f..18a6a32e 100644
--- a/man/lengthDS.Rd
+++ b/man/lengthDS.Rd
@@ -22,4 +22,6 @@ The function returns the length of the input vector or list.
 }
 \author{
 Demetris Avraam, for DataSHIELD Development Team
+
+Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 }
diff --git a/man/levelsDS.Rd b/man/levelsDS.Rd
index 87ab11a1..c54b7d13 100644
--- a/man/levelsDS.Rd
+++ b/man/levelsDS.Rd
@@ -22,4 +22,6 @@ The function returns the levels of the input vector or list.
 }
 \author{
 Alex Westerberg, for DataSHIELD Development Team
+
+Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 }
diff --git a/man/namesDS.Rd b/man/namesDS.Rd
index 951bfdd0..8eb4ad0c 100644
--- a/man/namesDS.Rd
+++ b/man/namesDS.Rd
@@ -31,4 +31,6 @@ is formally of double class "glm" and "ls" but responds TRUE to is.list(),
 }
 \author{
 Amadou Gaye, updated by Paul Burton 25/06/2020
+
+Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 }
diff --git a/man/numNaDS.Rd b/man/numNaDS.Rd
index 0d213261..572507fa 100644
--- a/man/numNaDS.Rd
+++ b/man/numNaDS.Rd
@@ -20,4 +20,6 @@ in a vector.
 }
 \author{
 Gaye, A.
+
+Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 }
diff --git a/man/uniqueDS.Rd b/man/uniqueDS.Rd
index 4168fd1b..4efedf80 100644
--- a/man/uniqueDS.Rd
+++ b/man/uniqueDS.Rd
@@ -21,4 +21,6 @@ The function computes the uniques values of a variable.
 }
 \author{
 Stuart Wheater for DataSHIELD Development Team
+
+Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 }

From b3f190ca0e6e612e8b49852a7859b9db190523d6 Mon Sep 17 00:00:00 2001
From: Tim Cadman <41470917+timcadman@users.noreply.github.com>
Date: Mon, 13 Apr 2026 11:05:28 +0200
Subject: [PATCH 09/12] test: updated expectations now some functions return a
 list

---
 tests/testthat/test-smk-isNaDS.R   | 36 +++++++++++++++---------------
 tests/testthat/test-smk-levelsDS.R |  2 --
 tests/testthat/test-smk-numNaDS.R  | 12 +++++-----
 3 files changed, 24 insertions(+), 26 deletions(-)

diff --git a/tests/testthat/test-smk-isNaDS.R b/tests/testthat/test-smk-isNaDS.R
index 0cbdecd8..33012766 100644
--- a/tests/testthat/test-smk-isNaDS.R
+++ b/tests/testthat/test-smk-isNaDS.R
@@ -25,9 +25,9 @@ test_that("numeric vector isNaDS", {
 
     res <- isNaDS("input")
 
-    expect_length(res, 1)
-    expect_equal(class(res), "logical")
-    expect_equal(res, FALSE)
+    expect_length(res$is.na, 1)
+    expect_equal(class(res$is.na), "logical")
+    expect_equal(res$is.na, FALSE)
 })
 
 test_that("numeric vector isNaDS - with NA single", {
@@ -35,9 +35,9 @@ test_that("numeric vector isNaDS - with NA single", {
 
     res <- isNaDS("input")
 
-    expect_length(res, 1)
-    expect_equal(class(res), "logical")
-    expect_equal(res, FALSE)
+    expect_length(res$is.na, 1)
+    expect_equal(class(res$is.na), "logical")
+    expect_equal(res$is.na, FALSE)
 })
 
 test_that("numeric vector isNaDS - with NA all", {
@@ -45,9 +45,9 @@ test_that("numeric vector isNaDS - with NA all", {
 
     res <- isNaDS("input")
 
-    expect_length(res, 1)
-    expect_equal(class(res), "logical")
-    expect_equal(res, TRUE)
+    expect_length(res$is.na, 1)
+    expect_equal(class(res$is.na), "logical")
+    expect_equal(res$is.na, TRUE)
 })
 
 # context("isNaDS::smk::character vector")
@@ -56,9 +56,9 @@ test_that("character vector isNaDS", {
 
     res <- isNaDS("input")
 
-    expect_length(res, 1)
-    expect_equal(class(res), "logical")
-    expect_equal(res, FALSE)
+    expect_length(res$is.na, 1)
+    expect_equal(class(res$is.na), "logical")
+    expect_equal(res$is.na, FALSE)
 })
 
 test_that("character vector isNaDS - with NA single", {
@@ -66,9 +66,9 @@ test_that("character vector isNaDS - with NA single", {
 
     res <- isNaDS("input")
 
-    expect_length(res, 1)
-    expect_equal(class(res), "logical")
-    expect_equal(res, FALSE)
+    expect_length(res$is.na, 1)
+    expect_equal(class(res$is.na), "logical")
+    expect_equal(res$is.na, FALSE)
 })
 
 test_that("character vector isNaDS - with NA all", {
@@ -76,9 +76,9 @@ test_that("character vector isNaDS - with NA all", {
 
     res <- isNaDS("input")
 
-    expect_length(res, 1)
-    expect_equal(class(res), "logical")
-    expect_equal(res, TRUE)
+    expect_length(res$is.na, 1)
+    expect_equal(class(res$is.na), "logical")
+    expect_equal(res$is.na, TRUE)
 })
 
 test_that("isNaDS throws error when object does not exist", {
diff --git a/tests/testthat/test-smk-levelsDS.R b/tests/testthat/test-smk-levelsDS.R
index 28949677..3059e003 100644
--- a/tests/testthat/test-smk-levelsDS.R
+++ b/tests/testthat/test-smk-levelsDS.R
@@ -35,8 +35,6 @@ test_that("numeric vector levelsDS", {
     expect_equal(res$Levels[2], "1")
     expect_equal(res$Levels[3], "2")
     expect_equal(res$Levels[4], "3")
-    expect_equal(class(res$ValidityMessage), "character")
-    expect_equal(res$ValidityMessage, "VALID ANALYSIS")
 })
 
 test_that("levelsDS throws error when object does not exist", {
diff --git a/tests/testthat/test-smk-numNaDS.R b/tests/testthat/test-smk-numNaDS.R
index f050d3d8..5040c94c 100644
--- a/tests/testthat/test-smk-numNaDS.R
+++ b/tests/testthat/test-smk-numNaDS.R
@@ -25,9 +25,9 @@ test_that("simple numNaDS", {
 
     res <- numNaDS("input")
 
-    expect_equal(class(res), "integer")
-    expect_length(res, 1)
-    expect_equal(res, 3)
+    expect_equal(class(res$numNA), "integer")
+    expect_length(res$numNA, 1)
+    expect_equal(res$numNA, 3)
 })
 
 test_that("simple numNaDS, single NA", {
@@ -35,9 +35,9 @@ test_that("simple numNaDS, single NA", {
 
     res <- numNaDS("input")
 
-    expect_equal(class(res), "integer")
-    expect_length(res, 1)
-    expect_equal(res, 1)
+    expect_equal(class(res$numNA), "integer")
+    expect_length(res$numNA, 1)
+    expect_equal(res$numNA, 1)
 })
 
 test_that("numNaDS throws error when object does not exist", {

From 48b6a4eaf57fdf6f2695ce9f983f42944a2c7863 Mon Sep 17 00:00:00 2001
From: Tim Cadman <41470917+timcadman@users.noreply.github.com>
Date: Mon, 13 Apr 2026 11:24:23 +0200
Subject: [PATCH 10/12] revert: delete mistakenly committed file

---
 R/ihen_outcome.R | 64 ------------------------------------------------
 1 file changed, 64 deletions(-)
 delete mode 100644 R/ihen_outcome.R

diff --git a/R/ihen_outcome.R b/R/ihen_outcome.R
deleted file mode 100644
index 4af38652..00000000
--- a/R/ihen_outcome.R
+++ /dev/null
@@ -1,64 +0,0 @@
-library(dplyr)
-library(tidyr)
-library(ggplot2)
-
-# --- Simplified Web Table 7 (with INMA + EDEN collapsed) ---
-bmi_data <- data.frame(
-  Cohort = c("RHEA","CHOP","SWS","GECKO","Raine","INMA","EDEN","GENR",
-             "ALSPAC","ABCD","NFBC66","NFBC86","BiB","ELFE","DNBC","MoBa"),
-  n0_1  = c(974,1668,2942,2738,2303,1910,1760,7230,1420,5669,7379,5141,12959,17795,56821,85079),
-  n2_3  = c(684,938,2701,2212,614,1177,1521,6466,1221,4763,5809,4739,6225,10773,0,45673),
-  n4_7  = c(887,1092,2166,2309,2088,1634,1278,6572,5682,4754,7268,7110,10539,10192,43164,49728),
-  n8_13 = c(334,755,1209,2180,1988,1043,904,5723,9585,3603,7239,4750,5592,3360,44177,33473),
-  n14_17= c(NA,NA,NA,NA,1623,NA,NA,NA,7675,NA,7035,5760,NA,NA,6508,NA)
-)
-
-# --- Reshape ---
-bmi_long <- bmi_data %>%
-  pivot_longer(cols = starts_with("n"), names_to = "Age_group", values_to = "n") %>%
-  mutate(Age_group = factor(Age_group,
-                            levels = c("n0_1", "n2_3", "n4_7", "n8_13", "n14_17"),
-                            labels = c("0–1 years", "2–3 years", "4–7 years", "8–13 years", "14–17 years"))) %>%
-  drop_na(n)
-
-# --- Order cohorts by total contribution ---
-bmi_long <- bmi_long %>%
-  group_by(Cohort) %>%
-  mutate(total_n = sum(n, na.rm = TRUE)) %>%
-  ungroup() %>%
-  arrange(total_n)
-
-# --- Split into 5 cumulative stages ---
-n_cohorts <- n_distinct(bmi_long$Cohort)
-stage_breaks <- round(seq(1, n_cohorts, length.out = 5))  # 5 roughly equal steps
-
-# --- Fixed axis limits for identical scaling ---
-ymax <- bmi_long %>%
-  group_by(Age_group) %>%
-  summarise(total = sum(n)) %>%
-  summarise(max_total = max(total)) %>%
-  pull(max_total)
-
-# --- Loop to create 5 plots ---
-for (i in seq_along(stage_breaks)) {
-  
-  included <- unique(bmi_long$Cohort)[1:stage_breaks[i]]
-  plot_data <- bmi_long %>% filter(Cohort %in% included)
-  
-  p <- ggplot(plot_data, aes(x = Age_group, y = n, fill = Cohort)) +
-    geom_bar(stat = "identity", width = 0.7, color = "white") +
-    scale_y_continuous(labels = scales::comma, limits = c(0, ymax)) +
-    scale_fill_viridis_d(option = "turbo", direction = -1) +
-    labs(
-      x = "Child age group",
-      y = "Number of BMI z-score observations",
-      fill = "Cohort"
-    ) +
-    theme_minimal(base_size = 13) +
-    theme(
-      legend.position = "right",
-      plot.title = element_blank()
-    )
-  
-  ggsave(sprintf("bmi_stacked_stage_%02d.png", i), p, width = 7, height = 5, dpi = 300)
-}

From 885f61f176a53d8a21f70b1f0320afaef29a08d4 Mon Sep 17 00:00:00 2001
From: Tim Cadman <41470917+timcadman@users.noreply.github.com>
Date: Mon, 13 Apr 2026 11:35:38 +0200
Subject: [PATCH 11/12] revert: allow data frames to pass class check and
 update tests

---
 R/lengthDS.R                       |  2 +-
 tests/testthat/test-smk-lengthDS.R | 24 ++++++++++++++++++------
 2 files changed, 19 insertions(+), 7 deletions(-)

diff --git a/R/lengthDS.R b/R/lengthDS.R
index 5aefca58..1c793aa0 100644
--- a/R/lengthDS.R
+++ b/R/lengthDS.R
@@ -12,7 +12,7 @@
 #'
 lengthDS <- function(x){
   x.val <- .loadServersideObject(x)
-  .checkClass(obj = x.val, obj_name = x, permitted_classes = c("character", "factor", "integer", "logical", "numeric", "list"))
+  .checkClass(obj = x.val, obj_name = x, permitted_classes = c("character", "factor", "integer", "logical", "numeric", "list", "data.frame"))
   list(length = length(x.val), class = class(x.val))
 }
 #AGGREGATE FUNCTION
diff --git a/tests/testthat/test-smk-lengthDS.R b/tests/testthat/test-smk-lengthDS.R
index 67454a8b..b410915d 100644
--- a/tests/testthat/test-smk-lengthDS.R
+++ b/tests/testthat/test-smk-lengthDS.R
@@ -56,12 +56,24 @@ test_that("lengthDS throws error when object does not exist", {
     )
 })
 
-test_that("lengthDS throws error when object is not a permitted type", {
-    bad_input <- data.frame(a = 1:3)
-    expect_error(
-        lengthDS("bad_input"),
-        regexp = "must be of type"
-    )
+test_that("simple lengthDS, numeric data.frame", {
+    input <- data.frame(v1 = c(0.0, 1.0, 2.0, 3.0, 4.0), v2 = c(4.0, 3.0, 2.0, 1.0, 0.0))
+
+    res <- lengthDS("input")
+
+    expect_equal(class(res), "list")
+    expect_equal(res$length, 2)
+    expect_equal(res$class, "data.frame")
+})
+
+test_that("simple lengthDS, character data.frame", {
+    input <- data.frame(v1 = c("0.0", "1.0", "2.0", "3.0", "4.0"), v2 = c("4.0", "3.0", "2.0", "1.0", "0.0"), stringsAsFactors = FALSE)
+
+    res <- lengthDS("input")
+
+    expect_equal(class(res), "list")
+    expect_equal(res$length, 2)
+    expect_equal(res$class, "data.frame")
 })
 
 #

From c74488d8371462afb0dfc28d4a7aeb01bec391a8 Mon Sep 17 00:00:00 2001
From: Tim Cadman <41470917+timcadman@users.noreply.github.com>
Date: Mon, 13 Apr 2026 14:25:05 +0200
Subject: [PATCH 12/12] refactor: remove class from levelsDS return, update
 test

---
 R/levelsDS.R                       | 7 +++----
 tests/testthat/test-smk-levelsDS.R | 2 +-
 2 files changed, 4 insertions(+), 5 deletions(-)

diff --git a/R/levelsDS.R b/R/levelsDS.R
index 6fca2b14..33c33ec6 100644
--- a/R/levelsDS.R
+++ b/R/levelsDS.R
@@ -3,9 +3,8 @@
 #' @description This function is similar to R function \code{levels}.
 #' @details The function returns the levels of the input vector or list.
 #' @param x a factor vector
-#' @return a list with two elements: \code{Levels} (the factor levels present
-#'   in the vector) and \code{class} (the class of the input object, for
-#'   client-side consistency checking)
+#' @return a list with one element: \code{Levels} (the factor levels present
+#'   in the vector)
 #' @author Alex Westerberg, for DataSHIELD Development Team
 #' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @export
@@ -33,7 +32,7 @@ levelsDS <- function(x){
     stop("FAILED: Result length less than nfilter.levels.density of input length.", call. = FALSE)
   }
 
-  out.obj <- list(Levels=out, class=class(x.val))
+  out.obj <- list(Levels=out)
   return(out.obj)
 }
 #AGGREGATE FUNCTION
diff --git a/tests/testthat/test-smk-levelsDS.R b/tests/testthat/test-smk-levelsDS.R
index 3059e003..2c313e1a 100644
--- a/tests/testthat/test-smk-levelsDS.R
+++ b/tests/testthat/test-smk-levelsDS.R
@@ -27,7 +27,7 @@ test_that("numeric vector levelsDS", {
 
     res <- levelsDS("input")
 
-    expect_length(res, 2)
+    expect_length(res, 1)
     expect_equal(class(res), "list")
     expect_equal(class(res$Levels), "character")
     expect_length(res$Levels, 4)