diff --git a/R/boxPlotGGDS.R b/R/boxPlotGGDS.R index 11b6fd90..6ee33824 100644 --- a/R/boxPlotGGDS.R +++ b/R/boxPlotGGDS.R @@ -5,7 +5,7 @@ #' parameters are passed. There are three different cases depending if there are grouping variables. #' The outliers are also removed from the graphical parameters. #' -#' @param data_table \code{data frame} Table that holds the information to be plotted, arranged as: \cr +#' @param data_table.name \code{character} Name of a server-side data frame that holds the information to be plotted, arranged as: \cr #' #' Column 'x': Names on the X axis of the boxplot, aka variables to plot \cr #' Column 'value': Values for that variable (raw data of columns rbinded) \cr @@ -18,11 +18,14 @@ #' @return \code{list} with: \cr #' -\code{data frame} Geometrical parameters (identity stats of ggplot) \cr #' -\code{character} Type of plot (single_group, double_group or no_group) \cr -#' +#' +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' @export -boxPlotGGDS <- function(data_table, group = NULL, group2 = NULL){ - +boxPlotGGDS <- function(data_table.name, group = NULL, group2 = NULL){ + + data_table <- .loadServersideObject(data_table.name) + ################################################################### # MODULE 1: CAPTURE THE subset filter SETTINGS # thr <- dsBase::listDisclosureSettingsDS() # diff --git a/R/boxPlotGG_data_TreatmentDS.R b/R/boxPlotGG_data_TreatmentDS.R index 7d6613d1..c3a18e67 100644 --- a/R/boxPlotGG_data_TreatmentDS.R +++ b/R/boxPlotGG_data_TreatmentDS.R @@ -1,42 +1,46 @@ #' @title Arrange data frame to pass it to the boxplot function #' -#' @param table \code{data frame} Table that holds the information to be plotted later +#' @param table.name \code{character} Name of a server-side data frame that holds the information to be plotted later #' @param variables \code{character vector} Name of the column(s) of the data frame to include on the boxplot -#' @param group \code{character} (default \code{NULL}) Name of the first grouping variable. -#' @param group2 \code{character} (default \code{NULL}) Name of the second grouping variable. +#' @param group \code{character} (default \code{NULL}) Name of the first grouping variable. +#' @param group2 \code{character} (default \code{NULL}) Name of the second grouping variable. #' #' @return \code{data frame} with the following structure: \cr -#' +#' #' Column 'x': Names on the X axis of the boxplot, aka variables to plot \cr #' Column 'value': Values for that variable (raw data of columns rbinded) \cr #' Column 'group': (Optional) Values of the grouping variable \cr #' Column 'group2': (Optional) Values of the second grouping variable \cr -#' +#' +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' @export -boxPlotGG_data_TreatmentDS <- function(table, variables, group = NULL, group2 = NULL){ +boxPlotGG_data_TreatmentDS <- function(table.name, variables, group = NULL, group2 = NULL){ + + table <- .loadServersideObject(table.name) + + for(variable in variables){ + .checkClass(obj = table[[variable]], obj_name = variable, permitted_classes = c("numeric", "integer")) + } if(is.null(group) & !is.null(group2)){ group <- group2 group2 <- NULL } - + if(is.null(group2)){ if(is.null(group)){ data <- table[, c(variables)] } else{ - if(! any(c("factor") %in% class(table[[group]]))) { - stop("Grouping variable must be of class factor") - } + .checkClass(obj = table[[group]], obj_name = group, permitted_classes = c("factor")) data <- table[, c(variables, group)] } - + } else{ - if((! any(c("factor") %in% class(table[[group]]))) | (! any(c("factor") %in% class(table[[group2]])))){ - stop("Grouping variable must be of class factor") - } + .checkClass(obj = table[[group]], obj_name = group, permitted_classes = c("factor")) + .checkClass(obj = table[[group2]], obj_name = group2, permitted_classes = c("factor")) data <- table[, c(variables, group, group2)] # Handle case group == group2 if(group == group2){ diff --git a/R/boxPlotGG_data_Treatment_numericDS.R b/R/boxPlotGG_data_Treatment_numericDS.R index 7374ca7d..feff4f0e 100644 --- a/R/boxPlotGG_data_Treatment_numericDS.R +++ b/R/boxPlotGG_data_Treatment_numericDS.R @@ -1,18 +1,22 @@ #' @title Arrange vector to pass it to the boxplot function #' -#' @param vector \code{numeric vector} Vector to arrange to be plotted later +#' @param vector.name \code{character} Name of a server-side numeric vector to arrange to be plotted later #' #' @return \code{data frame} with the following structure: \cr -#' -#' Column 'x': Names on the X axis of the boxplot, aka name of the vector (vector argument) \cr +#' +#' Column 'x': Names on the X axis of the boxplot, aka name of the vector (vector.name argument) \cr #' Column 'value': Values for that variable \cr -#' +#' +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' @export -boxPlotGG_data_Treatment_numericDS <- function(vector){ - - data <- data.frame(x = deparse(substitute(vector)), value = vector) - +boxPlotGG_data_Treatment_numericDS <- function(vector.name){ + + vector <- .loadServersideObject(vector.name) + .checkClass(obj = vector, obj_name = vector.name, permitted_classes = c("numeric", "integer")) + + data <- data.frame(x = vector.name, value = vector) + return(data) - + } \ No newline at end of file diff --git a/R/densityGridDS.R b/R/densityGridDS.R index 1569d5c1..1e16fc8a 100644 --- a/R/densityGridDS.R +++ b/R/densityGridDS.R @@ -3,24 +3,31 @@ #' @description Generates a density grid that can then be used for heatmap or contour plots. #' @details Invalid cells (cells with count < to the set filter value for the minimum allowed #' counts in table cells) are turn to 0. -#' @param xvect a numerical vector -#' @param yvect a numerical vector +#' @param x a character string providing the name of a server-side numerical vector +#' @param y a character string providing the name of a server-side numerical vector #' @param limits a logical expression for whether or not limits of the density grid are defined by -#' a user. If \code{limits} is set to "FALSE", min and max of xvect and yvect are used as a range. +#' a user. If \code{limits} is set to "FALSE", min and max of x and y are used as a range. #' If \code{limits} is set to "TRUE", limits defined by x.min, x.max, y.min and y.max are used. #' @param x.min a minimum value for the x axis of the grid density object, if needed #' @param x.max a maximum value for the x axis of the grid density object, if needed #' @param y.min a minimum value for the y axis of the grid density object, if needed #' @param y.max a maximum value for the y axis of the grid density object, if needed #' @param numints a number of intervals for the grid density object, by default is 20 -#' @return a grid density matrix +#' @return a list with the grid density matrix (\code{grid}) and the classes of the x and y inputs +#' (\code{class.x} and \code{class.y}) #' @author Julia Isaeva, Amadou Gaye, Demetris Avraam for DataSHIELD Development Team +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' @export -#' -densityGridDS <- function(xvect, yvect, limits=FALSE, x.min=NULL, x.max=NULL, y.min=NULL, y.max=NULL, numints=20){ - +#' +densityGridDS <- function(x, y, limits=FALSE, x.min=NULL, x.max=NULL, y.min=NULL, y.max=NULL, numints=20){ + + xvect <- .loadServersideObject(x) + yvect <- .loadServersideObject(y) + .checkClass(obj = xvect, obj_name = x, permitted_classes = c("numeric", "integer")) + .checkClass(obj = yvect, obj_name = y, permitted_classes = c("numeric", "integer")) + ############################################################# - # MODULE 1: CAPTURE THE nfilter SETTINGS + # MODULE 1: CAPTURE THE nfilter SETTINGS thr <- dsBase::listDisclosureSettingsDS() nfilter.tab <- as.numeric(thr$nfilter.tab) #nfilter.glm <- as.numeric(thr$nfilter.glm) @@ -93,9 +100,9 @@ densityGridDS <- function(xvect, yvect, limits=FALSE, x.min=NULL, x.max=NULL, y names(dimnames(grid.density.obj))[2] <- title.text names(dimnames(grid.density.obj))[1] <- '' - - return(grid.density.obj) - + + return(list(grid=grid.density.obj, class.x=class(xvect), class.y=class(yvect))) + } # AGGREGATE FUNCTION # densityGridDS diff --git a/R/heatmapPlotDS.R b/R/heatmapPlotDS.R index 349f57b9..d8afc61e 100644 --- a/R/heatmapPlotDS.R +++ b/R/heatmapPlotDS.R @@ -9,8 +9,8 @@ #' neighbours and the y-coordinate of the centroid is the average of the y-coordinates of the n nearest #' neighbours. The coordinates of the centroids return to the client side function and can be used for the #' plot of non-disclosive graphs (e.g. scatter plots, heatmap plots, contour plots, etc). -#' @param x the name of a numeric vector, the x-variable. -#' @param y the name of a numeric vector, the y-variable. +#' @param x.name a character string providing the name of a server-side numeric vector, the x-variable. +#' @param y.name a character string providing the name of a server-side numeric vector, the y-variable. #' @param k the number of the nearest neighbours for which their centroid is calculated if the #' \code{method.indicator} is equal to 1 (i.e. deterministic method). #' @param noise the percentage of the initial variance that is used as the variance of the embedded @@ -18,11 +18,18 @@ #' @param method.indicator a number equal to either 1 or 2. If the value is equal to 1 then the #' 'deterministic' method is used. If the value is set to 2 the 'probabilistic' method is used. #' @return a list with the x and y coordinates of the centroids if the deterministic method is used -#' or the x and y coordinated of the noisy data if the probabilistic method is used. +#' or the x and y coordinated of the noisy data if the probabilistic method is used, along with the +#' classes of the x and y inputs (\code{class.x} and \code{class.y}) #' @author Demetris Avraam for DataSHIELD Development Team +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' @export -#' -heatmapPlotDS <- function(x, y, k, noise, method.indicator){ +#' +heatmapPlotDS <- function(x.name, y.name, k, noise, method.indicator){ + + x <- .loadServersideObject(x.name) + y <- .loadServersideObject(y.name) + .checkClass(obj = x, obj_name = x.name, permitted_classes = c("numeric", "integer")) + .checkClass(obj = y, obj_name = y.name, permitted_classes = c("numeric", "integer")) ################################################################### # MODULE 1: CAPTURE THE nfilter SETTINGS # @@ -125,8 +132,8 @@ heatmapPlotDS <- function(x, y, k, noise, method.indicator){ } # Return a list with the x and y coordinates of the centroids - return(list(x.new, y.new)) - + return(list(x.new, y.new, class.x=class(x), class.y=class(y))) + } # AGGREGATE FUNCTION # heatmapPlotDS diff --git a/R/histogramDS1.R b/R/histogramDS1.R index 71ffc439..97e09780 100644 --- a/R/histogramDS1.R +++ b/R/histogramDS1.R @@ -7,7 +7,7 @@ #' function returns the minimum and maximum values of the vector with the scaled centroids. If the #' method.indicator is set to 3 (i.e. the 'probabilistic' method is used) the function returns the #' minimum and maximum values of the generated 'noisy' vector. -#' @param xvect the numeric vector for which the histogram is desired. +#' @param x a character string providing the name of the server-side numeric vector for which the histogram is desired. #' @param method.indicator a number equal to either 1, 2 or 3 indicating the method of disclosure #' control that is used for the generation of the histogram. If the value is equal to 1 then the #' 'smallCellsRule' is used. If the value is equal to 2 then the 'deterministic' method is used. @@ -16,11 +16,16 @@ #' \code{method.indicator} is equal to 2 (i.e. deterministic method). #' @param noise the percentage of the initial variance that is used as the variance of the embedded #' noise if the \code{method.indicator} is equal to 3 (i.e. probabilistic method). -#' @return a numeric vector which contains the minimum and the maximum values of the vector +#' @return a list with the numeric vector containing the minimum and the maximum values of the +#' vector (\code{range}) and the class of the input vector (\code{class}) #' @author Amadou Gaye, Demetris Avraam for DataSHIELD Development Team +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' @export #' -histogramDS1 <- function(xvect, method.indicator, k, noise){ +histogramDS1 <- function(x, method.indicator, k, noise){ + + xvect <- .loadServersideObject(x) + .checkClass(obj = xvect, obj_name = x, permitted_classes = c("numeric", "integer")) ################################################################## # MODULE 1: CAPTURE THE nfilter SETTINGS # @@ -43,110 +48,103 @@ histogramDS1 <- function(xvect, method.indicator, k, noise){ } else on.exit(if (exists(x = ".Random.seed", envir = globalenv())) remove(".Random.seed", envir = globalenv()), add = TRUE) - # print an error message if the input vector is not a numeric - if(!(is.numeric(xvect))){ - output <- "The input vector is not a numeric!" - }else{ - - if (method.indicator==1){ - - # the study-specific seed for random number generation - seed <- getOption("datashield.seed") - if (is.null(seed)) - stop("histogramDS1 requires 'datashield.seed' R option to operate", call.=FALSE) - set.seed(seed) - - rr <- c(min(xvect, na.rm=TRUE), max(xvect, na.rm=TRUE)) - if(rr[1] < 0){ min <- rr[1] * stats::runif(1, 1.01, 1.05) }else{ min <- rr[1] * stats::runif(1, 0.95, 0.99) } - if(rr[2] < 0){ max <- rr[2] * stats::runif(1, 0.95, 0.99) }else{ max <- rr[2] * stats::runif(1, 1.01, 1.05) } - - output <- c(min, max) - + if (method.indicator==1){ + + # the study-specific seed for random number generation + seed <- getOption("datashield.seed") + if (is.null(seed)) + stop("histogramDS1 requires 'datashield.seed' R option to operate", call.=FALSE) + set.seed(seed) + + rr <- c(min(xvect, na.rm=TRUE), max(xvect, na.rm=TRUE)) + if(rr[1] < 0){ min <- rr[1] * stats::runif(1, 1.01, 1.05) }else{ min <- rr[1] * stats::runif(1, 0.95, 0.99) } + if(rr[2] < 0){ max <- rr[2] * stats::runif(1, 0.95, 0.99) }else{ max <- rr[2] * stats::runif(1, 1.01, 1.05) } + + output <- c(min, max) + + } + + if(method.indicator==2){ + + # Remove any missing values + x <- stats::na.omit(xvect) + + # Standardise the variable + x.standardised <- (x-mean(x))/stats::sd(x) + + # Calculate the length of the variable after ommitting any NAs + N.data <- length(x) + + # Check if k is integer and has a value greater than or equal to the pre-specified threshold + # and less than or equal to the length of rows of data.complete minus the pre-specified threshold + if(k < nfilter.kNN | k > (N.data - nfilter.kNN)){ + stop(paste0("k must be greater than or equal to ", nfilter.kNN, " and less than or equal to ", (N.data-nfilter.kNN), "."), call.=FALSE) + }else{ + neighbours = k } - - if(method.indicator==2){ - - # Remove any missing values - x <- stats::na.omit(xvect) - - # Standardise the variable - x.standardised <- (x-mean(x))/stats::sd(x) - - # Calculate the length of the variable after ommitting any NAs - N.data <- length(x) - - # Check if k is integer and has a value greater than or equal to the pre-specified threshold - # and less than or equal to the length of rows of data.complete minus the pre-specified threshold - if(k < nfilter.kNN | k > (N.data - nfilter.kNN)){ - stop(paste0("k must be greater than or equal to ", nfilter.kNN, " and less than or equal to ", (N.data-nfilter.kNN), "."), call.=FALSE) - }else{ - neighbours = k - } - - # Find the k-1 nearest neighbours of each data point - nearest <- RANN::nn2(x.standardised, k = neighbours) - - # Calculate the centroid of each n nearest data points - x.centroid <- matrix() - for (i in 1:N.data){ - x.centroid[i] <- mean(x.standardised[nearest$nn.idx[i,1:neighbours]]) - } - - # Calculate the scaling factor - x.scalingFactor <- stats::sd(x.standardised)/stats::sd(x.centroid) - - # Apply the scaling factor to the centroids - x.masked <- x.centroid * x.scalingFactor - - # Shift the centroids back to the actual position and scale of the original data - x.new <- (x.masked * stats::sd(x)) + mean(x) - - # find the minimum and the maximum of the distribution - min <- min(x.new) - max <- max(x.new) - - output <- c(min, max) - + + # Find the k-1 nearest neighbours of each data point + nearest <- RANN::nn2(x.standardised, k = neighbours) + + # Calculate the centroid of each n nearest data points + x.centroid <- matrix() + for (i in 1:N.data){ + x.centroid[i] <- mean(x.standardised[nearest$nn.idx[i,1:neighbours]]) } - - if(method.indicator==3){ - - # Remove any missing values - x <- stats::na.omit(xvect) - - # Calculate the length of the variable after ommitting any NAs - N.data <- length(x) - - # Check if the percentage of the variance that is specified in the argument 'noise' - # and is used as the variance of the embedded noise is a greater - # than the minimum threshold specified in the filter 'nfilter.noise' - if(noise < nfilter.noise){ - stop(paste0("'noise' must be greater than or equal to ", nfilter.noise), call.=FALSE) - }else{ - percentage <- noise - } - - # the study-specific seed for random number generation - seed <- getOption("datashield.seed") - if (is.null(seed)) - stop("histogramDS requires 'datashield.seed' R option to operate", call.=FALSE) - set.seed(seed) - - # generate the noise-augmented vector - x.new <- x + stats::rnorm(N.data, mean=0, sd=sqrt(percentage*stats::var(x))) - - # find the minimum and the maximum of the distribution - min <- min(x.new) - max <- max(x.new) - - output <- c(min, max) - + + # Calculate the scaling factor + x.scalingFactor <- stats::sd(x.standardised)/stats::sd(x.centroid) + + # Apply the scaling factor to the centroids + x.masked <- x.centroid * x.scalingFactor + + # Shift the centroids back to the actual position and scale of the original data + x.new <- (x.masked * stats::sd(x)) + mean(x) + + # find the minimum and the maximum of the distribution + min <- min(x.new) + max <- max(x.new) + + output <- c(min, max) + + } + + if(method.indicator==3){ + + # Remove any missing values + x <- stats::na.omit(xvect) + + # Calculate the length of the variable after ommitting any NAs + N.data <- length(x) + + # Check if the percentage of the variance that is specified in the argument 'noise' + # and is used as the variance of the embedded noise is a greater + # than the minimum threshold specified in the filter 'nfilter.noise' + if(noise < nfilter.noise){ + stop(paste0("'noise' must be greater than or equal to ", nfilter.noise), call.=FALSE) + }else{ + percentage <- noise } - + + # the study-specific seed for random number generation + seed <- getOption("datashield.seed") + if (is.null(seed)) + stop("histogramDS requires 'datashield.seed' R option to operate", call.=FALSE) + set.seed(seed) + + # generate the noise-augmented vector + x.new <- x + stats::rnorm(N.data, mean=0, sd=sqrt(percentage*stats::var(x))) + + # find the minimum and the maximum of the distribution + min <- min(x.new) + max <- max(x.new) + + output <- c(min, max) + } - - return (output) - + + return(list(range=output, class=class(xvect))) + } # AGGREGATE FUNCTION # histogramDS1 diff --git a/R/histogramDS2.R b/R/histogramDS2.R index 001ab0dd..4e85b83f 100644 --- a/R/histogramDS2.R +++ b/R/histogramDS2.R @@ -6,7 +6,7 @@ #' size of a table. If a bin has less counts than this threshold then their counts #' and its density are replaced by a 0 value. #' @details Please find more details in the documentation of the clientside ds.histogram function. -#' @param xvect the numeric vector for which the histogram is desired. +#' @param x a character string providing the name of the server-side numeric vector for which the histogram is desired. #' @param num.breaks the number of breaks that the range of the variable is divided. #' @param min a numeric, the lower limit of the distribution. #' @param max a numeric, the upper limit of the distribution. @@ -20,9 +20,13 @@ #' noise if the \code{method.indicator} is equal to 3 (i.e. probabilistic method). #' @return a list with an object of class \code{histogram} and the number of invalid cells #' @author Amadou Gaye, Demetris Avraam for DataSHIELD Development Team +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' @export #' -histogramDS2 <- function (xvect, num.breaks, min, max, method.indicator, k, noise){ +histogramDS2 <- function (x, num.breaks, min, max, method.indicator, k, noise){ + + xvect <- .loadServersideObject(x) + .checkClass(obj = xvect, obj_name = x, permitted_classes = c("numeric", "integer")) ################################################################## # MODULE 1: CAPTURE THE nfilter SETTINGS # diff --git a/R/scatterPlotDS.R b/R/scatterPlotDS.R index ab48be10..3599c8f0 100644 --- a/R/scatterPlotDS.R +++ b/R/scatterPlotDS.R @@ -14,8 +14,8 @@ #' and variance equal to 10% of the true variance of $x$ and $y$ respectively. To avoid inferential #' disclosure we fix the random number generator in a value that is specified by the input #' variables. Thus the function returns always the same noisy data for a given pair of variables. -#' @param x the name of a numeric vector, the x-variable. -#' @param y the name of a numeric vector, the y-variable. +#' @param x.name a character string providing the name of a server-side numeric vector, the x-variable. +#' @param y.name a character string providing the name of a server-side numeric vector, the y-variable. #' @param method.indicator an integer either 1 or 2. If the user selects the deterministic #' method in the client side function the method.indicator is set to 1 while if the user selects #' the probabilistic method this argument is set to 2. @@ -23,12 +23,19 @@ #' deterministic method is selected. #' @param noise the percentage of the initial variance that is used as the variance of the embedded #' noise if the probabilistic method is selected. -#' @return a list with the x and y coordinates of the data to be plot +#' @return a list with the x and y coordinates of the data to be plot, along with the classes of +#' the x and y inputs (\code{class.x} and \code{class.y}) #' @author Demetris Avraam for DataSHIELD Development Team +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' @export #' -scatterPlotDS <- function(x, y, method.indicator, k, noise){ - +scatterPlotDS <- function(x.name, y.name, method.indicator, k, noise){ + + x <- .loadServersideObject(x.name) + y <- .loadServersideObject(y.name) + .checkClass(obj = x, obj_name = x.name, permitted_classes = c("numeric", "integer")) + .checkClass(obj = y, obj_name = y.name, permitted_classes = c("numeric", "integer")) + ################################################################### # MODULE 1: CAPTURE THE nfilter SETTINGS # thr <- dsBase::listDisclosureSettingsDS() # @@ -131,8 +138,8 @@ scatterPlotDS <- function(x, y, method.indicator, k, noise){ } # Return a list with the x and y coordinates of the centroids - return(list(x.new, y.new)) - + return(list(x.new, y.new, class.x=class(x), class.y=class(y))) + } # AGGREGATE FUNCTION # scatterPlotDS diff --git a/man/boxPlotGGDS.Rd b/man/boxPlotGGDS.Rd index 3633b943..b0d325ac 100644 --- a/man/boxPlotGGDS.Rd +++ b/man/boxPlotGGDS.Rd @@ -4,10 +4,10 @@ \alias{boxPlotGGDS} \title{Create the identity stats and necessary data to draw a plot on the client} \usage{ -boxPlotGGDS(data_table, group = NULL, group2 = NULL) +boxPlotGGDS(data_table.name, group = NULL, group2 = NULL) } \arguments{ -\item{data_table}{\code{data frame} Table that holds the information to be plotted, arranged as: \cr +\item{data_table.name}{\code{character} Name of a server-side data frame that holds the information to be plotted, arranged as: \cr Column 'x': Names on the X axis of the boxplot, aka variables to plot \cr Column 'value': Values for that variable (raw data of columns rbinded) \cr @@ -29,3 +29,6 @@ is purely geometrical aspects of the plot, as a ggplot object contains all the d parameters are passed. There are three different cases depending if there are grouping variables. The outliers are also removed from the graphical parameters. } +\author{ +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands +} diff --git a/man/boxPlotGG_data_TreatmentDS.Rd b/man/boxPlotGG_data_TreatmentDS.Rd index a1ba9781..a38e838e 100644 --- a/man/boxPlotGG_data_TreatmentDS.Rd +++ b/man/boxPlotGG_data_TreatmentDS.Rd @@ -4,10 +4,10 @@ \alias{boxPlotGG_data_TreatmentDS} \title{Arrange data frame to pass it to the boxplot function} \usage{ -boxPlotGG_data_TreatmentDS(table, variables, group = NULL, group2 = NULL) +boxPlotGG_data_TreatmentDS(table.name, variables, group = NULL, group2 = NULL) } \arguments{ -\item{table}{\code{data frame} Table that holds the information to be plotted later} +\item{table.name}{\code{character} Name of a server-side data frame that holds the information to be plotted later} \item{variables}{\code{character vector} Name of the column(s) of the data frame to include on the boxplot} @@ -26,3 +26,6 @@ boxPlotGG_data_TreatmentDS(table, variables, group = NULL, group2 = NULL) \description{ Arrange data frame to pass it to the boxplot function } +\author{ +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands +} diff --git a/man/boxPlotGG_data_Treatment_numericDS.Rd b/man/boxPlotGG_data_Treatment_numericDS.Rd index 914493b6..d43e961d 100644 --- a/man/boxPlotGG_data_Treatment_numericDS.Rd +++ b/man/boxPlotGG_data_Treatment_numericDS.Rd @@ -4,17 +4,20 @@ \alias{boxPlotGG_data_Treatment_numericDS} \title{Arrange vector to pass it to the boxplot function} \usage{ -boxPlotGG_data_Treatment_numericDS(vector) +boxPlotGG_data_Treatment_numericDS(vector.name) } \arguments{ -\item{vector}{\code{numeric vector} Vector to arrange to be plotted later} +\item{vector.name}{\code{character} Name of a server-side numeric vector to arrange to be plotted later} } \value{ \code{data frame} with the following structure: \cr - Column 'x': Names on the X axis of the boxplot, aka name of the vector (vector argument) \cr + Column 'x': Names on the X axis of the boxplot, aka name of the vector (vector.name argument) \cr Column 'value': Values for that variable \cr } \description{ Arrange vector to pass it to the boxplot function } +\author{ +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands +} diff --git a/man/densityGridDS.Rd b/man/densityGridDS.Rd index 2b254acf..8a8c1ee0 100644 --- a/man/densityGridDS.Rd +++ b/man/densityGridDS.Rd @@ -5,8 +5,8 @@ \title{Generates a density grid with or without a priori defined limits} \usage{ densityGridDS( - xvect, - yvect, + x, + y, limits = FALSE, x.min = NULL, x.max = NULL, @@ -16,12 +16,12 @@ densityGridDS( ) } \arguments{ -\item{xvect}{a numerical vector} +\item{x}{a character string providing the name of a server-side numerical vector} -\item{yvect}{a numerical vector} +\item{y}{a character string providing the name of a server-side numerical vector} \item{limits}{a logical expression for whether or not limits of the density grid are defined by -a user. If \code{limits} is set to "FALSE", min and max of xvect and yvect are used as a range. +a user. If \code{limits} is set to "FALSE", min and max of x and y are used as a range. If \code{limits} is set to "TRUE", limits defined by x.min, x.max, y.min and y.max are used.} \item{x.min}{a minimum value for the x axis of the grid density object, if needed} @@ -35,7 +35,8 @@ If \code{limits} is set to "TRUE", limits defined by x.min, x.max, y.min and y.m \item{numints}{a number of intervals for the grid density object, by default is 20} } \value{ -a grid density matrix +a list with the grid density matrix (\code{grid}) and the classes of the x and y inputs +(\code{class.x} and \code{class.y}) } \description{ Generates a density grid that can then be used for heatmap or contour plots. @@ -46,4 +47,6 @@ counts in table cells) are turn to 0. } \author{ Julia Isaeva, Amadou Gaye, Demetris Avraam for DataSHIELD Development Team + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/man/heatmapPlotDS.Rd b/man/heatmapPlotDS.Rd index 950dbace..f10c3e21 100644 --- a/man/heatmapPlotDS.Rd +++ b/man/heatmapPlotDS.Rd @@ -4,12 +4,12 @@ \alias{heatmapPlotDS} \title{Calculates the coordinates of the centroid of each n nearest neighbours} \usage{ -heatmapPlotDS(x, y, k, noise, method.indicator) +heatmapPlotDS(x.name, y.name, k, noise, method.indicator) } \arguments{ -\item{x}{the name of a numeric vector, the x-variable.} +\item{x.name}{a character string providing the name of a server-side numeric vector, the x-variable.} -\item{y}{the name of a numeric vector, the y-variable.} +\item{y.name}{a character string providing the name of a server-side numeric vector, the y-variable.} \item{k}{the number of the nearest neighbours for which their centroid is calculated if the \code{method.indicator} is equal to 1 (i.e. deterministic method).} @@ -22,7 +22,8 @@ noise if the \code{method.indicator} is equal to 2 (i.e. probabilistic method).} } \value{ a list with the x and y coordinates of the centroids if the deterministic method is used -or the x and y coordinated of the noisy data if the probabilistic method is used. +or the x and y coordinated of the noisy data if the probabilistic method is used, along with the +classes of the x and y inputs (\code{class.x} and \code{class.y}) } \description{ This function calculates the coordinates of the centroids for each n nearest neighbours. @@ -39,4 +40,6 @@ plot of non-disclosive graphs (e.g. scatter plots, heatmap plots, contour plots, } \author{ Demetris Avraam for DataSHIELD Development Team + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/man/histogramDS1.Rd b/man/histogramDS1.Rd index a8e8a551..129ed632 100644 --- a/man/histogramDS1.Rd +++ b/man/histogramDS1.Rd @@ -4,10 +4,10 @@ \alias{histogramDS1} \title{returns the minimum and the maximum of the input numeric vector} \usage{ -histogramDS1(xvect, method.indicator, k, noise) +histogramDS1(x, method.indicator, k, noise) } \arguments{ -\item{xvect}{the numeric vector for which the histogram is desired.} +\item{x}{a character string providing the name of the server-side numeric vector for which the histogram is desired.} \item{method.indicator}{a number equal to either 1, 2 or 3 indicating the method of disclosure control that is used for the generation of the histogram. If the value is equal to 1 then the @@ -21,7 +21,8 @@ If the value is set to 3 then the 'probabilistic' method is used.} noise if the \code{method.indicator} is equal to 3 (i.e. probabilistic method).} } \value{ -a numeric vector which contains the minimum and the maximum values of the vector +a list with the numeric vector containing the minimum and the maximum values of the +vector (\code{range}) and the class of the input vector (\code{class}) } \description{ this function returns the minimum and maximum of the input numeric vector which @@ -34,4 +35,6 @@ minimum and maximum values of the generated 'noisy' vector. } \author{ Amadou Gaye, Demetris Avraam for DataSHIELD Development Team + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/man/histogramDS2.Rd b/man/histogramDS2.Rd index 76bf8ea3..17ea4261 100644 --- a/man/histogramDS2.Rd +++ b/man/histogramDS2.Rd @@ -4,10 +4,10 @@ \alias{histogramDS2} \title{Computes a histogram of the input variable without plotting.} \usage{ -histogramDS2(xvect, num.breaks, min, max, method.indicator, k, noise) +histogramDS2(x, num.breaks, min, max, method.indicator, k, noise) } \arguments{ -\item{xvect}{the numeric vector for which the histogram is desired.} +\item{x}{a character string providing the name of the server-side numeric vector for which the histogram is desired.} \item{num.breaks}{the number of breaks that the range of the variable is divided.} @@ -41,4 +41,6 @@ Please find more details in the documentation of the clientside ds.histogram fun } \author{ Amadou Gaye, Demetris Avraam for DataSHIELD Development Team + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/man/scatterPlotDS.Rd b/man/scatterPlotDS.Rd index 7b2709fd..96a08442 100644 --- a/man/scatterPlotDS.Rd +++ b/man/scatterPlotDS.Rd @@ -4,12 +4,12 @@ \alias{scatterPlotDS} \title{Calculates the coordinates of the data to be plot} \usage{ -scatterPlotDS(x, y, method.indicator, k, noise) +scatterPlotDS(x.name, y.name, method.indicator, k, noise) } \arguments{ -\item{x}{the name of a numeric vector, the x-variable.} +\item{x.name}{a character string providing the name of a server-side numeric vector, the x-variable.} -\item{y}{the name of a numeric vector, the y-variable.} +\item{y.name}{a character string providing the name of a server-side numeric vector, the y-variable.} \item{method.indicator}{an integer either 1 or 2. If the user selects the deterministic method in the client side function the method.indicator is set to 1 while if the user selects @@ -22,7 +22,8 @@ deterministic method is selected.} noise if the probabilistic method is selected.} } \value{ -a list with the x and y coordinates of the data to be plot +a list with the x and y coordinates of the data to be plot, along with the classes of +the x and y inputs (\code{class.x} and \code{class.y}) } \description{ This function uses two disclosure control methods to generate non-disclosive @@ -44,4 +45,6 @@ variables. Thus the function returns always the same noisy data for a given pair } \author{ Demetris Avraam for DataSHIELD Development Team + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/tests/testthat/test-smk-boxPlotGGDS.R b/tests/testthat/test-smk-boxPlotGGDS.R new file mode 100644 index 00000000..fe7db46e --- /dev/null +++ b/tests/testthat/test-smk-boxPlotGGDS.R @@ -0,0 +1,42 @@ +# +# Set up +# + +# context("boxPlotGGDS::smk::setup") + +set.standard.disclosure.settings() + +# +# Tests +# + +# context("boxPlotGGDS::smk") +test_that("boxPlotGGDS, no grouping", { + boxPlotRawData <- data.frame(x = rep("v1", 20), value = c(1:20)) + + res <- boxPlotGGDS("boxPlotRawData") + + expect_length(res, 2) + expect_equal(res[[2]], "no_group") +}) + +test_that("boxPlotGGDS, single grouping", { + boxPlotRawData <- data.frame(x = rep("v1", 20), value = c(1:20), group = factor(rep(c("a", "b"), 10))) + + res <- boxPlotGGDS("boxPlotRawData", group = "group") + + expect_length(res, 2) + expect_equal(res[[2]], "single_group") +}) + +test_that("boxPlotGGDS fails when data_table.name references nonexistent object", { + expect_error(boxPlotGGDS("nonexistent_obj"), "does not exist") +}) + +# +# Done +# + +# context("boxPlotGGDS::smk::shutdown") + +# context("boxPlotGGDS::smk::done") diff --git a/tests/testthat/test-smk-boxPlotGG_data_TreatmentDS.R b/tests/testthat/test-smk-boxPlotGG_data_TreatmentDS.R new file mode 100644 index 00000000..0deb5ff5 --- /dev/null +++ b/tests/testthat/test-smk-boxPlotGG_data_TreatmentDS.R @@ -0,0 +1,50 @@ +# +# Set up +# + +# context("boxPlotGG_data_TreatmentDS::smk::setup") + +set.standard.disclosure.settings() + +# +# Tests +# + +# context("boxPlotGG_data_TreatmentDS::smk") +test_that("boxPlotGG_data_TreatmentDS, no grouping", { + D <- data.frame(v1 = c(1:20), v2 = c(20:1)) + + res <- boxPlotGG_data_TreatmentDS("D", variables = c("v1", "v2")) + + expect_true(all(c("x", "value") %in% names(res))) +}) + +test_that("boxPlotGG_data_TreatmentDS, single grouping", { + D <- data.frame(v1 = c(1:20), group = factor(rep(c("a", "b"), 10))) + + res <- boxPlotGG_data_TreatmentDS("D", variables = c("v1"), group = "group") + + expect_true(all(c("x", "value", "group") %in% names(res))) +}) + +test_that("boxPlotGG_data_TreatmentDS fails when table.name references nonexistent object", { + expect_error(boxPlotGG_data_TreatmentDS("nonexistent_obj", variables = c("v1")), "does not exist") +}) + +test_that("boxPlotGG_data_TreatmentDS fails when a variable is not numeric or integer", { + D <- data.frame(v1 = c("a", "b", "c")) + expect_error(boxPlotGG_data_TreatmentDS("D", variables = c("v1")), "must be of type numeric or integer") +}) + +test_that("boxPlotGG_data_TreatmentDS fails when group is not a factor", { + D <- data.frame(v1 = c(1:20), group = c(1:20)) + expect_error(boxPlotGG_data_TreatmentDS("D", variables = c("v1"), group = "group"), "must be of type factor") +}) + +# +# Done +# + +# context("boxPlotGG_data_TreatmentDS::smk::shutdown") + +# context("boxPlotGG_data_TreatmentDS::smk::done") diff --git a/tests/testthat/test-smk-boxPlotGG_data_Treatment_numericDS.R b/tests/testthat/test-smk-boxPlotGG_data_Treatment_numericDS.R new file mode 100644 index 00000000..354de5cd --- /dev/null +++ b/tests/testthat/test-smk-boxPlotGG_data_Treatment_numericDS.R @@ -0,0 +1,38 @@ +# +# Set up +# + +# context("boxPlotGG_data_Treatment_numericDS::smk::setup") + +set.standard.disclosure.settings() + +# +# Tests +# + +# context("boxPlotGG_data_Treatment_numericDS::smk") +test_that("boxPlotGG_data_Treatment_numericDS", { + v1 <- c(1:20) + + res <- boxPlotGG_data_Treatment_numericDS("v1") + + expect_equal(unique(res$x), "v1") + expect_equal(res$value, v1) +}) + +test_that("boxPlotGG_data_Treatment_numericDS fails when vector.name references nonexistent object", { + expect_error(boxPlotGG_data_Treatment_numericDS("nonexistent_obj"), "does not exist") +}) + +test_that("boxPlotGG_data_Treatment_numericDS fails when vector is not numeric or integer", { + v1 <- c("a", "b", "c") + expect_error(boxPlotGG_data_Treatment_numericDS("v1"), "must be of type numeric or integer") +}) + +# +# Done +# + +# context("boxPlotGG_data_Treatment_numericDS::smk::shutdown") + +# context("boxPlotGG_data_Treatment_numericDS::smk::done") diff --git a/tests/testthat/test-smk-densityGridDS.R b/tests/testthat/test-smk-densityGridDS.R index 2c075a4b..05efb14f 100644 --- a/tests/testthat/test-smk-densityGridDS.R +++ b/tests/testthat/test-smk-densityGridDS.R @@ -36,20 +36,43 @@ test_that("densityGridDS", { y.max <- NULL numints <- 3 - res <- densityGridDS(xvect=xvect, yvect=yvect, limits=FALSE, x.min=NULL, + res <- densityGridDS(x="xvect", y="yvect", limits=FALSE, x.min=NULL, x.max=NULL, y.min=NULL, y.max=NULL, numints=numints) - expect_equal(class(res), c("matrix","array")) - expect_equal(colnames(res), c("", "", "", "x.mids", "y.mids")) - expect_equal(as.numeric(round(res[1,], digits=3)), c(3.000, 0.000, 0.000, 8.798, 13.870)) - expect_equal(as.numeric(round(res[2,], digits=3)), c(4.000, 5.000, 0.000, 10.195, 16.870)) - expect_equal(as.numeric(round(res[3,], digits=3)), c(3.000, 0.000, 0.000, 11.592, 19.870)) - - expect_equal(names(dimnames(res))[2], "Number of invalid cells (cells with counts >0 and < nfilter.tab ) is 4") + expect_equal(class(res$grid), c("matrix","array")) + expect_equal(colnames(res$grid), c("", "", "", "x.mids", "y.mids")) + expect_equal(as.numeric(round(res$grid[1,], digits=3)), c(3.000, 0.000, 0.000, 8.798, 13.870)) + expect_equal(as.numeric(round(res$grid[2,], digits=3)), c(4.000, 5.000, 0.000, 10.195, 16.870)) + expect_equal(as.numeric(round(res$grid[3,], digits=3)), c(3.000, 0.000, 0.000, 11.592, 19.870)) + + expect_equal(names(dimnames(res$grid))[2], "Number of invalid cells (cells with counts >0 and < nfilter.tab ) is 4") + expect_equal(res$class.x, "numeric") + expect_equal(res$class.y, "numeric") }) +test_that("densityGridDS fails when x references nonexistent object", { + expect_error(densityGridDS(x="nonexistent_obj", y="yvect", numints=3), "does not exist") +}) + +test_that("densityGridDS fails when y references nonexistent object", { + yvect <- c(1:20) + expect_error(densityGridDS(x="yvect", y="nonexistent_obj", numints=3), "does not exist") +}) + +test_that("densityGridDS fails when x is not numeric or integer", { + xvect <- c("a", "b", "c") + yvect <- c(1, 2, 3) + expect_error(densityGridDS(x="xvect", y="yvect", numints=3), "must be of type numeric or integer") +}) + +test_that("densityGridDS fails when y is not numeric or integer", { + xvect <- c(1, 2, 3) + yvect <- c("a", "b", "c") + expect_error(densityGridDS(x="xvect", y="yvect", numints=3), "must be of type numeric or integer") +}) + # # Done # diff --git a/tests/testthat/test-smk-heatmapPlotDS.R b/tests/testthat/test-smk-heatmapPlotDS.R new file mode 100644 index 00000000..1313d608 --- /dev/null +++ b/tests/testthat/test-smk-heatmapPlotDS.R @@ -0,0 +1,55 @@ +# +# Set up +# + +# context("heatmapPlotDS::smk::setup") + +set.standard.disclosure.settings() + +# +# Tests +# + +# context("heatmapPlotDS::smk") +test_that("heatmapPlotDS, deterministic method", { + xvect <- c(1:20) + yvect <- c(20:1) + + res <- heatmapPlotDS("xvect", "yvect", k=3, noise=0.25, method.indicator=1) + + expect_length(res, 4) + expect_length(res[[1]], 20) + expect_length(res[[2]], 20) + expect_equal(res$class.x, "integer") + expect_equal(res$class.y, "integer") +}) + +test_that("heatmapPlotDS fails when x references nonexistent object", { + yvect <- c(20:1) + expect_error(heatmapPlotDS("nonexistent_obj", "yvect", k=3, noise=0.25, method.indicator=1), "does not exist") +}) + +test_that("heatmapPlotDS fails when y references nonexistent object", { + xvect <- c(1:20) + expect_error(heatmapPlotDS("xvect", "nonexistent_obj", k=3, noise=0.25, method.indicator=1), "does not exist") +}) + +test_that("heatmapPlotDS fails when x is not numeric or integer", { + xvect <- c("a", "b", "c") + yvect <- c(1, 2, 3) + expect_error(heatmapPlotDS("xvect", "yvect", k=3, noise=0.25, method.indicator=1), "must be of type numeric or integer") +}) + +test_that("heatmapPlotDS fails when y is not numeric or integer", { + xvect <- c(1, 2, 3) + yvect <- c("a", "b", "c") + expect_error(heatmapPlotDS("xvect", "yvect", k=3, noise=0.25, method.indicator=1), "must be of type numeric or integer") +}) + +# +# Done +# + +# context("heatmapPlotDS::smk::shutdown") + +# context("heatmapPlotDS::smk::done") diff --git a/tests/testthat/test-smk-histogramDS1.R b/tests/testthat/test-smk-histogramDS1.R new file mode 100644 index 00000000..10559b97 --- /dev/null +++ b/tests/testthat/test-smk-histogramDS1.R @@ -0,0 +1,40 @@ +# +# Set up +# + +# context("histogramDS1::smk::setup") + +set.standard.disclosure.settings() +set.random.seed.setting(1234) + +# +# Tests +# + +# context("histogramDS1::smk") +test_that("histogramDS1, smallCellsRule method", { + xvect <- c(1:100) + + res <- histogramDS1("xvect", method.indicator=1, k=3, noise=0.25) + + expect_length(res, 2) + expect_equal(res$class, "integer") + expect_length(res$range, 2) +}) + +test_that("histogramDS1 fails when x references nonexistent object", { + expect_error(histogramDS1("nonexistent_obj", method.indicator=1, k=3, noise=0.25), "does not exist") +}) + +test_that("histogramDS1 fails when x is not numeric or integer", { + xvect <- c("a", "b", "c") + expect_error(histogramDS1("xvect", method.indicator=1, k=3, noise=0.25), "must be of type numeric or integer") +}) + +# +# Done +# + +# context("histogramDS1::smk::shutdown") + +# context("histogramDS1::smk::done") diff --git a/tests/testthat/test-smk-histogramDS2.R b/tests/testthat/test-smk-histogramDS2.R new file mode 100644 index 00000000..da26d99a --- /dev/null +++ b/tests/testthat/test-smk-histogramDS2.R @@ -0,0 +1,39 @@ +# +# Set up +# + +# context("histogramDS2::smk::setup") + +set.standard.disclosure.settings() + +# +# Tests +# + +# context("histogramDS2::smk") +test_that("histogramDS2, smallCellsRule method", { + xvect <- c(1:100) + + res <- histogramDS2("xvect", num.breaks=10, min=1, max=100, method.indicator=1, k=3, noise=0.25) + + expect_length(res, 2) + expect_true(inherits(res$histobject, "histogram")) + expect_equal(res$invalidcells, 0) +}) + +test_that("histogramDS2 fails when x references nonexistent object", { + expect_error(histogramDS2("nonexistent_obj", num.breaks=10, min=1, max=100, method.indicator=1, k=3, noise=0.25), "does not exist") +}) + +test_that("histogramDS2 fails when x is not numeric or integer", { + xvect <- c("a", "b", "c") + expect_error(histogramDS2("xvect", num.breaks=10, min=1, max=100, method.indicator=1, k=3, noise=0.25), "must be of type numeric or integer") +}) + +# +# Done +# + +# context("histogramDS2::smk::shutdown") + +# context("histogramDS2::smk::done") diff --git a/tests/testthat/test-smk-scatterPlotDS.R b/tests/testthat/test-smk-scatterPlotDS.R new file mode 100644 index 00000000..7fee3d3e --- /dev/null +++ b/tests/testthat/test-smk-scatterPlotDS.R @@ -0,0 +1,55 @@ +# +# Set up +# + +# context("scatterPlotDS::smk::setup") + +set.standard.disclosure.settings() + +# +# Tests +# + +# context("scatterPlotDS::smk") +test_that("scatterPlotDS, deterministic method", { + xvect <- c(1:20) + yvect <- c(20:1) + + res <- scatterPlotDS("xvect", "yvect", method.indicator=1, k=3, noise=0.25) + + expect_length(res, 4) + expect_length(res[[1]], 20) + expect_length(res[[2]], 20) + expect_equal(res$class.x, "integer") + expect_equal(res$class.y, "integer") +}) + +test_that("scatterPlotDS fails when x references nonexistent object", { + yvect <- c(20:1) + expect_error(scatterPlotDS("nonexistent_obj", "yvect", method.indicator=1, k=3, noise=0.25), "does not exist") +}) + +test_that("scatterPlotDS fails when y references nonexistent object", { + xvect <- c(1:20) + expect_error(scatterPlotDS("xvect", "nonexistent_obj", method.indicator=1, k=3, noise=0.25), "does not exist") +}) + +test_that("scatterPlotDS fails when x is not numeric or integer", { + xvect <- c("a", "b", "c") + yvect <- c(1, 2, 3) + expect_error(scatterPlotDS("xvect", "yvect", method.indicator=1, k=3, noise=0.25), "must be of type numeric or integer") +}) + +test_that("scatterPlotDS fails when y is not numeric or integer", { + xvect <- c(1, 2, 3) + yvect <- c("a", "b", "c") + expect_error(scatterPlotDS("xvect", "yvect", method.indicator=1, k=3, noise=0.25), "must be of type numeric or integer") +}) + +# +# Done +# + +# context("scatterPlotDS::smk::shutdown") + +# context("scatterPlotDS::smk::done")