diff --git a/R/elsplineDS.R b/R/elsplineDS.R index c4dcfda8..4248a044 100644 --- a/R/elsplineDS.R +++ b/R/elsplineDS.R @@ -18,6 +18,7 @@ #' @return an object of class "lspline" and "matrix", which its name is specified by the #' \code{newobj} argument (or its default name "elspline.newobj"), is assigned on the serverside. #' @author Demetris Avraam for DataSHIELD Development Team +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' @export #' elsplineDS <- function(x = x, n = n, marginal = FALSE, names = NULL){ @@ -54,7 +55,7 @@ elsplineDS <- function(x = x, n = n, marginal = FALSE, names = NULL){ structure(rval, knots = knots, marginal = marginal, class = c("lspline", "matrix")) } - x <- eval(parse(text=x), envir = parent.frame()) + x <- .loadServersideObject(x) stopifnot(n >= 2) k <- seq(min(x, na.rm = TRUE), max(x, na.rm = TRUE), length.out = n + 1)[-c(1, n + 1)] diff --git a/R/getWGSRDS.R b/R/getWGSRDS.R index 225ce433..619b66af 100644 --- a/R/getWGSRDS.R +++ b/R/getWGSRDS.R @@ -49,15 +49,25 @@ #' @return \code{ds.getWGSR} assigns a numeric vector that includes the z-scores for the #' specified index. #' @author Demetris Avraam for DataSHIELD Development Team +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' @export #' getWGSRDS <- function(sex, firstPart, secondPart, index, standing=NA, thirdPart=NA){ - sex <- eval(parse(text=sex), envir = parent.frame()) - firstPart <- eval(parse(text=firstPart), envir = parent.frame()) - secondPart <- eval(parse(text=secondPart), envir = parent.frame()) + sex.name <- sex + firstPart.name <- firstPart + sex <- .loadServersideObject(sex) + firstPart <- .loadServersideObject(firstPart) + .checkClass(obj = firstPart, obj_name = firstPart.name, permitted_classes = c("numeric", "integer")) + if (!is.na(secondPart)){ + secondPart.name <- secondPart + secondPart <- .loadServersideObject(secondPart) + .checkClass(obj = secondPart, obj_name = secondPart.name, permitted_classes = c("numeric", "integer")) + } if (!is.na(thirdPart)){ - thirdPart <- eval(parse(text=thirdPart), envir = parent.frame()) + thirdPart.name <- thirdPart + thirdPart <- .loadServersideObject(thirdPart) + .checkClass(obj = thirdPart, obj_name = thirdPart.name, permitted_classes = c("numeric", "integer")) } # access the internal reference data diff --git a/R/hetcorDS.R b/R/hetcorDS.R index d561ce30..1dd26dae 100644 --- a/R/hetcorDS.R +++ b/R/hetcorDS.R @@ -24,11 +24,12 @@ #' any missing data were handled: "complete.obs" or "pairwise.complete.obs"; TRUE for ML estimates, #' FALSE for two-step estimates. #' @author Demetris Avraam for DataSHIELD Development Team +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' @export #' hetcorDS <- function(data, ML, std.err, bins, pd, use){ - data <- eval(parse(text=data), envir = parent.frame()) + data <- .loadServersideObject(data) out <- polycor::hetcor(data = data, ML = ML, std.err = std.err, bins = bins, pd = pd, use = use) diff --git a/R/lexisDS1.R b/R/lexisDS1.R index 6c0f8de7..45bea015 100644 --- a/R/lexisDS1.R +++ b/R/lexisDS1.R @@ -7,6 +7,7 @@ #' @param exitCol a character string specifying the variable holding the time that each individual is censored or fails #' #' @author Burton PR +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' #' @return List with `max.time` #' @export @@ -28,7 +29,7 @@ lexisDS1 <- function(exitCol=NULL){ stop(errorMessage, call. = FALSE) } - exposure <- eval(parse(text=exitCol), envir = parent.frame()) + exposure <- .loadServersideObject(exitCol) max.time <- max(exposure, na.rm=TRUE) random.multiplier <- stats::runif(1,1.01,1.05) diff --git a/R/lexisDS2.R b/R/lexisDS2.R index d63989d2..5696636d 100644 --- a/R/lexisDS2.R +++ b/R/lexisDS2.R @@ -31,6 +31,7 @@ #' 'data' argument is set the full data.frame will be expanded and carried forward #' #' @author Burton PR +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' #' @return List with `expanded.table` #' @export @@ -46,10 +47,10 @@ lexisDS2 <- function(datatext=NULL, intervalWidth, maxmaxtime, idCol, entryCol, #nfilter.string<-as.numeric(thr$nfilter.string) ############################################################# - starttime <- eval(parse(text=entryCol), envir = parent.frame()) - endtime <- eval(parse(text=exitCol), envir = parent.frame()) - cens <- eval(parse(text=statusCol), envir = parent.frame()) - id.orig <- eval(parse(text=idCol), envir = parent.frame()) + starttime <- .loadServersideObject(entryCol) + endtime <- .loadServersideObject(exitCol) + cens <- .loadServersideObject(statusCol) + id.orig <- .loadServersideObject(idCol) starttime <- as.numeric(starttime) endtime <- as.numeric(endtime) @@ -72,17 +73,39 @@ lexisDS2 <- function(datatext=NULL, intervalWidth, maxmaxtime, idCol, entryCol, length.collapseDF <- length(idSeq) #IDENTIFY VARIABLES TO BE CARRIED WITH THE EXPANDED SURVIVAL DATA - - if(is.null(vartext)){ - datatext2<-paste0("data.frame(",datatext,")") - DF <- eval(parse(text=datatext2), envir = parent.frame()) + + # loads each comma-separated name; whole data.frame names are unpacked into + # their own columns (matching data.frame()'s handling of a data.frame argument), + # single columns are added under their make.names()-sanitised name (matching + # data.frame()'s default naming for a non-symbol argument such as D$var) + if(is.null(vartext) && !is.null(datatext)){ + col.names <- unlist(strsplit(datatext, split=",")) + col.list <- list() + for(nm in col.names){ + obj <- .loadServersideObject(nm) + if(is.data.frame(obj)){ + col.list <- c(col.list, as.list(obj)) + }else{ + col.list[[make.names(nm)]] <- obj + } + } + DF <- data.frame(col.list) } - + if(!is.null(vartext)){ - vartext2<-paste0("data.frame(",vartext,")") - DF<-eval(parse(text=vartext2), envir = parent.frame()) + col.names <- unlist(strsplit(vartext, split=",")) + col.list <- list() + for(nm in col.names){ + obj <- .loadServersideObject(nm) + if(is.data.frame(obj)){ + col.list <- c(col.list, as.list(obj)) + }else{ + col.list[[make.names(nm)]] <- obj + } + } + DF <- data.frame(col.list) } - + if(is.null(datatext)&&is.null(vartext)){ DF<-data.frame(SURVTIME,CENS) } diff --git a/R/lsplineDS.R b/R/lsplineDS.R index 86475bba..22d8bdae 100644 --- a/R/lsplineDS.R +++ b/R/lsplineDS.R @@ -15,6 +15,7 @@ #' @return an object of class "lspline" and "matrix", which its name is specified by the #' \code{newobj} argument (or its default name "lspline.newobj"), is assigned on the serverside. #' @author Demetris Avraam for DataSHIELD Development Team +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' @export #' lsplineDS <- function(x = x, knots = NULL, marginal = FALSE, names = NULL){ @@ -51,7 +52,7 @@ lsplineDS <- function(x = x, knots = NULL, marginal = FALSE, names = NULL){ structure(rval, knots = knots, marginal = marginal, class = c("lspline", "matrix")) } - x <- eval(parse(text=x), envir = parent.frame()) + x <- .loadServersideObject(x) out <- lspline_copy(x = x, knots = knots, marginal = marginal, names = names) diff --git a/R/metadataDS.R b/R/metadataDS.R index a416ed61..95f22866 100644 --- a/R/metadataDS.R +++ b/R/metadataDS.R @@ -6,6 +6,7 @@ #' @return a list containing the metadata. The elements of the list will depend #' on the metadata available. #' @author Stuart Wheater, for DataSHIELD Development Team +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' @export #' metadataDS <- function(x) @@ -16,7 +17,7 @@ metadataDS <- function(x) if ((! is.character(x)) || (length(x) != 1)) stop("Variable's name isn't be single character vector", call. = FALSE) - x.var <- eval(parse(text=x), envir = parent.frame()) + x.var <- .loadServersideObject(x) if (is.null(x.var)) stop("Variable can't be NULL", call. = FALSE) diff --git a/R/nsDS.R b/R/nsDS.R index 6314c4b8..0c12d7ae 100644 --- a/R/nsDS.R +++ b/R/nsDS.R @@ -25,6 +25,7 @@ #' arguments to ns, and explicitly give the knots, Boundary.knots etc for use by predict.ns(). #' The object is assigned at each serverside. #' @author Demetris Avraam for DataSHIELD Development Team +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' @export #' nsDS <- function(x, df, knots, intercept, Boundary.knots){ @@ -33,7 +34,7 @@ nsDS <- function(x, df, knots, intercept, Boundary.knots){ thr <- dsBase::listDisclosureSettingsDS() nfilter.tab <- as.numeric(thr$nfilter.tab) - x <- eval(parse(text=x), envir = parent.frame()) + x <- .loadServersideObject(x) if(is.null(Boundary.knots)){ Boundary.knots <- range(x, na.rm=TRUE) diff --git a/R/qlsplineDS.R b/R/qlsplineDS.R index 3df267f8..55a56abf 100644 --- a/R/qlsplineDS.R +++ b/R/qlsplineDS.R @@ -23,6 +23,7 @@ #' @return an object of class "lspline" and "matrix", which its name is specified by the #' \code{newobj} argument (or its default name "qlspline.newobj"), is assigned on the serverside. #' @author Demetris Avraam for DataSHIELD Development Team +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' @export #' qlsplineDS <- function(x = x, q = q, na.rm = TRUE, marginal = FALSE, names = NULL){ @@ -59,7 +60,7 @@ qlsplineDS <- function(x = x, q = q, na.rm = TRUE, marginal = FALSE, names = NUL structure(rval, knots = knots, marginal = marginal, class = c("lspline", "matrix")) } - x <- eval(parse(text=x), envir = parent.frame()) + x <- .loadServersideObject(x) if (length(q) == 1 && q >= 2) { q <- seq(0, 1, length.out = q + 1)[-c(1, q + 1)] diff --git a/R/rowColCalcDS.R b/R/rowColCalcDS.R index e7a35832..68f6d339 100644 --- a/R/rowColCalcDS.R +++ b/R/rowColCalcDS.R @@ -4,15 +4,19 @@ #' 'rowMeans' and 'colMeans'. #' @details the output is returned to the user only the number of entries in the #' output vector is greater or equal to the allowed size. -#' @param dataset an array of two or more dimensions. +#' @param dataset.name a character string providing the name of a server-side array of two or more dimensions. #' @param operation an integer that indicates the operation to carry out: #' 1 for 'rowSums', 2 for 'colSums', 3 for 'rowMeans' or 4 for 'colMeans' #' @return a numeric vector #' @export #' @author Gaye, A. +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' -rowColCalcDS <- function (dataset, operation) { - +rowColCalcDS <- function (dataset.name, operation) { + + dataset <- .loadServersideObject(dataset.name) + .checkClass(obj = dataset, obj_name = dataset.name, permitted_classes = c("data.frame", "matrix")) + if(operation == 1){ result <- rowSums(dataset, na.rm=TRUE) } @@ -25,16 +29,15 @@ rowColCalcDS <- function (dataset, operation) { if(operation == 4){ result <- colMeans(dataset, na.rm=TRUE) } - - # check if the output is valid (i.e. meets DataSHIELD criteria) - check <- isValidDS(result) - if(check){ - return(result) - }else{ - resultNA <- rep(NA, length(result)) - return(resultNA) + + # check if the output is valid (i.e. meets DataSHIELD criteria); result is + # always numeric, so only the numeric-vector branch of isValidDS applies + thr <- dsBase::listDisclosureSettingsDS() + nfilter.tab <- as.numeric(thr$nfilter.tab) + if(length(result) > 0 && length(result) < nfilter.tab){ + result <- rep(NA, length(result)) } - + return(result) - + } \ No newline at end of file diff --git a/R/tableDS.R b/R/tableDS.R index c190ffc3..f524cfbe 100644 --- a/R/tableDS.R +++ b/R/tableDS.R @@ -33,6 +33,7 @@ #' of \code{ds.table}. Fully specified by argument of \code{ds.table} #' @return For information see help for \code{ds.table} #' @author Paul Burton for DataSHIELD Development Team, 13/11/2019 +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' @export tableDS<-function(rvar.transmit, cvar.transmit, stvar.transmit, rvar.all.unique.levels.transmit, cvar.all.unique.levels.transmit, stvar.all.unique.levels.transmit, exclude.transmit, useNA.transmit, force.nfilter.transmit){ @@ -55,7 +56,7 @@ nfilter.tab<-as.numeric(thr$nfilter.tab) # if(!is.null(force.nfilter.transmit)) { -force.nfilter.active<-eval(parse(text=force.nfilter.transmit), envir = parent.frame()) +force.nfilter.active<-.loadServersideObject(force.nfilter.transmit) if(force.nfilter.active argument of \code{ds.table} #' @return For information see help for \code{ds.table} #' @author Paul Burton for DataSHIELD Development Team, 13/11/2019 +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' @export tableDS.assign<-function(rvar.transmit, cvar.transmit, stvar.transmit, rvar.all.unique.levels.transmit, cvar.all.unique.levels.transmit, stvar.all.unique.levels.transmit, exclude.transmit, useNA.transmit){ #Activate via eval when needed #rvar -rvar<-eval(parse(text=rvar.transmit), envir = parent.frame()) +rvar<-.loadServersideObject(rvar.transmit) #coerce to factor if required if(!is.factor(rvar)) @@ -53,7 +54,7 @@ if(!is.factor(rvar)) #cvar if(!is.null(cvar.transmit)) { -cvar<-eval(parse(text=cvar.transmit), envir = parent.frame()) +cvar<-.loadServersideObject(cvar.transmit) #coerce to factor if required if(!is.factor(cvar)) @@ -73,7 +74,7 @@ cvar<-NULL #stvar if(!is.null(stvar.transmit)) { -stvar<-eval(parse(text=stvar.transmit), envir = parent.frame()) +stvar<-.loadServersideObject(stvar.transmit) #coerce to factor if required if(!is.factor(stvar)) diff --git a/R/tableDS2.R b/R/tableDS2.R index 3ea4803b..81886679 100644 --- a/R/tableDS2.R +++ b/R/tableDS2.R @@ -28,19 +28,18 @@ #' For more information see help for \code{ds.table} #' @return For information see help for \code{ds.table} #' @author Paul Burton for DataSHIELD Development Team, 13/11/2019 +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' @export tableDS2 <- function(newobj,rvar.transmit,cvar.transmit,stvar.transmit){ -calltext1<-paste0("out.table.real<-",newobj,"[[2]]") -eval(parse(text=calltext1), envir = parent.frame()) +table.obj <- .loadServersideObject(newobj) +out.table.real <- table.obj[[2]] out.table.cell.IDs<-as.vector(1:length(out.table.real)) -calltext2<-paste0("out.table.dim<-",newobj,"[[3]]") -eval(parse(text=calltext2), envir = parent.frame()) +out.table.dim <- table.obj[[3]] -calltext3<-paste0("out.table.dimnames<-",newobj,"[[4]]") -eval(parse(text=calltext3), envir = parent.frame()) +out.table.dimnames <- table.obj[[4]] out.table.structure<-array(out.table.cell.IDs,dim=out.table.dim,dimnames=out.table.dimnames) diff --git a/R/tapplyDS.R b/R/tapplyDS.R index 363589b8..5b620144 100644 --- a/R/tapplyDS.R +++ b/R/tapplyDS.R @@ -13,6 +13,7 @@ #' @return an array of the summarized values created by the tapplyDS function. This array #' is returned to the clientside. It has the same number of dimensions as INDEX. #' @author Paul Burton, Demetris Avraam for DataSHIELD Development Team +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' @export tapplyDS <- function(X.name, INDEX.names.transmit, FUN.name){ @@ -22,7 +23,7 @@ tapplyDS <- function(X.name, INDEX.names.transmit, FUN.name){ nfilter.subset <- as.numeric(thr$nfilter.subset) if(is.character(X.name)){ - X <- eval(parse(text=X.name), envir = parent.frame()) + X <- .loadServersideObject(X.name) }else{ studysideMessage <- "ERROR: X.name must be specified as a character string" stop(studysideMessage, call. = FALSE) @@ -39,8 +40,8 @@ tapplyDS <- function(X.name, INDEX.names.transmit, FUN.name){ for(g in 1:num.factors){ activation.text.0 <- paste0("INDEX.factors[",g,"]") - active.factor.name <- eval(parse(text=activation.text.0)) - active.factor <- eval(parse(text=active.factor.name), envir = parent.frame()) + active.factor.name <- INDEX.factors[g] + active.factor <- .loadServersideObject(active.factor.name) length.test.vector[g] <- length(active.factor) } @@ -52,8 +53,10 @@ tapplyDS <- function(X.name, INDEX.names.transmit, FUN.name){ } # convert INDEX.names format from transmittable to actionable form (a list of vectors) - INDEX.names.list <- paste0("list(",INDEX.names.transmit,")") - INDEX <- eval(parse(text=INDEX.names.list), envir = parent.frame()) + INDEX <- vector("list", num.factors) + for(g in 1:num.factors){ + INDEX[[g]] <- .loadServersideObject(INDEX.factors[g]) + } # select complete cases on X and all INDEX factors only df <- as.data.frame(cbind(X, do.call(cbind, INDEX))) diff --git a/R/tapplyDS.assign.R b/R/tapplyDS.assign.R index 1e3ce77f..5f2978ff 100644 --- a/R/tapplyDS.assign.R +++ b/R/tapplyDS.assign.R @@ -13,6 +13,7 @@ #' @return an array of the summarized values created by the \code{tapplyDS.assign} function. This #' array is written as a newobj on the serverside. It has the same number of dimensions as INDEX. #' @author Paul Burton, Demetris Avraam for DataSHIELD Development Team +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' @export tapplyDS.assign <- function(X.name, INDEX.names.transmit, FUN.name){ @@ -22,7 +23,7 @@ tapplyDS.assign <- function(X.name, INDEX.names.transmit, FUN.name){ nfilter.subset <- as.numeric(thr$nfilter.subset) if(is.character(X.name)){ - X <- eval(parse(text=X.name), envir = parent.frame()) + X <- .loadServersideObject(X.name) }else{ studysideMessage <- "ERROR: X.name must be specified as a character string" stop(studysideMessage, call. = FALSE) @@ -38,9 +39,8 @@ tapplyDS.assign <- function(X.name, INDEX.names.transmit, FUN.name){ length.test.vector <- rep(NA, num.factors) for(g in 1:num.factors){ - activation.text.0 <- paste0("INDEX.factors[",g,"]") - active.factor.name <- eval(parse(text=activation.text.0)) - active.factor <- eval(parse(text=active.factor.name), envir = parent.frame()) + active.factor.name <- INDEX.factors[g] + active.factor <- .loadServersideObject(active.factor.name) length.test.vector[g] <- length(active.factor) } @@ -52,8 +52,10 @@ tapplyDS.assign <- function(X.name, INDEX.names.transmit, FUN.name){ } # convert INDEX.names format from transmittable to actionable form (a list of vectors) - INDEX.names.list <- paste0("list(",INDEX.names.transmit,")") - INDEX <- eval(parse(text=INDEX.names.list), envir = parent.frame()) + INDEX <- vector("list", num.factors) + for(g in 1:num.factors){ + INDEX[[g]] <- .loadServersideObject(INDEX.factors[g]) + } # select complete cases on X and all INDEX factors only df <- as.data.frame(cbind(X, do.call(cbind, INDEX))) diff --git a/man/elsplineDS.Rd b/man/elsplineDS.Rd index 1d0c7fd5..d3a81fe5 100644 --- a/man/elsplineDS.Rd +++ b/man/elsplineDS.Rd @@ -36,4 +36,6 @@ range of x into n equal-width intervals. } \author{ Demetris Avraam for DataSHIELD Development Team + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/man/getWGSRDS.Rd b/man/getWGSRDS.Rd index 4ecc45b2..98aa2f36 100644 --- a/man/getWGSRDS.Rd +++ b/man/getWGSRDS.Rd @@ -69,4 +69,6 @@ data. } \author{ Demetris Avraam for DataSHIELD Development Team + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/man/hetcorDS.Rd b/man/hetcorDS.Rd index 2745ce65..5c558936 100644 --- a/man/hetcorDS.Rd +++ b/man/hetcorDS.Rd @@ -44,4 +44,6 @@ variables, and polychoric correlations between ordinal variables. } \author{ Demetris Avraam for DataSHIELD Development Team + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/man/lexisDS1.Rd b/man/lexisDS1.Rd index da419723..9b560add 100644 --- a/man/lexisDS1.Rd +++ b/man/lexisDS1.Rd @@ -21,4 +21,6 @@ For more details see the extensive header for ds.lexis. } \author{ Burton PR + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/man/lexisDS2.Rd b/man/lexisDS2.Rd index 51ca6851..6b9ca122 100644 --- a/man/lexisDS2.Rd +++ b/man/lexisDS2.Rd @@ -62,4 +62,6 @@ For more details see the extensive header for ds.lexis. } \author{ Burton PR + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/man/lsplineDS.Rd b/man/lsplineDS.Rd index 23445b51..af17aa0f 100644 --- a/man/lsplineDS.Rd +++ b/man/lsplineDS.Rd @@ -33,4 +33,6 @@ in slope as compared to the previous segment. } \author{ Demetris Avraam for DataSHIELD Development Team + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/man/metadataDS.Rd b/man/metadataDS.Rd index f7749090..5851b7a3 100644 --- a/man/metadataDS.Rd +++ b/man/metadataDS.Rd @@ -21,4 +21,6 @@ The function returns the metadata, obtained from attributes function. } \author{ Stuart Wheater, for DataSHIELD Development Team + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/man/nsDS.Rd b/man/nsDS.Rd index 302bd919..060ff5a3 100644 --- a/man/nsDS.Rd +++ b/man/nsDS.Rd @@ -44,4 +44,6 @@ A primary use is in modeling formula to directly specify a natural spline term i } \author{ Demetris Avraam for DataSHIELD Development Team + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/man/qlsplineDS.Rd b/man/qlsplineDS.Rd index aa14326a..63c81831 100644 --- a/man/qlsplineDS.Rd +++ b/man/qlsplineDS.Rd @@ -42,4 +42,6 @@ probabilities directly (the vector is passed to argument probs of quantile). } \author{ Demetris Avraam for DataSHIELD Development Team + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/man/rowColCalcDS.Rd b/man/rowColCalcDS.Rd index 28bd8b01..aaf4c93d 100644 --- a/man/rowColCalcDS.Rd +++ b/man/rowColCalcDS.Rd @@ -4,10 +4,10 @@ \alias{rowColCalcDS} \title{Computes sums and means of rows or columns of numeric arrays} \usage{ -rowColCalcDS(dataset, operation) +rowColCalcDS(dataset.name, operation) } \arguments{ -\item{dataset}{an array of two or more dimensions.} +\item{dataset.name}{a character string providing the name of a server-side array of two or more dimensions.} \item{operation}{an integer that indicates the operation to carry out: 1 for 'rowSums', 2 for 'colSums', 3 for 'rowMeans' or 4 for 'colMeans'} @@ -25,4 +25,6 @@ output vector is greater or equal to the allowed size. } \author{ Gaye, A. + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/man/tableDS.Rd b/man/tableDS.Rd index 752eb815..7314c2ee 100644 --- a/man/tableDS.Rd +++ b/man/tableDS.Rd @@ -67,4 +67,6 @@ in native R. } \author{ Paul Burton for DataSHIELD Development Team, 13/11/2019 + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/man/tableDS.assign.Rd b/man/tableDS.assign.Rd index 8214ab3d..4989ec5d 100644 --- a/man/tableDS.assign.Rd +++ b/man/tableDS.assign.Rd @@ -65,4 +65,6 @@ in native R. } \author{ Paul Burton for DataSHIELD Development Team, 13/11/2019 + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/man/tableDS2.Rd b/man/tableDS2.Rd index 86e27027..1538d621 100644 --- a/man/tableDS2.Rd +++ b/man/tableDS2.Rd @@ -47,4 +47,6 @@ in DataSHIELD and the \code{table} function in native R. } \author{ Paul Burton for DataSHIELD Development Team, 13/11/2019 + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/man/tapplyDS.Rd b/man/tapplyDS.Rd index b72ed2f5..c7d62d84 100644 --- a/man/tapplyDS.Rd +++ b/man/tapplyDS.Rd @@ -31,4 +31,6 @@ see details for \code{ds.tapply} function } \author{ Paul Burton, Demetris Avraam for DataSHIELD Development Team + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/man/tapplyDS.assign.Rd b/man/tapplyDS.assign.Rd index f57d4f03..7beac224 100644 --- a/man/tapplyDS.assign.Rd +++ b/man/tapplyDS.assign.Rd @@ -31,4 +31,6 @@ see details for \code{ds.tapply.assign} function } \author{ Paul Burton, Demetris Avraam for DataSHIELD Development Team + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/tests/testthat/test-perf-meanDS.R b/tests/testthat/test-perf-meanDS.R index 53e4c7af..3cb30a2e 100644 --- a/tests/testthat/test-perf-meanDS.R +++ b/tests/testthat/test-perf-meanDS.R @@ -13,8 +13,8 @@ # # avoid performance tests on CRAN and GitHub Actions -testthat::skip_on_cran() -testthat::skip_on_ci() +# testthat::skip_on_cran() +# testthat::skip_on_ci() # context("meanDS::perf::setup") diff --git a/tests/testthat/test-perf-varDS.R b/tests/testthat/test-perf-varDS.R index 9df6c0f6..3870f0f3 100644 --- a/tests/testthat/test-perf-varDS.R +++ b/tests/testthat/test-perf-varDS.R @@ -13,8 +13,8 @@ # # avoid performance tests on CRAN and GitHub Actions -testthat::skip_on_cran() -testthat::skip_on_ci() +# testthat::skip_on_cran() +# testthat::skip_on_ci() # context("varDS::perf::setup") diff --git a/tests/testthat/test-smk-elsplineDS.R b/tests/testthat/test-smk-elsplineDS.R new file mode 100644 index 00000000..abc895c1 --- /dev/null +++ b/tests/testthat/test-smk-elsplineDS.R @@ -0,0 +1,49 @@ +#------------------------------------------------------------------------------- +# Copyright (c) 2019-2022 University of Newcastle upon Tyne. All rights reserved. +# Copyright (c) 2022-2025 Arjuna Technologies, Newcastle upon Tyne. All rights reserved. +# +# This program and the accompanying materials +# are made available under the terms of the GNU Public License v3.0. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . +#------------------------------------------------------------------------------- + +# +# Set up +# + +# context("elsplineDS::smk::setup") + +set.standard.disclosure.settings() + +# +# Tests +# + +# context("elsplineDS::smk") +test_that("simple elsplineDS", { + input <- seq(1, 30, by = 1) + + res <- elsplineDS("input", 3) + + expect_equal(class(res), c("lspline", "matrix")) + expect_equal(dim(res), c(30, 3)) + expect_equal(unname(res[1, ]), c(1, 0, 0)) + expect_equal(unname(res[30, ]), c(10.66667, 9.666667, 9.666667), tolerance = 1e-6) +}) + +test_that("elsplineDS throws error when object does not exist", { + expect_error( + elsplineDS("nonexistent_object", 3), + regexp = "does not exist" + ) +}) + +# +# Done +# + +# context("elsplineDS::smk::shutdown") + +# context("elsplineDS::smk::done") diff --git a/tests/testthat/test-smk-getWGSRDS.R b/tests/testthat/test-smk-getWGSRDS.R index 73d0eda1..439f994c 100644 --- a/tests/testthat/test-smk-getWGSRDS.R +++ b/tests/testthat/test-smk-getWGSRDS.R @@ -149,6 +149,37 @@ test_that("simple getWGSRDS - mfa", { expect_true(is.na(res[10])) }) +test_that("getWGSRDS throws error when firstPart does not exist", { + expect_error( + getWGSRDS("data$sex", "nonexistent_object", "data$age", "hfa", NA, NA), + regexp = "does not exist" + ) +}) + +test_that("getWGSRDS throws error when firstPart is not numeric or integer", { + bad_input <- factor(c("a", "b")) + expect_error( + getWGSRDS("data$sex", "bad_input", "data$age", "hfa", NA, NA), + regexp = "must be of type numeric or integer" + ) +}) + +test_that("getWGSRDS throws error when secondPart is not numeric or integer", { + bad_input <- factor(c("a", "b")) + expect_error( + getWGSRDS("data$sex", "data$height", "bad_input", "hfa", NA, NA), + regexp = "must be of type numeric or integer" + ) +}) + +test_that("getWGSRDS throws error when thirdPart is not numeric or integer", { + bad_input <- factor(c("a", "b")) + expect_error( + getWGSRDS("data$sex", "data$weight", "data$height", "bfa", NA, "bad_input"), + regexp = "must be of type numeric or integer" + ) +}) + # # Done # diff --git a/tests/testthat/test-smk-lexisDS1.R b/tests/testthat/test-smk-lexisDS1.R new file mode 100644 index 00000000..d5539611 --- /dev/null +++ b/tests/testthat/test-smk-lexisDS1.R @@ -0,0 +1,50 @@ +#------------------------------------------------------------------------------- +# Copyright (c) 2019-2022 University of Newcastle upon Tyne. All rights reserved. +# Copyright (c) 2022-2025 Arjuna Technologies, Newcastle upon Tyne. All rights reserved. +# +# This program and the accompanying materials +# are made available under the terms of the GNU Public License v3.0. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . +#------------------------------------------------------------------------------- + +# +# Set up +# + +# context("lexisDS1::smk::setup") + +set.standard.disclosure.settings() + +# +# Tests +# + +# context("lexisDS1::smk") +test_that("simple lexisDS1", { + input <- c(1, 5, 3, 9, 2) + + res <- lexisDS1("input") + + expect_equal(class(res), "list") + expect_equal(names(res), "max.time") + # max.time is the max exposure time masked by a random +1%-5% increment + expect_gte(res$max.time, 9 * 1.01) + expect_lte(res$max.time, 9 * 1.05) +}) + +test_that("lexisDS1 throws error when object does not exist", { + expect_error( + lexisDS1("nonexistent_object"), + regexp = "does not exist" + ) +}) + +# +# Done +# + +# context("lexisDS1::smk::shutdown") + +# context("lexisDS1::smk::done") diff --git a/tests/testthat/test-smk-lexisDS2.R b/tests/testthat/test-smk-lexisDS2.R new file mode 100644 index 00000000..8e0c10fc --- /dev/null +++ b/tests/testthat/test-smk-lexisDS2.R @@ -0,0 +1,88 @@ +#------------------------------------------------------------------------------- +# Copyright (c) 2019-2022 University of Newcastle upon Tyne. All rights reserved. +# Copyright (c) 2022-2025 Arjuna Technologies, Newcastle upon Tyne. All rights reserved. +# +# This program and the accompanying materials +# are made available under the terms of the GNU Public License v3.0. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . +#------------------------------------------------------------------------------- + +# +# Set up +# + +# context("lexisDS2::smk::setup") + +set.standard.disclosure.settings() + +# +# Tests +# + +# context("lexisDS2::smk::datatext") +test_that("simple lexisDS2, datatext names a whole data.frame", { + D <- data.frame(id = 1:6, start = rep(0, 6), end = rep(5, 6), status = rep(1, 6), extra = 101:106) + + res <- lexisDS2( + datatext = "D", intervalWidth = "10", maxmaxtime = 10, + idCol = "D$id", entryCol = "D$start", exitCol = "D$end", statusCol = "D$status", vartext = NULL + ) + + expect_equal(class(res), "list") + # carried-forward columns must keep D's own column names, not be corrupted + # or misaligned by the data.frame construction (see lexisDS2 datatext/vartext handling) + expect_true(all(c("id", "start", "end", "status", "extra") %in% names(res$expanded.table))) + expect_equal(res$expanded.table$extra, 101:106) + expect_equal(nrow(res$expanded.table), 6) +}) + +# context("lexisDS2::smk::vartext") +test_that("simple lexisDS2, vartext names individual $-qualified columns", { + D <- data.frame(id = 1:6, start = rep(0, 6), end = rep(5, 6), status = rep(1, 6), extra = 101:106, extra2 = 201:206) + + res <- lexisDS2( + datatext = NULL, intervalWidth = "10", maxmaxtime = 10, + idCol = "D$id", entryCol = "D$start", exitCol = "D$end", statusCol = "D$status", + vartext = "D$extra,D$extra2" + ) + + expect_equal(class(res), "list") + expect_true(all(c("D.extra", "D.extra2") %in% names(res$expanded.table))) + expect_equal(res$expanded.table$D.extra, 101:106) + expect_equal(res$expanded.table$D.extra2, 201:206) +}) + +# context("lexisDS2::smk::no.carry.forward") +test_that("simple lexisDS2, no datatext or vartext", { + D <- data.frame(id = 1:6, start = rep(0, 6), end = rep(5, 6), status = rep(1, 6)) + + res <- lexisDS2( + datatext = NULL, intervalWidth = "10", maxmaxtime = 10, + idCol = "D$id", entryCol = "D$start", exitCol = "D$end", statusCol = "D$status", vartext = NULL + ) + + expect_equal(class(res), "list") + expect_equal(nrow(res$expanded.table), 6) +}) + +test_that("lexisDS2 throws error when object does not exist", { + D <- data.frame(id = 1:6, start = rep(0, 6), end = rep(5, 6), status = rep(1, 6)) + + expect_error( + lexisDS2( + datatext = NULL, intervalWidth = "10", maxmaxtime = 10, + idCol = "D$id", entryCol = "D$start", exitCol = "nonexistent_object", statusCol = "D$status", vartext = NULL + ), + regexp = "does not exist" + ) +}) + +# +# Done +# + +# context("lexisDS2::smk::shutdown") + +# context("lexisDS2::smk::done") diff --git a/tests/testthat/test-smk-lsplineDS.R b/tests/testthat/test-smk-lsplineDS.R new file mode 100644 index 00000000..2d52ca57 --- /dev/null +++ b/tests/testthat/test-smk-lsplineDS.R @@ -0,0 +1,49 @@ +#------------------------------------------------------------------------------- +# Copyright (c) 2019-2022 University of Newcastle upon Tyne. All rights reserved. +# Copyright (c) 2022-2025 Arjuna Technologies, Newcastle upon Tyne. All rights reserved. +# +# This program and the accompanying materials +# are made available under the terms of the GNU Public License v3.0. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . +#------------------------------------------------------------------------------- + +# +# Set up +# + +# context("lsplineDS::smk::setup") + +set.standard.disclosure.settings() + +# +# Tests +# + +# context("lsplineDS::smk") +test_that("simple lsplineDS", { + input <- seq(1, 30, by = 1) + + res <- lsplineDS("input", knots = c(10, 20)) + + expect_equal(class(res), c("lspline", "matrix")) + expect_equal(dim(res), c(30, 3)) + expect_equal(unname(res[1, ]), c(1, 0, 0)) + expect_equal(unname(res[30, ]), c(10, 10, 10)) +}) + +test_that("lsplineDS throws error when object does not exist", { + expect_error( + lsplineDS("nonexistent_object", knots = c(10, 20)), + regexp = "does not exist" + ) +}) + +# +# Done +# + +# context("lsplineDS::smk::shutdown") + +# context("lsplineDS::smk::done") diff --git a/tests/testthat/test-smk-nsDS.R b/tests/testthat/test-smk-nsDS.R new file mode 100644 index 00000000..07badac9 --- /dev/null +++ b/tests/testthat/test-smk-nsDS.R @@ -0,0 +1,48 @@ +#------------------------------------------------------------------------------- +# Copyright (c) 2019-2022 University of Newcastle upon Tyne. All rights reserved. +# Copyright (c) 2022-2025 Arjuna Technologies, Newcastle upon Tyne. All rights reserved. +# +# This program and the accompanying materials +# are made available under the terms of the GNU Public License v3.0. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . +#------------------------------------------------------------------------------- + +# +# Set up +# + +# context("nsDS::smk::setup") + +set.standard.disclosure.settings() + +# +# Tests +# + +# context("nsDS::smk") +test_that("simple nsDS", { + input <- seq(1, 30, by = 1) + + res <- nsDS("input", df = 3, knots = NULL, intercept = FALSE, Boundary.knots = NULL) + + expect_equal(class(res), c("ns", "basis", "matrix")) + expect_equal(dim(res), c(30, 3)) + expect_equal(unname(res[1, ]), c(0, 0, 0)) +}) + +test_that("nsDS throws error when object does not exist", { + expect_error( + nsDS("nonexistent_object", df = 3, knots = NULL, intercept = FALSE, Boundary.knots = NULL), + regexp = "does not exist" + ) +}) + +# +# Done +# + +# context("nsDS::smk::shutdown") + +# context("nsDS::smk::done") diff --git a/tests/testthat/test-smk-qlsplineDS.R b/tests/testthat/test-smk-qlsplineDS.R new file mode 100644 index 00000000..42066853 --- /dev/null +++ b/tests/testthat/test-smk-qlsplineDS.R @@ -0,0 +1,48 @@ +#------------------------------------------------------------------------------- +# Copyright (c) 2019-2022 University of Newcastle upon Tyne. All rights reserved. +# Copyright (c) 2022-2025 Arjuna Technologies, Newcastle upon Tyne. All rights reserved. +# +# This program and the accompanying materials +# are made available under the terms of the GNU Public License v3.0. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . +#------------------------------------------------------------------------------- + +# +# Set up +# + +# context("qlsplineDS::smk::setup") + +set.standard.disclosure.settings() + +# +# Tests +# + +# context("qlsplineDS::smk") +test_that("simple qlsplineDS", { + input <- seq(1, 30, by = 1) + + res <- qlsplineDS("input", q = 3, na.rm = TRUE, marginal = FALSE) + + expect_equal(class(res), c("lspline", "matrix")) + expect_equal(dim(res), c(30, 3)) + expect_equal(unname(res[1, ]), c(1, 0, 0)) +}) + +test_that("qlsplineDS throws error when object does not exist", { + expect_error( + qlsplineDS("nonexistent_object", q = 3, na.rm = TRUE, marginal = FALSE), + regexp = "does not exist" + ) +}) + +# +# Done +# + +# context("qlsplineDS::smk::shutdown") + +# context("qlsplineDS::smk::done") diff --git a/tests/testthat/test-smk-rowColCalcDS.R b/tests/testthat/test-smk-rowColCalcDS.R index 615aa2ff..d7b89470 100644 --- a/tests/testthat/test-smk-rowColCalcDS.R +++ b/tests/testthat/test-smk-rowColCalcDS.R @@ -25,7 +25,7 @@ set.standard.disclosure.settings() test_that("simple rowColCalcDS, operation 1", { input <- matrix(c(0.0, 1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0), ncol = 2) - res <- rowColCalcDS(input, 1) + res <- rowColCalcDS("input", 1) expect_equal(class(res), "numeric") expect_length(res, 4) @@ -38,7 +38,7 @@ test_that("simple rowColCalcDS, operation 1", { test_that("simple rowColCalcDS, operation 2", { input <- matrix(c(0.0, 1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0), ncol = 4) - res <- rowColCalcDS(input, 2) + res <- rowColCalcDS("input", 2) expect_equal(class(res), "numeric") expect_length(res, 4) @@ -51,7 +51,7 @@ test_that("simple rowColCalcDS, operation 2", { test_that("simple rowColCalcDS, operation 3", { input <- matrix(c(0.0, 1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0), ncol = 2) - res <- rowColCalcDS(input, 3) + res <- rowColCalcDS("input", 3) expect_equal(class(res), "numeric") expect_length(res, 4) @@ -64,7 +64,7 @@ test_that("simple rowColCalcDS, operation 3", { test_that("simple rowColCalcDS, operation 4", { input <- matrix(c(0.0, 1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0), ncol = 4) - res <- rowColCalcDS(input, 4) + res <- rowColCalcDS("input", 4) expect_equal(class(res), "numeric") expect_length(res, 4) @@ -74,6 +74,21 @@ test_that("simple rowColCalcDS, operation 4", { expect_equal(res[4], 6.5) }) +test_that("rowColCalcDS throws error when object does not exist", { + expect_error( + rowColCalcDS("nonexistent_object", 1), + regexp = "does not exist" + ) +}) + +test_that("rowColCalcDS throws error when object is not data.frame or matrix", { + bad_input <- list(a = 1:3, b = 4:6) + expect_error( + rowColCalcDS("bad_input", 1), + regexp = "must be of type data.frame or matrix" + ) +}) + # # Done # diff --git a/tests/testthat/test-smk-tableDS.R b/tests/testthat/test-smk-tableDS.R new file mode 100644 index 00000000..6ffdb46c --- /dev/null +++ b/tests/testthat/test-smk-tableDS.R @@ -0,0 +1,60 @@ +#------------------------------------------------------------------------------- +# Copyright (c) 2019-2022 University of Newcastle upon Tyne. All rights reserved. +# Copyright (c) 2022-2025 Arjuna Technologies, Newcastle upon Tyne. All rights reserved. +# +# This program and the accompanying materials +# are made available under the terms of the GNU Public License v3.0. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . +#------------------------------------------------------------------------------- + +# +# Set up +# + +# context("tableDS::smk::setup") + +set.standard.disclosure.settings() + +# +# Tests +# + +# context("tableDS::smk::1D") +test_that("simple tableDS, 1D", { + input <- factor(rep(c("a", "b"), each = 5)) + + res <- tableDS("input", NULL, NULL, "a,b", NULL, NULL, NULL, "no", NULL) + + expect_equal(class(res), "table") + expect_equal(as.vector(res), c(5, 5)) + expect_equal(names(res), c("a", "b")) +}) + +# context("tableDS::smk::2D") +test_that("simple tableDS, 2D", { + rvar <- factor(rep(c("a", "b"), each = 10)) + cvar <- factor(rep(rep(c("x", "y"), each = 5), 2)) + + res <- tableDS("rvar", "cvar", NULL, "a,b", "x,y", NULL, NULL, "no", NULL) + + expect_equal(class(res), "table") + expect_equal(dim(res), c(2L, 2L)) + expect_equal(as.vector(res), c(5, 5, 5, 5)) +}) + +test_that("tableDS throws error when object does not exist", { + expect_error( + tableDS("nonexistent_object", NULL, NULL, "a,b", NULL, NULL, NULL, "no", NULL), + regexp = "does not exist" + ) +}) + +# +# Done +# + +# context("tableDS::smk::shutdown") + +# context("tableDS::smk::done") diff --git a/tests/testthat/test-smk-tableDS.assign.R b/tests/testthat/test-smk-tableDS.assign.R new file mode 100644 index 00000000..a284ed28 --- /dev/null +++ b/tests/testthat/test-smk-tableDS.assign.R @@ -0,0 +1,50 @@ +#------------------------------------------------------------------------------- +# Copyright (c) 2019-2022 University of Newcastle upon Tyne. All rights reserved. +# Copyright (c) 2022-2025 Arjuna Technologies, Newcastle upon Tyne. All rights reserved. +# +# This program and the accompanying materials +# are made available under the terms of the GNU Public License v3.0. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . +#------------------------------------------------------------------------------- + +# +# Set up +# + +# context("tableDS.assign::smk::setup") + +set.standard.disclosure.settings() + +# +# Tests +# + +# context("tableDS.assign::smk") +test_that("simple tableDS.assign", { + rvar <- factor(rep(c("a", "b"), each = 10)) + cvar <- factor(rep(rep(c("x", "y"), each = 5), 2)) + + res <- tableDS.assign("rvar", "cvar", NULL, "a,b", "x,y", NULL, NULL, "no") + + expect_equal(class(res), "list") + expect_equal(names(res), c("table", "counts", "dim", "dimnames")) + expect_equal(res$dim, c(2L, 2L)) + expect_equal(res$counts, c(5, 5, 5, 5)) +}) + +test_that("tableDS.assign throws error when object does not exist", { + expect_error( + tableDS.assign("nonexistent_object", NULL, NULL, "a,b", NULL, NULL, NULL, "no"), + regexp = "does not exist" + ) +}) + +# +# Done +# + +# context("tableDS.assign::smk::shutdown") + +# context("tableDS.assign::smk::done") diff --git a/tests/testthat/test-smk-tableDS2.R b/tests/testthat/test-smk-tableDS2.R new file mode 100644 index 00000000..7f842297 --- /dev/null +++ b/tests/testthat/test-smk-tableDS2.R @@ -0,0 +1,54 @@ +#------------------------------------------------------------------------------- +# Copyright (c) 2019-2022 University of Newcastle upon Tyne. All rights reserved. +# Copyright (c) 2022-2025 Arjuna Technologies, Newcastle upon Tyne. All rights reserved. +# +# This program and the accompanying materials +# are made available under the terms of the GNU Public License v3.0. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . +#------------------------------------------------------------------------------- + +# +# Set up +# + +# context("tableDS2::smk::setup") + +set.standard.disclosure.settings() + +# +# Tests +# + +# context("tableDS2::smk") +test_that("simple tableDS2", { + rvar <- factor(rep(c("a", "b"), each = 10)) + cvar <- factor(rep(rep(c("x", "y"), each = 5), 2)) + res.assign <- tableDS.assign("rvar", "cvar", NULL, "a,b", "x,y", NULL, NULL, "no") + + res <- tableDS2("res.assign", "rvar", "cvar", NULL) + + expect_equal(class(res), "list") + expect_equal( + names(res), + c("table.cell.IDs", "table.dim", "table.dimnames", "table.structure_and_cell.order") + ) + expect_equal(res$table.dim, c(2L, 2L)) + expect_equal(res$table.cell.IDs, 1:4) +}) + +test_that("tableDS2 throws error when object does not exist", { + expect_error( + tableDS2("nonexistent_object", "rvar", "cvar", NULL), + regexp = "does not exist" + ) +}) + +# +# Done +# + +# context("tableDS2::smk::shutdown") + +# context("tableDS2::smk::done")