updated tests

Dockerfile

@@ -1,52 +1,54 @@
 FROM rocker/shiny:4.4.2
 
 RUN apt-get update && apt-get install -y \
-    --no-install-recommends \
-    git-core \
-    libssl-dev \
-    libcurl4-gnutls-dev \
-    curl \
-    libsodium-dev \
-    libxml2-dev \
-    libicu-dev \
-    && apt-get clean \
-    && rm -rf /var/lib/apt/lists/*
+  --no-install-recommends \
+  git-core \
+  libssl-dev \
+  libcurl4-gnutls-dev \
+  curl \
+  libsodium-dev \
+  libxml2-dev \
+  libicu-dev \
+  && apt-get clean \
+  && rm -rf /var/lib/apt/lists/*
 
 ENV _R_SHLIB_STRIP_=true
 ENV SHINY_LOG_STDERR=1
 
 RUN install2.r --error --skipinstalled \
-    shiny \
-    shinyjs \
-    shinyWidgets \
-    jsonlite \
-    ggplot2 \
-    htmltools \
-    drc \
-    DT \
-    httr \
-    agricolae \
-    broom \
-    readxl \
-    openxlsx \
-    purrr \
-    png \
-    RColorBrewer \
-    remotes \
-    xml2 \
-    xlsx \
-    openssl \
-    ggpmisc \
-    jose \
-    R6 \
-    cowplot \
-    car \
-    equatiomatic \
-    quarto
+  shiny \
+  shinyjs \
+  shinyWidgets \
+  jsonlite \
+  ggplot2 \
+  htmltools \
+  drc \
+  DT \
+  httr \
+  agricolae \
+  broom \
+  readxl \
+  openxlsx \
+  purrr \
+  png \
+  RColorBrewer \
+  remotes \
+  xml2 \
+  xlsx \
+  openssl \
+  ggpmisc \
+  jose \
+  R6 \
+  cowplot \
+  car \
+  equatiomatic \
+  quarto
 
 USER shiny
 COPY ./bs/R ./myapp
-RUN mkdir /home/shiny/results
+# is not needed anymore
+RUN mkdir /home/shiny/results 
+
 
 COPY ./MTT/ /home/MTT
 COPY ./comeln/ /home/comeln

bs/R/utils.R

@@ -1,6 +1,7 @@
 # Upload data into R
 readData <- function(path) {
   stopifnot(is.character(path))
+  if (!file.exists(path)) stop("File does not exists")
   max_file_size <- 50 * 1024^2 # 50 MB in bytes
   file_size <- file.info(path)$size
   if (is.na(file_size) || file_size > max_file_size) {
@@ -25,11 +26,11 @@ readData <- function(path) {
     } else if (tab == TRUE) {
       seperator <- "\t"
     } else {
-      return("error")
+      stop("Could not identiy the seperator. Please upload a file with a known seperator.")
     }
     df <- try(read.csv(path, header = TRUE, sep = seperator))
     if (class(df) == "try-error") {
-      return("error")
+      stop(conditionMessage(df))
     }
   } else {
     f <- function(x) {
@@ -50,8 +51,11 @@ readData <- function(path) {
     df <- data.frame(df)
   }
   # Check data frame dimensions
-  max_rows <- 1e6
+  if (nrow(df) == 0) {
+    stop("The uploaded file is empty. Please upload a file with data.")
+  }
   max_cols <- 1000
+  max_rows <- 1e6
   if (nrow(df) > max_rows || ncol(df) > max_cols) {
     stop(sprintf(
       "Data exceeds the limit of %d rows or %d columns. Please upload a smaller dataset.",
@@ -62,16 +66,20 @@ readData <- function(path) {
 }
 
 DF2String <- function(df) {
+  stopifnot(
+    "Input to DF2String is not of type DataFrame" = is.data.frame(df)
+  )
   resNames <- names(df)
   resNames <- paste(resNames, collapse = "\t")
-  resNames <- paste(resNames, "\n")
   res <- apply(df, 1, function(x) {
     x <- as.character(x)
     x <- paste(x, collapse = "\t")
     return(x)
   })
-  res <- paste0(resNames, "\n", res, collapse = "")
+  res <- c(resNames, res)
   res <- paste0(res, "\n")
+  res <- Reduce(paste0, res)
+  return(res)
 }
 
 setClass("plot",
@@ -158,7 +166,10 @@ createExcelFile <- function(l) {
 
   # create temporary file
   file <- function() {
-    tempfile <- tempfile(tmpdir = "/home/shiny/results", fileext = ".xlsx")
+    # TODO: is it necessary to store this in this folder. Or could i use tempfile without dir argument?
+    # Is it needed in the docker container?
+    # tempfile <- tempfile(tmpdir = "/home/shiny/results", fileext = ".xlsx")
+    tempfile <- tempfile(fileext = ".xlsx")
     return(tempfile)
   }
   fn <- file()
@@ -265,8 +276,9 @@ combine <- function(new, vec, df, first) {
 splitData <- function(df, formula) {
   df <- model.frame(formula, data = df)
   stopifnot(ncol(df) >= 2)
-  res <- data.frame(value = df[, 1], interaction = interaction(df[, 2:ncol(df)]))
-  names(res) <- c("value", interaction = paste0(names(df)[2:ncol(df)], collapse = "."))
+  res <- data.frame(
+    value = df[, 1], interaction = interaction(df[, 2:ncol(df)])
+  )
   res
 }
 
@@ -288,20 +300,25 @@ get_elem <- function(df, ...) {
     if (!is.numeric(args[[1]]) || !is.numeric(args[[2]])) {
       stop("The index arguments have to be of type numeric")
     }
-    return(df[args[[1]], args[[2]]])
+    res <- df[args[[1]], args[[2]]]
+    if (is.null(res)) stop("Cannot access the element")
+    return(res)
   }
   if (is.vector(df)) {
     if (!is.numeric(args[[1]])) {
       stop("The index arguments have to be of type numeric")
     }
-    return(df[args[[1]]])
+    res <- df[args[[1]]]
+    if (is.na(res)) stop("Cannot access the element")
+    return(res)
   }
 }
 
 get_cols <- function(df, ...) {
   stopifnot("Expected dataframe" = is.data.frame(df))
   s <- substitute(list(...))
   args <- as.list(s[-1])
+  stopifnot("No columns are specified" = length(args) >= 1)
   lapply(args, function(x) {
     name <- deparse(x)
     stopifnot("Column not found" = name %in% names(df))
@@ -352,19 +369,13 @@ as.fact <- function(v) {
 }
 
 # Split groups
-# FIX: this works only for one column
 split <- function(df, cols, levels) {
-  df_res <- NULL
-  levels_temp <- NULL
+  df_res <- df
   for (i in seq_along(cols)) {
-    if (i == 1) {
-      levels_temp <- levels[levels %in% unique(df[, cols[i]])]
-    } else {
-      levels_temp <- levels[levels %in% unique(df_res[, cols[i]])]
-    }
-    df_res <- rbind(df_res, df[df[, cols[i]] == levels_temp, ])
+    levels_temp <- levels[levels %in% unique(df_res[, cols[i]])]
+    df_res <- df_res[df_res[, cols[i]] %in% levels_temp, ]
   }
-  if (nrow(df) == 0) stop("Subset contains 0 rows")
+  if (nrow(df_res) == 0) stop("Subset contains 0 rows")
   return(df_res)
 }
 
@@ -428,11 +439,17 @@ check_axis_limits <- function(col, min, max) {
     return()
   } else {
     choices <- unique(col)
-    if (!(min %in% choices) || !(max %in% choices)) {
-      stop("Found invalid axis limits")
-    }
-    if (which(max == choices) <= which(min == choices)) {
-      stop("Found invalid axis limits. The max value is found before the min value")
+    if (length(choices) == 1) {
+      if (!(min == choices && max == choices)) {
+       stop("If only one level is available the max and min value have to be set to this value!")
+      }
+    } else {
+      if (!(min %in% choices) || !(max %in% choices)) {
+        stop("Found invalid axis limits")
+      }
+      if (which(max == choices) <= which(min == choices)) {
+        stop("Found invalid axis limits. The max value is found before the min value")
+      }
     }
     return()
   }
@@ -581,6 +598,9 @@ check_filename_for_serverless <- function(filename) {
 
 # Split list of plots into panels of 9 plots
 create_plot_pages <- function(plotList) {
+  if (length(plotList) == 0) {
+    plotList <- list(ggplot2::ggplot() + ggplot2::geom_point())
+  }
   n_full_pages <- floor(length(plotList) / 9)
   if (n_full_pages == 0) {
     return(list(cowplot::plot_grid(plotlist = plotList)))
@@ -628,6 +648,7 @@ elongate_col <- function(col, l) {
   }
 }
 
+# TODO: for a later update keep the type of the original cols
 DataFrame <- function(...) {
   columns <- list(...)
   s <- substitute(list(...))
@@ -687,6 +708,7 @@ Qnorm <- function(...) {
 Rnorm <- function(...) {
   args <- list(...)
   n <- args[[1]]
+  if (length(n) > 1) stop("Length of size input to Rnorm > 1")
   if (!is.numeric(n) && !is.integer(n)) {
     n <- length(n)
   }
@@ -715,6 +737,7 @@ Qbinom <- function(...) {
 Rbinom <- function(...) {
   args <- list(...)
   n <- args[[1]]
+  if (length(n) > 1) stop("Length of size input to Rbinom > 1")
   if (!is.numeric(n) && !is.integer(n)) {
     n <- length(n)
   }
@@ -739,6 +762,7 @@ Ppois <- function(...) {
 Rpois <- function(...) {
   args <- list(...)
   n <- args[[1]]
+  if (length(n) > 1) stop("Length of size input to Rpois > 1")
   if (!is.numeric(n) && !is.integer(n)) {
     n <- length(n)
   }
@@ -767,6 +791,7 @@ Qunif <- function(...) {
 Runif <- function(...) {
   args <- list(...)
   n <- args[[1]]
+  if (length(n) > 1) stop("Length of size input to Runif > 1")
   if (!is.numeric(n) && !is.integer(n)) {
     n <- length(n)
   }
@@ -779,4 +804,3 @@ Runif <- function(...) {
   }
   runif(...)
 }
-