From 3c2188cc8184497330f1922796822b29f5507454 Mon Sep 17 00:00:00 2001 From: Stuart Wheater Date: Wed, 19 Nov 2025 13:59:29 +0000 Subject: [PATCH 1/8] Save and restore 'par' values --- R/ds.contourPlot.R | 4 ++++ R/ds.heatmapPlot.R | 4 ++++ R/ds.histogram.R | 4 ++++ R/ds.scatterPlot.R | 4 ++++ 4 files changed, 16 insertions(+) diff --git a/R/ds.contourPlot.R b/R/ds.contourPlot.R index 4e195e48b..6601dd912 100644 --- a/R/ds.contourPlot.R +++ b/R/ds.contourPlot.R @@ -120,6 +120,10 @@ ds.contourPlot <- function(x=NULL, y=NULL, type='combine', show='all', numints=2 stop("y=NULL. Please provide the names of two numeric vectors!", call.=FALSE) } + # Save par and setup reseting of par values + old_par <- par(no.readonly = TRUE) + on.exit(par(old_par), add = TRUE) + # check if the input objects are defined in all the studies isDefined(datasources, x) isDefined(datasources, y) diff --git a/R/ds.heatmapPlot.R b/R/ds.heatmapPlot.R index 262b1d700..2c920e331 100644 --- a/R/ds.heatmapPlot.R +++ b/R/ds.heatmapPlot.R @@ -169,6 +169,10 @@ ds.heatmapPlot <- function(x=NULL, y=NULL, type="combine", show="all", numints=2 stop("y=NULL. Please provide the names of the 2nd numeric vector!", call.=FALSE) } + # Save par and setup reseting of par values + old_par <- par(no.readonly = TRUE) + on.exit(par(old_par), add = TRUE) + # check if the input objects are defined in all the studies isDefined(datasources, x) isDefined(datasources, y) diff --git a/R/ds.histogram.R b/R/ds.histogram.R index 0f5357b77..358c1a08c 100644 --- a/R/ds.histogram.R +++ b/R/ds.histogram.R @@ -167,6 +167,10 @@ ds.histogram <- function(x=NULL, type="split", num.breaks=10, method="smallCells stop("Please provide the name of the input vector!", call.=FALSE) } + # Save par and setup reseting of par values + old_par <- par(no.readonly = TRUE) + on.exit(par(old_par), add = TRUE) + # check if the input object is defined in all the studies isDefined(datasources, x) diff --git a/R/ds.scatterPlot.R b/R/ds.scatterPlot.R index 6c2c78058..21e5b2629 100644 --- a/R/ds.scatterPlot.R +++ b/R/ds.scatterPlot.R @@ -147,6 +147,10 @@ ds.scatterPlot <- function(x=NULL, y=NULL, method='deterministic', k=3, noise=0. stop("The 'datasources' were expected to be a list of DSConnection-class objects", call.=FALSE) } + # Save par and setup reseting of par values + old_par <- par(no.readonly = TRUE) + on.exit(par(old_par), add = TRUE) + # check if the input objects are defined in all the studies isDefined(datasources, x) isDefined(datasources, y) From ca5274b8e725c1bca05547e41ed5d50eab6879d6 Mon Sep 17 00:00:00 2001 From: Stuart Wheater Date: Fri, 21 Nov 2025 14:00:23 +0000 Subject: [PATCH 2/8] Fix version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index f2d7fb091..8f531e9e0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: dsBaseClient Title: 'DataSHIELD' Client Side Base Functions -Version: 6.3.5-9000 +Version: 6.3.5.9000 Description: Base 'DataSHIELD' functions for the client side. 'DataSHIELD' is a software package which allows you to do non-disclosive federated analysis on sensitive data. 'DataSHIELD' analytic functions have been designed to only share non disclosive summary statistics, with built in automated output From 7761ed1f260c3ec73c820d612bec63ae9b1696eb Mon Sep 17 00:00:00 2001 From: Stuart Wheater Date: Fri, 21 Nov 2025 15:59:01 +0000 Subject: [PATCH 3/8] Fix return and export --- NAMESPACE | 1 - R/computeWeightedMeans.R | 4 +++- man/computeWeightedMeans.Rd | 4 ++++ man/ds.forestplot.Rd | 3 +++ 4 files changed, 10 insertions(+), 2 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 406745737..a41b8f0af 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,5 @@ # Generated by roxygen2: do not edit by hand -export(computeWeightedMeans) export(ds.Boole) export(ds.abs) export(ds.asCharacter) diff --git a/R/computeWeightedMeans.R b/R/computeWeightedMeans.R index 0f04fc915..1284ffc08 100644 --- a/R/computeWeightedMeans.R +++ b/R/computeWeightedMeans.R @@ -9,9 +9,11 @@ #' @param variables character name of the variable(s) to focus on. The variables must be in the data.table #' @param weight character name of the data.table column that contains a weight. #' @param by character vector of the columns to group by +#' @return Returns a data table object with computed weighted means. +#' #' @import data.table #' @importFrom stats as.formula na.omit ts weighted.mean -#' @export +#' @keywords internal computeWeightedMeans <- function(data_table, variables, weight, by) { if (is.null(weight)) { diff --git a/man/computeWeightedMeans.Rd b/man/computeWeightedMeans.Rd index 0b8b0879f..c1f9bfc15 100644 --- a/man/computeWeightedMeans.Rd +++ b/man/computeWeightedMeans.Rd @@ -15,6 +15,9 @@ computeWeightedMeans(data_table, variables, weight, by) \item{by}{character vector of the columns to group by} } +\value{ +Returns a data table object with computed weighted means. +} \description{ This function is originally from the panelaggregation package. It has been ported here in order to bypass the package being @@ -23,3 +26,4 @@ kicked off CRAN. \author{ Matthias Bannert, Gabriel Bucur } +\keyword{internal} diff --git a/man/ds.forestplot.Rd b/man/ds.forestplot.Rd index 408dc2d30..66606601d 100644 --- a/man/ds.forestplot.Rd +++ b/man/ds.forestplot.Rd @@ -19,6 +19,9 @@ See details from \code{?meta::metagen} for the different options.} \item{layout}{\code{character} (default \code{"JAMA"}) Layout of the plot. See details from \code{?meta::metagen} for the different options.} } +\value{ +Results a foresplot object created with `meta::forest`. +} \description{ Draws a forestplot of the coefficients for Study-Level Meta-Analysis performed with DataSHIELD From ddae0c79117300b2ee1f818dac2acd5d7bddd9a7 Mon Sep 17 00:00:00 2001 From: Stuart Wheater Date: Fri, 21 Nov 2025 16:00:30 +0000 Subject: [PATCH 4/8] Replaces print(..) and cat(...) to message(...) --- R/ds.cbind.R | 10 +++++----- R/ds.dataFrame.R | 10 +++++----- R/ds.dataFrameSubset.R | 8 ++++---- R/ds.dmtC2S.R | 2 +- R/ds.extractQuantiles.R | 2 +- R/ds.forestplot.R | 1 + R/ds.glm.R | 20 ++++++++++---------- R/ds.glmSLMA.R | 24 ++++++++++++------------ R/ds.glmSummary.R | 10 +++++----- R/ds.glmerSLMA.R | 32 ++++++++++++++++---------------- R/ds.listClientsideFunctions.R | 18 ------------------ R/ds.lmerSLMA.R | 34 +++++++++++++++++----------------- R/ds.matrix.R | 2 +- R/ds.matrixDiag.R | 2 +- R/ds.rBinom.R | 4 ++-- R/ds.rNorm.R | 4 ++-- R/ds.rPois.R | 4 ++-- R/ds.rUnif.R | 2 +- R/ds.ranksSecure.R | 25 +++++++++++-------------- R/ds.rbind.R | 8 ++++---- R/ds.rep.R | 8 ++++---- R/ds.sample.R | 6 +++--- R/ds.table.R | 29 ++++++++++++++--------------- 23 files changed, 122 insertions(+), 143 deletions(-) diff --git a/R/ds.cbind.R b/R/ds.cbind.R index d943e0175..e21cb961c 100644 --- a/R/ds.cbind.R +++ b/R/ds.cbind.R @@ -157,7 +157,7 @@ ds.cbind <- function(x=NULL, DataSHIELD.checks=FALSE, force.colnames=NULL, newob } colNames <- unlist(colNames) if(anyDuplicated(colNames) != 0){ - cat("\n Warning: Some column names in study", j, "are duplicated and a suffix '.k' will be added to the kth replicate \n") + message("\n Warning: Some column names in study", j, "are duplicated and a suffix '.k' will be added to the kth replicate \n") } } } @@ -198,7 +198,7 @@ ds.cbind <- function(x=NULL, DataSHIELD.checks=FALSE, force.colnames=NULL, newob next.class <- DSI::datashield.aggregate(datasources[std], calltext1) class.vector <- c(class.vector, next.class[[1]]) if (notify.of.progress){ - cat("\n",j," of ", length(x), " elements to combine in step 1 of 2 in study ", std, "\n") + message("\n",j," of ", length(x), " elements to combine in step 1 of 2 in study ", std, "\n") } } for(j in 1:length(x)){ @@ -206,14 +206,14 @@ ds.cbind <- function(x=NULL, DataSHIELD.checks=FALSE, force.colnames=NULL, newob if(class.vector[j]!="data.frame" && class.vector[j]!="matrix"){ colname.vector <- c(colname.vector, test.df) if (notify.of.progress){ - cat("\n",j," of ", length(x), " elements to combine in step 2 of 2 in study ", std, "\n") + message("\n",j," of ", length(x), " elements to combine in step 2 of 2 in study ", std, "\n") } }else{ calltext2 <- call('colnamesDS', test.df) df.names <- DSI::datashield.aggregate(datasources[std], calltext2) colname.vector <- c(colname.vector, df.names[[1]]) if (notify.of.progress){ - cat("\n", j," of ", length(x), " elements to combine in step 2 of 2 in study ", std, "\n") + message("\n", j," of ", length(x), " elements to combine in step 2 of 2 in study ", std, "\n") } } } @@ -221,7 +221,7 @@ ds.cbind <- function(x=NULL, DataSHIELD.checks=FALSE, force.colnames=NULL, newob } if (notify.of.progress){ - cat("\nBoth steps in all studies completed\n") + message("\nBoth steps in all studies completed\n") } # prepare name vectors for transmission diff --git a/R/ds.dataFrame.R b/R/ds.dataFrame.R index 5837747c6..eeddcdd90 100644 --- a/R/ds.dataFrame.R +++ b/R/ds.dataFrame.R @@ -137,7 +137,7 @@ ds.dataFrame <- function(x=NULL, row.names=NULL, check.rows=FALSE, check.names=T } colNames <- unlist(colNames) if(anyDuplicated(colNames) != 0){ - cat("\n Warning: Some column names in study", j, "are duplicated and a suffix '.k' will be added to the kth replicate \n") + message("\n Warning: Some column names in study", j, "are duplicated and a suffix '.k' will be added to the kth replicate \n") } } } @@ -178,7 +178,7 @@ ds.dataFrame <- function(x=NULL, row.names=NULL, check.rows=FALSE, check.names=T next.class <- DSI::datashield.aggregate(datasources[std], calltext1) class.vector <- c(class.vector, next.class[[1]]) if (notify.of.progress){ - cat("\n",j," of ", length(x), " elements to combine in step 1 of 2 in study ", std, "\n") + message("\n",j," of ", length(x), " elements to combine in step 1 of 2 in study ", std, "\n") } } for(j in 1:length(x)){ @@ -186,14 +186,14 @@ ds.dataFrame <- function(x=NULL, row.names=NULL, check.rows=FALSE, check.names=T if(class.vector[j]!="data.frame" && class.vector[j]!="matrix"){ colname.vector <- c(colname.vector, test.df) if (notify.of.progress){ - cat("\n",j," of ", length(x), " elements to combine in step 2 of 2 in study ", std, "\n") + message("\n",j," of ", length(x), " elements to combine in step 2 of 2 in study ", std, "\n") } }else{ calltext2 <- call('colnamesDS', test.df) df.names <- DSI::datashield.aggregate(datasources[std], calltext2) colname.vector <- c(colname.vector, df.names[[1]]) if (notify.of.progress){ - cat("\n", j," of ", length(x), " elements to combine in step 2 of 2 in study ", std, "\n") + message("\n", j," of ", length(x), " elements to combine in step 2 of 2 in study ", std, "\n") } } } @@ -201,7 +201,7 @@ ds.dataFrame <- function(x=NULL, row.names=NULL, check.rows=FALSE, check.names=T } if (notify.of.progress){ - cat("\nBoth steps in all studies completed\n") + message("\nBoth steps in all studies completed\n") } # prepare vectors for transmission diff --git a/R/ds.dataFrameSubset.R b/R/ds.dataFrameSubset.R index 1c5ff6a00..1ae6278db 100644 --- a/R/ds.dataFrameSubset.R +++ b/R/ds.dataFrameSubset.R @@ -231,13 +231,13 @@ if(!is.null(rm.cols)){ if (notify.of.progress) { if(num.messages==1){ - cat("\nSource",s,"\n",return.warning.message[[s]][[1]],"\n") + message("\nSource",s,"\n",return.warning.message[[s]][[1]],"\n") }else{ - cat("\nSource",s,"\n") + message("\nSource",s,"\n") for(m in 1:(num.messages-1)){ - cat(return.warning.message[[s]][[m]],"\n") + message(return.warning.message[[s]][[m]],"\n") } - cat(return.warning.message[[s]][[num.messages]],"\n") + message(return.warning.message[[s]][[num.messages]],"\n") } } } diff --git a/R/ds.dmtC2S.R b/R/ds.dmtC2S.R index ee2e4be67..085d198fb 100644 --- a/R/ds.dmtC2S.R +++ b/R/ds.dmtC2S.R @@ -93,7 +93,7 @@ if(dplyr::is.tbl(dfdata)) if(!is.matrix(dfdata) && !is.data.frame(dfdata) && !dplyr::is.tbl(dfdata)) { - cat("\n FAILED: must either be a data.frame, matrix or tibble") + message("\n FAILED: must either be a data.frame, matrix or tibble") return('Please respecify') } diff --git a/R/ds.extractQuantiles.R b/R/ds.extractQuantiles.R index ba39dd51c..4068f8f3b 100644 --- a/R/ds.extractQuantiles.R +++ b/R/ds.extractQuantiles.R @@ -224,7 +224,7 @@ datasources.in.current.function<-datasources #CALL CLIENTSIDE FUNCTION ds.dmtC2S TO RETURN final.quantile.df TO SERVERSIDE dsBaseClient::ds.dmtC2S(dfdata=final.quantile.df,newobj="final.quantile.df",datasources = datasources.in.current.function) - cat("\n\n\n"," FINAL RANKING PROCEDURES COMPLETE: + message("\n\n\n"," FINAL RANKING PROCEDURES COMPLETE: PRIMARY RANKING OUTPUT IS IN DATA FRAME",extract.summary.output.ranks.df, " WHICH IS SORTED BY",extract.ranks.sort.by," AND HAS BEEN diff --git a/R/ds.forestplot.R b/R/ds.forestplot.R index 60227913c..e1bc21c13 100644 --- a/R/ds.forestplot.R +++ b/R/ds.forestplot.R @@ -10,6 +10,7 @@ #' See details from \code{?meta::metagen} for the different options. #' @param layout \code{character} (default \code{"JAMA"}) Layout of the plot. #' See details from \code{?meta::metagen} for the different options. +#' @return Results a foresplot object created with `meta::forest`. #' #' @export #' diff --git a/R/ds.glm.R b/R/ds.glm.R index 13cba2d96..8b1dbceb7 100644 --- a/R/ds.glm.R +++ b/R/ds.glm.R @@ -343,10 +343,10 @@ ds.glm <- function(formula=NULL, data=NULL, family=NULL, offset=NULL, weights=NU # to provide name of offset or weights variable if(sum(as.numeric(grepl('offset', formula, ignore.case=TRUE)))>0 || sum(as.numeric(grepl('weights', formula, ignore.case=TRUE)))>0){ - cat("\n\n WARNING: you may have specified an offset or regression weights") - cat("\n as part of the model formula. In ds.glm (unlike the usual glm in R)") - cat("\n you must specify an offset or weights separately from the formula") - cat("\n using the offset or weights argument.\n\n") + message("\n\n WARNING: you may have specified an offset or regression weights") + message("\n as part of the model formula. In ds.glm (unlike the usual glm in R)") + message("\n you must specify an offset or weights separately from the formula") + message("\n using the offset or weights argument.\n\n") } formula <- stats::as.formula(formula) @@ -451,12 +451,12 @@ ds.glm <- function(formula=NULL, data=NULL, family=NULL, offset=NULL, weights=NU "Any values of 1 in the following tables denote potential disclosure risks\n", "please use the argument to include only valid studies.\n", "Errors by study are as follows:\n") - print(as.matrix(y.invalid)) - print(as.matrix(Xpar.invalid)) - print(as.matrix(w.invalid)) - print(as.matrix(o.invalid)) - print(as.matrix(glm.saturation.invalid)) - print(as.matrix(errorMessage)) + message(as.matrix(y.invalid)) + message(as.matrix(Xpar.invalid)) + message(as.matrix(w.invalid)) + message(as.matrix(o.invalid)) + message(as.matrix(glm.saturation.invalid)) + message(as.matrix(errorMessage)) return(list( output.blocked.information.1, diff --git a/R/ds.glmSLMA.R b/R/ds.glmSLMA.R index 9b46a6a40..3c9d0edb5 100644 --- a/R/ds.glmSLMA.R +++ b/R/ds.glmSLMA.R @@ -398,10 +398,10 @@ ds.glmSLMA<-function(formula=NULL, family=NULL, offset=NULL, weights=NULL, combi if(sum(as.numeric(grepl('offset', formula, ignore.case=TRUE)))>0 || sum(as.numeric(grepl('weights', formula, ignore.case=TRUE)))>0) { - cat("\n\n WARNING: you may have specified an offset or regression weights") - cat("\n as part of the model formula. In ds.glm (unlike the usual glm in R)") - cat("\n you must specify an offset or weights separately from the formula") - cat("\n using the offset or weights argument.\n\n") + message("\n\n WARNING: you may have specified an offset or regression weights") + message("\n as part of the model formula. In ds.glm (unlike the usual glm in R)") + message("\n you must specify an offset or weights separately from the formula") + message("\n using the offset or weights argument.\n\n") } formula <- stats::as.formula(formula) @@ -617,7 +617,7 @@ if(at.least.one.study.data.error) } if (notify.of.progress) { - cat("\n\nSAVING SERVERSIDE glm OBJECT AS: <",newobj,">\n\n") + message("\n\nSAVING SERVERSIDE glm OBJECT AS: <",newobj,">\n\n") } calltext.2 <- call('glmSLMADS.assign', formula, family, offset, weights, dataName) @@ -664,17 +664,17 @@ if(!all.studies.valid) { for(sse in study.with.errors) { - cat("\n","Error report from second serverside function for study",sse,"\n") - cat("############################################################","\n") - cat(unlist(study.summary[[sse]][[1]]),"\n") - cat(unlist(study.summary[[sse]][[2]]),"\n\n") + message("\n","Error report from second serverside function for study",sse,"\n") + message("############################################################","\n") + message(unlist(study.summary[[sse]][[1]]),"\n") + message(unlist(study.summary[[sse]][[2]]),"\n\n") num.messages<-length(study.summary[[sse]])-2 for(m in 1:num.messages) { if(!is.null(unlist(study.summary[[sse]][[2+m]]))) { - cat(unlist(study.summary[[sse]][[2+m]]),"\n\n") + message(unlist(study.summary[[sse]][[2+m]]),"\n\n") } } } @@ -806,8 +806,8 @@ if(num.valid.studies>1){ if(!coefficient.vectors.match){ - cat("\n\nModels in different sources vary in structure\nplease match coefficients for meta-analysis individually\n") - cat("nYou can use the DataSHIELD generated estimates and standard errors as the basis for a meta-analysis\nbut carry out the final pooling step independently of DataSHIELD using whatever meta-analysis package you wish\n\n") + message("\n\nModels in different sources vary in structure\nplease match coefficients for meta-analysis individually\n") + message("nYou can use the DataSHIELD generated estimates and standard errors as the basis for a meta-analysis\nbut carry out the final pooling step independently of DataSHIELD using whatever meta-analysis package you wish\n\n") return(list(output.summary=output.summary)) } diff --git a/R/ds.glmSummary.R b/R/ds.glmSummary.R index 5629d937f..9fc259c5b 100644 --- a/R/ds.glmSummary.R +++ b/R/ds.glmSummary.R @@ -172,17 +172,17 @@ if(obj.name.exists.in.all.sources && obj.non.null.in.all.sources){ # # # # if(no.errors){ # -# cat("\n\nCREATE ASSIGN OBJECT\n") # +# message("\n\nCREATE ASSIGN OBJECT\n") # # # # validity.check<-paste0("<",test.obj.name, "> appears valid in all sources") # # print(list(is.object.created=return.message,validity.check=validity.check)) # # } # # if(!no.errors){ # - validity.check<-paste0("<",test.obj.name,"> invalid in at least one source. See studyside.messages:") # - print(list(is.object.created=return.message,validity.check=validity.check, # - studyside.messages=studyside.message)) # - } # + validity.check<-paste0("<",test.obj.name,"> invalid in at least one source. See studyside.messages:") # + message(list(is.object.created=return.message,validity.check=validity.check, # + studyside.messages=studyside.message)) # + } # # #END OF CHECK OBJECT CREATED CORECTLY MODULE # ############################################################################################################# diff --git a/R/ds.glmerSLMA.R b/R/ds.glmerSLMA.R index 8bb8aa36f..b996707ef 100644 --- a/R/ds.glmerSLMA.R +++ b/R/ds.glmerSLMA.R @@ -269,10 +269,10 @@ ds.glmerSLMA <- function(formula=NULL, offset=NULL, weights=NULL, combine.with.m if(sum(as.numeric(grepl('offset', formula, ignore.case=TRUE)))>0 || sum(as.numeric(grepl('weights', formula, ignore.case=TRUE)))>0) { - cat("\n\n WARNING: you may have specified an offset or regression weights") - cat("\n as part of the model formula. In ds.glm (unlike the usual glm in R)") - cat("\n you must specify an offset or weights separately from the formula") - cat("\n using the offset or weights argument.\n\n") + message("\n\n WARNING: you may have specified an offset or regression weights") + message("\n as part of the model formula. In ds.glm (unlike the usual glm in R)") + message("\n you must specify an offset or weights separately from the formula") + message("\n using the offset or weights argument.\n\n") } formula <- stats::as.formula(formula) @@ -363,7 +363,7 @@ ds.glmerSLMA <- function(formula=NULL, offset=NULL, weights=NULL, combine.with.m if (notify.of.progress) { - cat("\n\nSAVING SERVERSIDE glmerMod OBJECT AS: <",newobj,">\n\n") + message("\n\nSAVING SERVERSIDE glmerMod OBJECT AS: <",newobj,">\n\n") } calltext.2 <- call('glmerSLMADS.assign', formula, offset, weights, dataName, family, @@ -407,17 +407,17 @@ ds.glmerSLMA <- function(formula=NULL, offset=NULL, weights=NULL, combine.with.m { for(sse in study.with.errors) { - cat("\n","Error report from second serverside function for study",sse,"\n") - cat("############################################################","\n") - cat(unlist(study.summary[[sse]][[1]]),"\n") - cat(unlist(study.summary[[sse]][[2]]),"\n\n") + message("\n","Error report from second serverside function for study",sse,"\n") + message("############################################################","\n") + message(unlist(study.summary[[sse]][[1]]),"\n") + message(unlist(study.summary[[sse]][[2]]),"\n\n") num.messages<-length(study.summary[[sse]])-2 for(m in 1:num.messages) { if(!is.null(unlist(study.summary[[sse]][[2+m]]))) { - cat(unlist(study.summary[[sse]][[2+m]]),"\n\n") + message(unlist(study.summary[[sse]][[2+m]]),"\n\n") } } } @@ -425,8 +425,8 @@ ds.glmerSLMA <- function(formula=NULL, offset=NULL, weights=NULL, combine.with.m if(all.studies.valid) { - cat("\nAll studies passed disclosure tests\n") - cat("Please check for convergence warnings in the study summaries\n\n\n") + message("\nAll studies passed disclosure tests\n") + message("Please check for convergence warnings in the study summaries\n\n\n") } } @@ -551,8 +551,8 @@ ds.glmerSLMA <- function(formula=NULL, offset=NULL, weights=NULL, combine.with.m if(!coefficient.vectors.match){ - cat("\n\nModels in different sources vary in structure\nplease match coefficients for meta-analysis individually\n") - cat("nYou can use the DataSHIELD generated estimates and standard errors as the basis for a meta-analysis\nbut carry out the final pooling step independently of DataSHIELD using whatever meta-analysis package you wish\n\n") + message("\n\nModels in different sources vary in structure\nplease match coefficients for meta-analysis individually\n") + message("nYou can use the DataSHIELD generated estimates and standard errors as the basis for a meta-analysis\nbut carry out the final pooling step independently of DataSHIELD using whatever meta-analysis package you wish\n\n") return(list(output.summary=output.summary)) } @@ -615,10 +615,10 @@ ds.glmerSLMA <- function(formula=NULL, offset=NULL, weights=NULL, combine.with.m if (notify.of.progress) { - cat("Convergence information\n") + message("Convergence information\n") for(r in 1:numstudies) { - cat(full.error.message[r],"\n") + message(full.error.message[r],"\n") } } diff --git a/R/ds.listClientsideFunctions.R b/R/ds.listClientsideFunctions.R index ba7c57a89..752401471 100644 --- a/R/ds.listClientsideFunctions.R +++ b/R/ds.listClientsideFunctions.R @@ -57,48 +57,30 @@ for(j in 1:length(search.path)) } - cat("\n### Full search path \n") print.search.list<-search() - print(print.search.list) if(test.userDefinedClient==TRUE) { - cat("\n### userDefinedClient functions \n") print.text<-ls(pos=".GlobalEnv",pattern="ds.*") if(identical(print.text,character(0)))print.text<-"No clientside functions in this repository" - print(print.text) print.text.full<-c(print.text.full,print.text) } if(test.dsBetaTestClient==TRUE) { - cat("\n### dsBetaTestClient functions \n") print.text<-ls(pos="package:dsBetaTestClient") if(identical(print.text,character(0)))print.text<-"No clientside functions in this repository" - print(print.text) print.text.full<-c(print.text.full,print.text) } if(test.dsBaseClient==TRUE) { - cat("\n### dsBaseClient functions \n") print.text<-ls(pos="package:dsBaseClient") if(identical(print.text,character(0)))print.text<-"No clientside functions in this repository" - print(print.text) print.text.full<-c(print.text.full,print.text) } - if(test.no.functions==TRUE) - { - cat("\n### No standard clientside functions identified \n") - } - - cat("\nIf you cannot see one or more of the clientside functions you expected to find", - "please see above for the full search path. If one of the paths is a possible clientside repository", - "issue the R command ls(pos='package:dsPackageName')", - "where 'package:dsPackageName' is the full name stated in the search path\n\n") - return(print.text.full) } # ds.listClientsideFunctions() diff --git a/R/ds.lmerSLMA.R b/R/ds.lmerSLMA.R index b6d05c9bf..8b7c69b2c 100644 --- a/R/ds.lmerSLMA.R +++ b/R/ds.lmerSLMA.R @@ -225,10 +225,10 @@ ds.lmerSLMA <- function(formula=NULL, offset=NULL, weights=NULL, combine.with.me if(sum(as.numeric(grepl('offset', formula, ignore.case=TRUE)))>0 || sum(as.numeric(grepl('weights', formula, ignore.case=TRUE)))>0) { - cat("\n\n WARNING: you may have specified an offset or regression weights") - cat("\n as part of the model formula. In ds.glm (unlike the usual glm in R)") - cat("\n you must specify an offset or weights separately from the formula") - cat("\n using the offset or weights argument.\n\n") + message("\n\n WARNING: you may have specified an offset or regression weights") + message("\n as part of the model formula. In ds.glm (unlike the usual glm in R)") + message("\n you must specify an offset or weights separately from the formula") + message("\n using the offset or weights argument.\n\n") } formula <- stats::as.formula(formula) @@ -286,7 +286,7 @@ ds.lmerSLMA <- function(formula=NULL, offset=NULL, weights=NULL, combine.with.me if(!is.null(optimizer)&&optimizer!="nloptwrap") { errorMessage.opt<-"ERROR: the only optimizer currently available for lmer is 'nloptwrap', please respecify" - cat("\n",errorMessage.opt,"\n") + message("\n",errorMessage.opt,"\n") return(list(errorMessage=errorMessage.opt)) } @@ -303,7 +303,7 @@ ds.lmerSLMA <- function(formula=NULL, offset=NULL, weights=NULL, combine.with.me } if (notify.of.progress) { - cat("\n\nSAVING SERVERSIDE lmerMod OBJECT AS: <",newobj,">\n\n") + message("\n\nSAVING SERVERSIDE lmerMod OBJECT AS: <",newobj,">\n\n") } calltext.2 <- call('lmerSLMADS.assign', formula, offset, weights, dataName, REML, @@ -343,17 +343,17 @@ ds.lmerSLMA <- function(formula=NULL, offset=NULL, weights=NULL, combine.with.me { for(sse in study.with.errors) { - cat("\n","Error report from second serverside function for study",sse,"\n") - cat("############################################################","\n") - cat(unlist(study.summary[[sse]][[1]]),"\n") - cat(unlist(study.summary[[sse]][[2]]),"\n\n") + message("\n","Error report from second serverside function for study",sse,"\n") + message("############################################################","\n") + message(unlist(study.summary[[sse]][[1]]),"\n") + message(unlist(study.summary[[sse]][[2]]),"\n\n") num.messages<-length(study.summary[[sse]])-2 for(m in 1:num.messages) { if(!is.null(unlist(study.summary[[sse]][[2+m]]))) { - cat(unlist(study.summary[[sse]][[2+m]]),"\n\n") + message(unlist(study.summary[[sse]][[2+m]]),"\n\n") } } } @@ -361,8 +361,8 @@ ds.lmerSLMA <- function(formula=NULL, offset=NULL, weights=NULL, combine.with.me if(all.studies.valid) { - cat("\nAll studies passed disclosure tests\n") - cat("Please check for convergence warnings in the study summaries\n\n\n") + message("\nAll studies passed disclosure tests\n") + message("Please check for convergence warnings in the study summaries\n\n\n") } } @@ -488,8 +488,8 @@ ds.lmerSLMA <- function(formula=NULL, offset=NULL, weights=NULL, combine.with.me if(!coefficient.vectors.match){ - cat("\n\nModels in different sources vary in structure\nplease match coefficients for meta-analysis individually\n") - cat("nYou can use the DataSHIELD generated estimates and standard errors as the basis for a meta-analysis\nbut carry out the final pooling step independently of DataSHIELD using whatever meta-analysis package you wish\n\n") + message("\n\nModels in different sources vary in structure\nplease match coefficients for meta-analysis individually\n") + message("nYou can use the DataSHIELD generated estimates and standard errors as the basis for a meta-analysis\nbut carry out the final pooling step independently of DataSHIELD using whatever meta-analysis package you wish\n\n") return(list(output.summary=output.summary)) } @@ -552,10 +552,10 @@ for(q in 1:numstudies) if (notify.of.progress) { - cat("Convergence information\n") + message("Convergence information\n") for(r in 1:numstudies) { - cat(full.error.message[r],"\n") + message(full.error.message[r],"\n") } } diff --git a/R/ds.matrix.R b/R/ds.matrix.R index b90356c59..69ad3a728 100644 --- a/R/ds.matrix.R +++ b/R/ds.matrix.R @@ -171,7 +171,7 @@ ds.matrix <- function(mdata = NA, from="clientside.scalar", nrows.scalar=NULL, n #Check that valid from has been specified if(from!="serverside.vector"&&from!="serverside.scalar"&&from!="clientside.scalar") { - cat(" FAILED: must be specified as one of the following - 'serverside.vector', + message(" FAILED: must be specified as one of the following - 'serverside.vector', 'serverside.scalar', 'clientside.scalar'\n\n") return('Please respecify') } diff --git a/R/ds.matrixDiag.R b/R/ds.matrixDiag.R index 8c8ca877a..1ea1341a4 100644 --- a/R/ds.matrixDiag.R +++ b/R/ds.matrixDiag.R @@ -203,7 +203,7 @@ ds.matrixDiag<-function(x1=NULL, aim=NULL, nrows.scalar=NULL, newobj=NULL, datas if(aim!="serverside.vector.2.matrix"&&aim!="serverside.scalar.2.matrix"&&aim!="serverside.matrix.2.vector"&& aim!="clientside.vector.2.matrix"&&aim!="clientside.scalar.2.matrix") { - cat(" FAILED: aim must be specified as one of the following - 'serverside.vector.2.matrix', + message(" FAILED: aim must be specified as one of the following - 'serverside.vector.2.matrix', 'serverside.scalar.2.matrix', 'serverside.matrix.2.vector', 'clientside.vector.2.matrix', 'clientside.scalar.2.matrix'\n\n") return('Please respecify') diff --git a/R/ds.rBinom.R b/R/ds.rBinom.R index 2f39f8b10..ec8b4f880 100644 --- a/R/ds.rBinom.R +++ b/R/ds.rBinom.R @@ -214,14 +214,14 @@ single.integer.seed<-c(single.integer.seed,seed.as.integer.study.specific) if(seed.as.text=="NULL"){ -cat("NO SEED SET IN STUDY",study.id,"\n\n") +message("NO SEED SET IN STUDY",study.id,"\n\n") } else { calltext <- paste0("setSeedDS(", seed.as.text, ")") ssDS.obj[[study.id]] <- DSI::datashield.aggregate(datasources[study.id], as.symbol(calltext)) } } -cat("\n\n") +message("\n\n") diff --git a/R/ds.rNorm.R b/R/ds.rNorm.R index 6100c8505..76d885f11 100644 --- a/R/ds.rNorm.R +++ b/R/ds.rNorm.R @@ -217,13 +217,13 @@ single.integer.seed<-c(single.integer.seed,seed.as.integer.study.specific) if(seed.as.text=="NULL"){ -cat("NO SEED SET IN STUDY",study.id,"\n\n") +message("NO SEED SET IN STUDY",study.id,"\n\n") } calltext <- paste0("setSeedDS(", seed.as.text, ")") ssDS.obj[[study.id]] <- DSI::datashield.aggregate(datasources[study.id], as.symbol(calltext)) } -cat("\n\n") +message("\n\n") diff --git a/R/ds.rPois.R b/R/ds.rPois.R index 2d2c7f019..74be7fdf7 100644 --- a/R/ds.rPois.R +++ b/R/ds.rPois.R @@ -190,13 +190,13 @@ single.integer.seed<-c(single.integer.seed,seed.as.integer.study.specific) if(seed.as.text=="NULL"){ -cat("NO SEED SET IN STUDY",study.id,"\n\n") +message("NO SEED SET IN STUDY",study.id,"\n\n") } calltext <- paste0("setSeedDS(", seed.as.text, ")") ssDS.obj[[study.id]] <- DSI::datashield.aggregate(datasources[study.id], as.symbol(calltext)) } -cat("\n\n") +message("\n\n") diff --git a/R/ds.rUnif.R b/R/ds.rUnif.R index d98fa28f0..ea74766b5 100644 --- a/R/ds.rUnif.R +++ b/R/ds.rUnif.R @@ -232,7 +232,7 @@ single.integer.seed<-c(single.integer.seed,seed.as.integer.study.specific) if(seed.as.text=="NULL"){ -cat("NO SEED SET IN STUDY",study.id,"\n") +message("NO SEED SET IN STUDY",study.id,"\n") } else { calltext <- paste0("setSeedDS(", seed.as.text, ")") diff --git a/R/ds.ranksSecure.R b/R/ds.ranksSecure.R index 1d9d98ed9..8ffa6a971 100644 --- a/R/ds.ranksSecure.R +++ b/R/ds.ranksSecure.R @@ -228,7 +228,7 @@ ds.ranksSecure <- function(input.var.name=NULL, quantiles.for.estimation="0.05-0 } if(monitor.progress){ -cat("\n\nStep 1 of 8 complete: +message("\n\nStep 1 of 8 complete: Cleaned up residual output from previous runs of ds.ranksSecure @@ -272,7 +272,7 @@ cat("\n\nStep 1 of 8 complete: dsBaseClient::ds.dmtC2S(dfdata=input.mean.sd.df,newobj="input.mean.sd.df") if(monitor.progress){ -cat("\n\nStep 2 of 8 complete: +message("\n\nStep 2 of 8 complete: Estimated mean and sd of v2br to standardise initial values @@ -308,7 +308,7 @@ cat("\n\nStep 2 of 8 complete: dsBaseClient::ds.dmtC2S(dfdata=min.max.df,newobj="min.max.df") if(monitor.progress){ -cat("\n\nStep 3 of 8 complete: +message("\n\nStep 3 of 8 complete: Generated ultra max and ultra min values to allocate to missing values if is NA.hi or NA.low @@ -316,9 +316,6 @@ cat("\n\nStep 3 of 8 complete: ") } -print(input.mean.sd.df) - - #CALL THE FIRST SERVER SIDE FUNCTION (ASSIGN) #WRITES ENCRYPTED DATA TO SERVERSIDE OBJECT "blackbox.output.df" calltext1 <- call("blackBoxDS", input.var.name=input.var.name, @@ -328,7 +325,7 @@ print(input.mean.sd.df) DSI::datashield.assign(datasources, "blackbox.output.df", calltext1) if(monitor.progress){ -cat("\n\nStep 4 of 8 complete: +message("\n\nStep 4 of 8 complete: Pseudo data synthesised,first set of rank-consistent transformations complete and blackbox.output.df created @@ -390,7 +387,7 @@ cat("\n\nStep 4 of 8 complete: ds.make("sR5.df$global.rank","testvar.ranks") if(monitor.progress){ -cat("\n\nStep 5 of 8 complete: + message("\n\nStep 5 of 8 complete: Global ranks generated and pseudodata stripped out. Now ready to proceed to transformation of global ranks @@ -445,7 +442,7 @@ cat("\n\nStep 5 of 8 complete: DSI::datashield.assign(datasources, "blackbox.ranks.df", calltext4) if(monitor.progress){ -cat("\n\nStep 6 of 8 complete: + message("\n\nStep 6 of 8 complete: Rank-consistent transformations of global ranks complete and blackbox.ranks.df created @@ -510,7 +507,7 @@ cat("\n\nStep 6 of 8 complete: DSI::datashield.assign(datasources,summary.output.ranks.df, calltext7) if(monitor.progress){ -cat("\n\nStep 7 of 8 complete: + message("\n\nStep 7 of 8 complete: Final global ranking of values in v2br complete and written to each serverside as appropriate @@ -544,7 +541,7 @@ cat("\n\nStep 7 of 8 complete: } if(monitor.progress && rm.residual.objects){ -cat("\n\nStep 8 of 8 complete: + message("\n\nStep 8 of 8 complete: Cleaned up residual output from running ds.ranksSecure @@ -552,7 +549,7 @@ cat("\n\nStep 8 of 8 complete: } if(monitor.progress && !rm.residual.objects){ - cat("\n\nStep 8 of 8 complete: + message("\n\nStep 8 of 8 complete: Residual output from running ds.ranksSecure NOT deleted @@ -562,14 +559,14 @@ cat("\n\nStep 8 of 8 complete: if(!generate.quantiles){ - cat("\n\n\n"," FINAL RANKING PROCEDURES COMPLETE: + message("\n\n\n"," FINAL RANKING PROCEDURES COMPLETE: PRIMARY RANKING OUTPUT IS IN DATA FRAME",summary.output.ranks.df, " WHICH IS SORTED BY",ranks.sort.by," AND HAS BEEN WRITTEN TO THE SERVERSIDE\n\n\n\n") info.message<-"As the argument was set to FALSE no quantiles have been estimated.Please set argument to TRUE if you want to estimate quantiles such as median, quartiles and 90th percentile" - cat("\n\n",info.message,"\n\n") + message("\n\n",info.message,"\n\n") return(info.message) } diff --git a/R/ds.rbind.R b/R/ds.rbind.R index 47e9165c2..d0aca96a8 100644 --- a/R/ds.rbind.R +++ b/R/ds.rbind.R @@ -133,7 +133,7 @@ calltext1<-call('classDS', testclass.var) next.class <- DSI::datashield.aggregate(datasources, calltext1) class.vector<-c(class.vector,next.class[[1]]) if (notify.of.progress) - cat("\n",j," of ", length(x), " elements to combine in step 1 of 2\n") + message("\n",j," of ", length(x), " elements to combine in step 1 of 2\n") } for(j in 1:length(x)) @@ -144,7 +144,7 @@ if(class.vector[j]!="data.frame" && class.vector[j]!="matrix") { colname.vector<-c(colname.vector,test.df) if (notify.of.progress) - cat("\n",j," of ", length(x), " elements to combine in step 2 of 2\n") + message("\n",j," of ", length(x), " elements to combine in step 2 of 2\n") } else { @@ -152,11 +152,11 @@ else df.names <- DSI::datashield.aggregate(datasources, calltext2) colname.vector<-c(colname.vector,df.names[[1]]) if (notify.of.progress) - cat("\n",j," of ", length(x), " elements to combine in step 2 of 2\n") + message("\n",j," of ", length(x), " elements to combine in step 2 of 2\n") } } if (notify.of.progress) - cat("\nBoth steps completed\n") + message("\nBoth steps completed\n") #CHECK FOR DUPLICATE NAMES IN COLUMN NAME VECTOR AND ADD ".k" TO THE kth REPLICATE num.duplicates<-rep(0,length(colname.vector)) diff --git a/R/ds.rep.R b/R/ds.rep.R index 2d2ce9515..2f3e03010 100644 --- a/R/ds.rep.R +++ b/R/ds.rep.R @@ -151,7 +151,7 @@ if(source.each=='s')source.each<-'serverside' #Check that source has been specified if(source.x1!="serverside"&&source.x1!="clientside") { - cat(" FAILED: if source.x1 is non-null it must be specified as + message(" FAILED: if source.x1 is non-null it must be specified as one of the following: 'clientside','serverside','c', or 's'\n\n") return('Please respecify') } @@ -174,7 +174,7 @@ if(source.each=='s')source.each<-'serverside' #Check that source has been specified if(source.times!="serverside"&&source.times!="clientside"&&!is.null(source.times)) { - cat(" FAILED: if source.times is non-null it must be specified as + message(" FAILED: if source.times is non-null it must be specified as one of the following: 'clientside','serverside','c', or 's'\n\n") return('Please respecify') } @@ -208,7 +208,7 @@ if(source.each=='s')source.each<-'serverside' #Check that source has been specified if(source.length.out!="serverside"&&source.length.out!="clientside"&&!is.null(source.length.out)) { - cat(" FAILED: if source.length.out is non-null it must be specified as + message(" FAILED: if source.length.out is non-null it must be specified as one of the following: 'clientside','serverside','c', or 's'\n\n") return('Please respecify') } @@ -243,7 +243,7 @@ if(source.each=='s')source.each<-'serverside' #Check that source has been specified if(source.each!="serverside"&&source.each!="clientside"&&!is.null(source.each)) { - cat(" FAILED: if source.each is non-null it must be specified as + message(" FAILED: if source.each is non-null it must be specified as one of the following: 'clientside','serverside','c', or 's'\n\n") return('Please respecify') } diff --git a/R/ds.sample.R b/R/ds.sample.R index 08c1b04c1..9bd6780fb 100644 --- a/R/ds.sample.R +++ b/R/ds.sample.R @@ -207,18 +207,18 @@ single.integer.seed<-c(single.integer.seed,seed.as.integer.study.specific) if(seed.as.text=="NULL"){ if (notify.of.progress) - cat("NO SEED SET IN STUDY",study.id,"\n\n") + message("NO SEED SET IN STUDY",study.id,"\n\n") } calltext <- paste0("setSeedDS(", seed.as.text, ")") if (notify.of.progress) - print(calltext) + message(calltext) ssDS.obj[[study.id]] <- DSI::datashield.aggregate(datasources[study.id], as.symbol(calltext)) } if (notify.of.progress) - cat("\n\n") + message("\n\n") diff --git a/R/ds.table.R b/R/ds.table.R index 780f9f862..e1238e2a5 100644 --- a/R/ds.table.R +++ b/R/ds.table.R @@ -424,10 +424,10 @@ if(num.valid.studies==0) if ((! table.assign) || report.chisq.tests) { validity.message<-"All studies failed for reasons identified below" - cat("\n",validity.message,"\n\n") + message("\n",validity.message,"\n\n") for(ns in 1:numsources.orig) { - cat("\nStudy",ns,": ",error.messages[[ns]],"\n") + message("\nStudy",ns,": ",error.messages[[ns]],"\n") } return(list(validity.message=validity.message,error.messages=error.messages)) @@ -476,12 +476,12 @@ for(ns in 1:numsources.orig) validity.message<-c(validity.message,message.add) } -# cat("\n",validity.message,"\n") +# message("\n",validity.message,"\n") # for(ns in 1:numsources.orig) # { -# cat("\nStudy",ns,": ",error.messages[[ns]]) +# message("\nStudy",ns,": ",error.messages[[ns]]) # } -# cat("\n\n") +# message("\n\n") #table.out<-table.out.valid #numsources<-length(table.out) @@ -492,12 +492,12 @@ if(num.valid.studies==numsources.orig) validity.message<-"Data in all studies were valid" if (! table.assign) { - cat("\n",validity.message,"\n") + message("\n",validity.message,"\n") for(ns in 1:numsources.orig) { - cat("\nStudy",ns,": ",error.messages[[ns]]) + message("\nStudy",ns,": ",error.messages[[ns]]) } - cat("\n\n") + message("\n\n") } } @@ -520,7 +520,6 @@ if(numsources>1) { all.dims.same<-FALSE return.message<-"Warning: tables in different sources have different numbers of dimensions. Please analyse and combine yourself from study.specific tables above" - print(return.message) return(return.message) } } @@ -649,7 +648,7 @@ cells.so.far<-0 table.current.study<-cbind(rvar.mark,cvar.mark,stvar.mark,count.in.cell) table.current.study[is.na(table.current.study)]<-"NA" -#cat("current study =",ns) +#message("current study =",ns) #print(table.current.study) @@ -738,7 +737,7 @@ for(oo in 1:length(table.current.study[,1])) if(d1.a!=d1||d2.a!=d2||d3.a!=d3) { return.message= "Dimensions of tables not behaving sensibly across studies.Please check the data in each study and calculate counts and percentages, yourself, using the counts from the individual studies" - cat(return.message) + message(return.message) return(return.message) } @@ -875,7 +874,7 @@ cells.so.far<-0 table.current.study<-cbind(rvar.mark,cvar.mark,count.in.cell) table.current.study[is.na(table.current.study)]<-"NA" -#cat("current study =",ns) +#message("current study =",ns) #print(table.current.study) @@ -959,7 +958,7 @@ for(oo in 1:length(table.current.study[,1])) if(d1.a!=d1||d2.a!=d2) { return.message= "Dimensions of tables not behaving sensibly across studies.Please check the data in each study and calculate counts and percentages, yourself, using the counts from the individual studies" - cat(return.message) + message(return.message) return(return.message) } @@ -1082,7 +1081,7 @@ cells.so.far<-0 table.current.study<-cbind(rvar.mark,count.in.cell) table.current.study[is.na(table.current.study)]<-"NA" -#cat("current study =",ns) +#message("current study =",ns) #print(table.current.study) @@ -1153,7 +1152,7 @@ for(oo in 1:length(table.current.study[,1])) if(d1.a!=d1) { return.message= "Dimensions of tables not behaving sensibly across studies.Please check the data in each study and calculate counts and percentages, yourself, using the counts from the individual studies" - cat(return.message) + message(return.message) return(return.message) } From 0d4755d677bcbb5abb26b4ba7d878b530159399b Mon Sep 17 00:00:00 2001 From: Stuart Wheater Date: Fri, 21 Nov 2025 16:10:22 +0000 Subject: [PATCH 5/8] par -> graphics::par --- R/ds.contourPlot.R | 4 ++-- R/ds.heatmapPlot.R | 4 ++-- R/ds.histogram.R | 4 ++-- R/ds.scatterPlot.R | 4 ++-- 4 files changed, 8 insertions(+), 8 deletions(-) diff --git a/R/ds.contourPlot.R b/R/ds.contourPlot.R index 6601dd912..f1fbb3bd8 100644 --- a/R/ds.contourPlot.R +++ b/R/ds.contourPlot.R @@ -121,8 +121,8 @@ ds.contourPlot <- function(x=NULL, y=NULL, type='combine', show='all', numints=2 } # Save par and setup reseting of par values - old_par <- par(no.readonly = TRUE) - on.exit(par(old_par), add = TRUE) + old_par <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(old_par), add = TRUE) # check if the input objects are defined in all the studies isDefined(datasources, x) diff --git a/R/ds.heatmapPlot.R b/R/ds.heatmapPlot.R index 2c920e331..024224aa5 100644 --- a/R/ds.heatmapPlot.R +++ b/R/ds.heatmapPlot.R @@ -170,8 +170,8 @@ ds.heatmapPlot <- function(x=NULL, y=NULL, type="combine", show="all", numints=2 } # Save par and setup reseting of par values - old_par <- par(no.readonly = TRUE) - on.exit(par(old_par), add = TRUE) + old_par <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(old_par), add = TRUE) # check if the input objects are defined in all the studies isDefined(datasources, x) diff --git a/R/ds.histogram.R b/R/ds.histogram.R index 358c1a08c..0fbe2e209 100644 --- a/R/ds.histogram.R +++ b/R/ds.histogram.R @@ -168,8 +168,8 @@ ds.histogram <- function(x=NULL, type="split", num.breaks=10, method="smallCells } # Save par and setup reseting of par values - old_par <- par(no.readonly = TRUE) - on.exit(par(old_par), add = TRUE) + old_par <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(old_par), add = TRUE) # check if the input object is defined in all the studies isDefined(datasources, x) diff --git a/R/ds.scatterPlot.R b/R/ds.scatterPlot.R index 21e5b2629..55804b3b0 100644 --- a/R/ds.scatterPlot.R +++ b/R/ds.scatterPlot.R @@ -148,8 +148,8 @@ ds.scatterPlot <- function(x=NULL, y=NULL, method='deterministic', k=3, noise=0. } # Save par and setup reseting of par values - old_par <- par(no.readonly = TRUE) - on.exit(par(old_par), add = TRUE) + old_par <- graphics::par(no.readonly = TRUE) + on.exit(graphics::par(old_par), add = TRUE) # check if the input objects are defined in all the studies isDefined(datasources, x) From 7e944fd6c10d7f2b99ada459690dd68573beaa4e Mon Sep 17 00:00:00 2001 From: Stuart Wheater Date: Fri, 21 Nov 2025 16:15:55 +0000 Subject: [PATCH 6/8] Fix mice result --- tests/testthat/test-smk-ds.mice.R | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/tests/testthat/test-smk-ds.mice.R b/tests/testthat/test-smk-ds.mice.R index 19e46f740..71c0464a4 100644 --- a/tests/testthat/test-smk-ds.mice.R +++ b/tests/testthat/test-smk-ds.mice.R @@ -83,12 +83,7 @@ test_that("mice, second imputation", { expect_length(newImp$sim2, 3) expect_length(newImp$sim3, 3) expect_true("character" %in% class(newImp$sim1$method)) - if (ds.test_env$driver == "OpalDriver") - expect_equal(as.character(newImp$sim1$method), c("pmm","norm","pmm","pmm","pmm","","","","","","polyreg")) - else if (ds.test_env$driver == "ArmadilloDriver") - expect_equal(as.character(newImp$sim1$method), c("pmm","norm","pmm","pmm","pmm","","","","","","")) - else - expect_equal(as.character(newImp$sim1$method), c("pmm","norm","pmm","pmm","pmm","","","","","","polyreg")) + expect_equal(as.character(newImp$sim1$method), c("pmm","norm","pmm","pmm","pmm","","","","","","polyreg")) expect_true("matrix" %in% class(newImp$sim1$predictorMatrix)) expect_true("array" %in% class(newImp$sim1$predictorMatrix)) expect_equal(as.numeric(newImp$sim1$predictorMatrix[,1]), c(0,1,1,1,1,1,1,1,1,1,1)) From 40108ca415dde4326092a14e816cdfe2a491171a Mon Sep 17 00:00:00 2001 From: Stuart Wheater Date: Fri, 21 Nov 2025 16:23:47 +0000 Subject: [PATCH 7/8] Removed ' --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 8f531e9e0..348fb26e8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -5,7 +5,7 @@ Description: Base 'DataSHIELD' functions for the client side. 'DataSHIELD' is a you to do non-disclosive federated analysis on sensitive data. 'DataSHIELD' analytic functions have been designed to only share non disclosive summary statistics, with built in automated output checking based on statistical disclosure control. With data sites setting the threshold values for - the automated output checks. For more details, see 'citation("dsBaseClient")'. + the automated output checks. For more details, see citation("dsBaseClient"). Authors@R: c(person(given = "Paul", family = "Burton", role = c("aut"), From 584fa476ed70fa812d57ac3eaa3fd9b5d6198d26 Mon Sep 17 00:00:00 2001 From: Stuart Wheater Date: Fri, 21 Nov 2025 16:39:39 +0000 Subject: [PATCH 8/8] Remove dataBootstrapUnitTests.R --- .../data_files/dataBootstrapUnitTests.R | 117 ------------------ 1 file changed, 117 deletions(-) delete mode 100644 tests/testthat/data_files/dataBootstrapUnitTests.R diff --git a/tests/testthat/data_files/dataBootstrapUnitTests.R b/tests/testthat/data_files/dataBootstrapUnitTests.R deleted file mode 100644 index 4c51af16a..000000000 --- a/tests/testthat/data_files/dataBootstrapUnitTests.R +++ /dev/null @@ -1,117 +0,0 @@ -library(remotes) -install.packages("MolgenisArmadillo", repos = "https://registry.molgenis.org/repository/R") -library(MolgenisArmadillo) -library(DSI) - -# init_studies_dataset -CNSIM1 <- load("data_files/CNSIM/CNSIM1.rda") -CNSIM2 <- load("data_files/CNSIM/CNSIM2.rda") -CNSIM3 <- load("data_files/CNSIM/CNSIM3.rda") - -DASIM1 <- load("data_files/DASIM/DASIM1.rda") -DASIM2 <- load("data_files/DASIM/DASIM2.rda") -DASIM3 <- load("data_files/DASIM/DASIM3.rda") - -EXPAND_WITH_MISSING1 <- load("data_files/SURVIVAL/EXPAND_MISSING/expand_missing_study1.rda") -EXPAND_WITH_MISSING2 <- load("data_files/SURVIVAL/EXPAND_MISSING/expand_missing_study2.rda") -EXPAND_WITH_MISSING3 <- load("data_files/SURVIVAL/EXPAND_MISSING/expand_missing_study3.rda") - -CLUSTER_INT1 <- load("data_files/CLUSTER/CLUSTER_INT1.rda") -CLUSTER_INT2 <- load("data_files/CLUSTER/CLUSTER_INT2.rda") -CLUSTER_INT3 <- load("data_files/CLUSTER/CLUSTER_INT3.rda") - -CLUSTER_SLO1 <- load("data_files/CLUSTER/CLUSTER_SLO1.rda") -CLUSTER_SLO2 <- load("data_files/CLUSTER/CLUSTER_SLO2.rda") -CLUSTER_SLO3 <- load("data_files/CLUSTER/CLUSTER_SLO3.rda") - -# init_discordant_datasets -DISCORDANT_STUDY1 <- load("data_files/DISCORDANT/discordant_study1.rda") -DISCORDANT_STUDY2 <- load("data_files/DISCORDANT/discordant_study2.rda") -DISCORDANT_STUDY3 <- load("data_files/DISCORDANT/discordant_study3.rda") - -# init_testing_datasets -DATASET1 <- load("data_files/TESTING/DATASET1.rda") -DATASET2 <- load("data_files/TESTING/DATASET2.rda") -DATASET3 <- load("data_files/TESTING/DATASET3.rda") - -FACTOR_LEVELS_DATASET1 <- load("data_files/FACTOR_LEVELS/FACTOR_LEVELS_DATASET1.rda") -FACTOR_LEVELS_DATASET2 <- load("data_files/FACTOR_LEVELS/FACTOR_LEVELS_DATASET2.rda") -FACTOR_LEVELS_DATASET3 <- load("data_files/FACTOR_LEVELS/FACTOR_LEVELS_DATASET3.rda") - - -storage_url <- "http://localhost:9000" -# access_key and secret_key can be found in the minio configuration in the docker-compose.yml -MolgenisArmadillo::armadillo.set_credentials(server = storage_url, access_key = "molgenis", secret_key = "molgenis") -MolgenisArmadillo::armadillo.create_project("testdata") - - -# init_studies_datasets -MolgenisArmadillo::armadillo.upload_table("testdata", "cnsim", CNSIM1) -MolgenisArmadillo::armadillo.upload_table("testdata", "cnsim", CNSIM2) -MolgenisArmadillo::armadillo.upload_table("testdata", "cnsim", CNSIM3) - -MolgenisArmadillo::armadillo.upload_table("testdata", "dasim", DASIM1) -MolgenisArmadillo::armadillo.upload_table("testdata", "dasim", DASIM2) -MolgenisArmadillo::armadillo.upload_table("testdata", "dasim", DASIM3) - -MolgenisArmadillo::armadillo.upload_table("testdata", "survival", EXPAND_WITH_MISSING1) -MolgenisArmadillo::armadillo.upload_table("testdata", "survival", EXPAND_WITH_MISSING2) -MolgenisArmadillo::armadillo.upload_table("testdata", "survival", EXPAND_WITH_MISSING3) - -MolgenisArmadillo::armadillo.upload_table("testdata", "cluster", CLUSTER_INT1) -MolgenisArmadillo::armadillo.upload_table("testdata", "cluster", CLUSTER_INT2) -MolgenisArmadillo::armadillo.upload_table("testdata", "cluster", CLUSTER_INT3) - -MolgenisArmadillo::armadillo.upload_table("testdata", "cluster", CLUSTER_SLO1) -MolgenisArmadillo::armadillo.upload_table("testdata", "cluster", CLUSTER_SLO2) -MolgenisArmadillo::armadillo.upload_table("testdata", "cluster", CLUSTER_SLO3) - - -# init_discordant_datasets -MolgenisArmadillo::armadillo.upload_table("testdata", "discordant", DISCORDANT_STUDY1) -MolgenisArmadillo::armadillo.upload_table("testdata", "discordant", DISCORDANT_STUDY2) -MolgenisArmadillo::armadillo.upload_table("testdata", "discordant", DISCORDANT_STUDY3) - - -# remove first column -DATASET1 <- DATASET1[,-1] -DATASET2 <- DATASET2[,-1] -DATASET3 <- DATASET3[,-1] - -# init_testing_datasets -MolgenisArmadillo::armadillo.upload_table("testdata", "testing", DATASET1) -MolgenisArmadillo::armadillo.upload_table("testdata", "testing", DATASET2) -MolgenisArmadillo::armadillo.upload_table("testdata", "testing", DATASET3) - -MolgenisArmadillo::armadillo.upload_table("testdata", "factor_levels", FACTOR_LEVELS_DATASET1) -MolgenisArmadillo::armadillo.upload_table("testdata", "factor_levels", FACTOR_LEVELS_DATASET2) -MolgenisArmadillo::armadillo.upload_table("testdata", "factor_levels", FACTOR_LEVELS_DATASET3) - -class(CNSIM1$PM_BMI_CATEGORICAL) -levels(CNSIM1$PM_BMI_CATEGORICAL) - -devtools::test() -devtools::test(filter = "datachk", invert = TRUE) -devtools::test(filter = "dataFrameSort") - - # build the login dataframe -builder <- DSI::newDSLoginBuilder() -builder$append(server = "armadillo", - url = armadillo_url, - user = "admin", - password = "admin", - table = "testdata/testing/DISCORDANT_STUDY1", - driver = "ArmadilloDriver") - -# create loginframe -logindata <- builder$build() -logindata - -datashield.logout(conns) - -conns <- datashield.login(logins = logindata, assign = TRUE) -ds.ls() -dsGetInfo(conns$armadillo) -ds.colnames("D") -datashield.errors() -dsGetInfo(conns$armadillo)