Updates for CRAN

DESCRIPTION

@@ -1,11 +1,11 @@
 Package: dsBaseClient
 Title: 'DataSHIELD' Client Side Base Functions
-Version: 7.0.0-9000
+Version: 7.0.0.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
     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"),

NAMESPACE

@@ -1,6 +1,5 @@
 # Generated by roxygen2: do not edit by hand
 
-export(computeWeightedMeans)
 export(ds.Boole)
 export(ds.abs)
 export(ds.asCharacter)

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)) {

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,30 +198,30 @@ 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)){
       test.df <- x[j]
       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")
         }  
       }
     }
     colname.list[[std]] <- colname.vector
   }
 
   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

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 <- 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)
   isDefined(datasources, y)

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,30 +178,30 @@ 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)){
       test.df <- x[j]
       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")
         }  
       }
     }
     colname.list[[std]] <- colname.vector
   }
 
   if (notify.of.progress){
-    cat("\nBoth steps in all studies completed\n")
+    message("\nBoth steps in all studies completed\n")
   }
 
   # prepare vectors for transmission

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")
 	    }
         }
     }

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: <dfdata> must either be a data.frame, matrix or tibble")	
+	   message("\n            FAILED: <dfdata> must either be a data.frame, matrix or tibble")	
        return('Please respecify')
 	}
 

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

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
 #'

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 <datasources> 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,

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))
     }
 

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															 	#
 #############################################################################################################

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,26 +407,26 @@ 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")
           }
         }
       }
     }
 
     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")
     }
   }	
 

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 <- 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)
   isDefined(datasources, y)

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 <- 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)