V6.3.4 dev permissive

R/BooleDS.R

@@ -28,7 +28,7 @@
 BooleDS <- function(V1.name=NULL, V2.name=NULL, Boolean.operator.n=NULL, na.assign.text, numeric.output=TRUE){
 
   # Check Permissive Privacy Control Level.
-  dsBase::checkPermissivePrivacyControlLevel(c('permissive', 'banana'))
+  dsBase::checkPermissivePrivacyControlLevel(c('permissive', 'banana', 'carrot'))
 
 #########################################################################
 # DataSHIELD MODULE: CAPTURE THE nfilter SETTINGS                       #

R/blackBoxDS.R

@@ -67,8 +67,11 @@ blackBoxDS <- function(input.var.name=NULL,
   ########################################################
 
   # back-up current .Random.seed and revert on.exit
-  old_seed <- .Random.seed
-  on.exit(.Random.seed <- old_seed, add = TRUE)
+  if (exists(x = ".Random.seed", envir = globalenv())) {
+      assign(x = "old_seed", value = .Random.seed, envir = parent.frame());
+      on.exit({ assign(x = ".Random.seed", value = old_seed, envir = globalenv()); remove("old_seed", envir = parent.frame()) }, add = TRUE)
+  } else
+      on.exit(if (exists(x = ".Random.seed", envir = globalenv())) remove(".Random.seed", envir = globalenv()), add = TRUE)
 
  input.var <- eval(parse(text=input.var.name), envir = parent.frame())
 

R/blackBoxRanksDS.R

@@ -62,8 +62,11 @@ blackBoxRanksDS <- function(input.var.name=NULL, shared.seedval){ #START FUNC
   ########################################################
 
   # back-up current .Random.seed and revert on.exit
-  old_seed <- .Random.seed
-  on.exit(.Random.seed <- old_seed, add = TRUE)
+  if (exists(x = ".Random.seed", envir = globalenv())) {
+      assign(x = "old_seed", value = .Random.seed, envir = parent.frame());
+      on.exit({ assign(x = ".Random.seed", value = old_seed, envir = globalenv()); remove("old_seed", envir = parent.frame()) }, add = TRUE)
+  } else
+      on.exit(if (exists(x = ".Random.seed", envir = globalenv())) remove(".Random.seed", envir = globalenv()), add = TRUE)
 
 input.var <- eval(parse(text=input.var.name), envir = parent.frame())
 input.global.ranks<-input.var

R/cbindDS.R

@@ -24,7 +24,7 @@
 cbindDS <- function(x.names.transmit=NULL, colnames.transmit=NULL){
 
   # Check Permissive Privacy Control Level.
-  dsBase::checkPermissivePrivacyControlLevel(c('permissive', 'banana'))
+  dsBase::checkPermissivePrivacyControlLevel(c('permissive', 'banana', 'carrot'))
 
   x.names.input <- x.names.transmit
   x.names.act1 <- unlist(strsplit(x.names.input, split=","))

R/dataFrameDS.R

@@ -40,7 +40,7 @@
 dataFrameDS <- function(vectors=NULL, r.names=NULL, ch.rows=FALSE, ch.names=TRUE, clnames=NULL, strAsFactors=TRUE, completeCases=FALSE){
 
   # Check Permissive Privacy Control Level.
-  dsBase::checkPermissivePrivacyControlLevel(c('permissive', 'banana'))
+  dsBase::checkPermissivePrivacyControlLevel(c('permissive', 'banana', 'carrot'))
 
   #########################################################################
   # DataSHIELD MODULE: CAPTURE THE nfilter SETTINGS

R/dataFrameSortDS.R

@@ -36,7 +36,7 @@
 dataFrameSortDS <- function(df.name=NULL,sort.key.name=NULL,sort.descending,sort.method){
 
   # Check Permissive Privacy Control Level.
-  dsBase::checkPermissivePrivacyControlLevel(c('permissive', 'banana'))
+  dsBase::checkPermissivePrivacyControlLevel(c('permissive', 'banana', 'carrot'))
 
   #########################################################################
   # DataSHIELD MODULE: CAPTURE THE nfilter SETTINGS

R/dataFrameSubsetDS1.R

@@ -50,7 +50,7 @@
 dataFrameSubsetDS1 <- function(df.name=NULL,V1.name=NULL,V2.name=NULL,Boolean.operator.n=NULL,keep.cols=NULL,rm.cols=NULL,keep.NAs=NULL){
 
   # Check Permissive Privacy Control Level.
-  dsBase::checkPermissivePrivacyControlLevel(c('permissive', 'banana'))
+  dsBase::checkPermissivePrivacyControlLevel(c('permissive', 'banana', 'carrot'))
 
 #########################################################################
 # DataSHIELD MODULE: CAPTURE THE nfilter SETTINGS

R/dataFrameSubsetDS2.R

@@ -59,7 +59,7 @@
 dataFrameSubsetDS2<-function(df.name=NULL,V1.name=NULL, V2.name=NULL, Boolean.operator.n=NULL,keep.cols=NULL, rm.cols=NULL, keep.NAs=NULL){
 
   # Check Permissive Privacy Control Level.
-  dsBase::checkPermissivePrivacyControlLevel(c('permissive', 'banana'))
+  dsBase::checkPermissivePrivacyControlLevel(c('permissive', 'banana', 'carrot'))
 
 #########################################################################
 # DataSHIELD MODULE: CAPTURE THE nfilter SETTINGS                       #

R/heatmapPlotDS.R

@@ -39,8 +39,11 @@ heatmapPlotDS <- function(x, y, k, noise, method.indicator){
   ###################################################################
 
   # back-up current .Random.seed and revert on.exit
-  old_seed <- .Random.seed
-  on.exit(.Random.seed <- old_seed, add = TRUE)
+  if (exists(x = ".Random.seed", envir = globalenv())) {
+      assign(x = "old_seed", value = .Random.seed, envir = parent.frame());
+      on.exit({ assign(x = ".Random.seed", value = old_seed, envir = globalenv()); remove("old_seed", envir = parent.frame()) }, add = TRUE)
+  } else
+      on.exit(if (exists(x = ".Random.seed", envir = globalenv())) remove(".Random.seed", envir = globalenv()), add = TRUE)
 
   # Cbind the columns of the two variables and remove any rows that include NAs
   data.table <- cbind.data.frame(x, y)

R/histogramDS1.R

@@ -37,8 +37,11 @@ histogramDS1 <- function(xvect, method.indicator, k, noise){
   ##################################################################
 
   # back-up current .Random.seed and revert on.exit
-  old_seed <- .Random.seed
-  on.exit(.Random.seed <- old_seed, add = TRUE)
+  if (exists(x = ".Random.seed", envir = globalenv())) {
+      assign(x = "old_seed", value = .Random.seed, envir = parent.frame());
+      on.exit({ assign(x = ".Random.seed", value = old_seed, envir = globalenv()); remove("old_seed", envir = parent.frame()) }, add = TRUE)
+  } 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))){

R/histogramDS2.R

@@ -39,8 +39,11 @@ histogramDS2 <- function (xvect, num.breaks, min, max, method.indicator, k, nois
   ##################################################################
 
   # back-up current .Random.seed and revert on.exit
-  old_seed <- .Random.seed
-  on.exit(.Random.seed <- old_seed, add = TRUE)
+  if (exists(x = ".Random.seed", envir = globalenv())) {
+      assign(x = "old_seed", value = .Random.seed, envir = parent.frame());
+      on.exit({ assign(x = ".Random.seed", value = old_seed, envir = globalenv()); remove("old_seed", envir = parent.frame()) }, add = TRUE)
+  } else
+      on.exit(if (exists(x = ".Random.seed", envir = globalenv())) remove(".Random.seed", envir = globalenv()), add = TRUE)
 
   if (method.indicator==1){
 

R/levelsDS.R

@@ -10,7 +10,7 @@
 levelsDS <- function(x){
 
   # Check Permissive Privacy Control Level.
-  dsBase::checkPermissivePrivacyControlLevel(c('permissive', 'banana'))
+  dsBase::checkPermissivePrivacyControlLevel(c('permissive', 'banana', 'carrot'))
 
   ##################################################################
   #MODULE 1: CAPTURE THE nfilter SETTINGS                          #

R/minMaxRandDS.R

@@ -21,8 +21,11 @@
 minMaxRandDS <- function(input.var.name){ #START FUNC
 
   # back-up current .Random.seed and revert on.exit
-  old_seed <- .Random.seed
-  on.exit(.Random.seed <- old_seed, add = TRUE)
+  if (exists(x = ".Random.seed", envir = globalenv())) {
+      assign(x = "old_seed", value = .Random.seed, envir = parent.frame());
+      on.exit({ assign(x = ".Random.seed", value = old_seed, envir = globalenv()); remove("old_seed", envir = parent.frame()) }, add = TRUE)
+  } else
+      on.exit(if (exists(x = ".Random.seed", envir = globalenv())) remove(".Random.seed", envir = globalenv()), add = TRUE)
 
   input.var <- eval(parse(text=input.var.name), envir = parent.frame())
 

R/rangeDS.R

@@ -9,8 +9,11 @@
 #'
 rangeDS <- function(xvect) {
   # back-up current .Random.seed and revert on.exit
-  old_seed <- .Random.seed
-  on.exit(.Random.seed <- old_seed, add = TRUE)
+  if (exists(x = ".Random.seed", envir = globalenv())) {
+      assign(x = "old_seed", value = .Random.seed, envir = parent.frame());
+      on.exit({ assign(x = ".Random.seed", value = old_seed, envir = globalenv()); remove("old_seed", envir = parent.frame()) }, add = TRUE)
+  } 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))) {

R/reShapeDS.R

@@ -43,7 +43,7 @@
 reShapeDS <- function(data.name, varying.transmit, v.names.transmit, timevar.name, idvar.name, drop.transmit, direction, sep){
 
   # Check Permissive Privacy Control Level.
-  dsBase::checkPermissivePrivacyControlLevel(c('permissive', 'banana'))
+  dsBase::checkPermissivePrivacyControlLevel(c('permissive', 'banana', 'carrot'))
 
   datatext <- paste0("data.frame(",data.name,")")
   data <- eval(parse(text=datatext), envir = parent.frame())

R/recodeLevelsDS.R

@@ -11,7 +11,7 @@
 recodeLevelsDS <- function (x=NULL, classes=NULL){
 
   # Check Permissive Privacy Control Level.
-  dsBase::checkPermissivePrivacyControlLevel(c('permissive', 'banana'))
+  dsBase::checkPermissivePrivacyControlLevel(c('permissive', 'banana', 'carrot'))
 
   # check if the input vector is valid (i.e. meets DataSHIELD criteria)
   check <- isValidDS(x)

R/recodeValuesDS.R

@@ -31,7 +31,7 @@
 recodeValuesDS <- function(var.name.text=NULL, values2replace.text=NULL, new.values.text=NULL, missing=NULL){
 
   # Check Permissive Privacy Control Level.
-  dsBase::checkPermissivePrivacyControlLevel(c('permissive', 'banana'))
+  dsBase::checkPermissivePrivacyControlLevel(c('permissive', 'banana', 'carrot'))
 
   #############################################################
   #MODULE 1: CAPTURE THE used nfilter SETTINGS

R/scatterPlotDS.R

@@ -44,8 +44,11 @@ scatterPlotDS <- function(x, y, method.indicator, k, noise){
   ###################################################################
 
   # back-up current .Random.seed and revert on.exit
-  old_seed <- .Random.seed
-  on.exit(.Random.seed <- old_seed, add = TRUE)
+  if (exists(x = ".Random.seed", envir = globalenv())) {
+      assign(x = "old_seed", value = .Random.seed, envir = parent.frame());
+      on.exit({ assign(x = ".Random.seed", value = old_seed, envir = globalenv()); remove("old_seed", envir = parent.frame()) }, add = TRUE)
+  } else
+      on.exit(if (exists(x = ".Random.seed", envir = globalenv())) remove(".Random.seed", envir = globalenv()), add = TRUE)
 
   # Cbind the columns of the two variables and remove any rows that include NAs
   data.table <- cbind.data.frame(x, y)

R/subsetByClassDS.R

@@ -18,7 +18,7 @@
 subsetByClassDS <- function(data=NULL, variables=NULL){
 
   # Check Permissive Privacy Control Level.
-  dsBase::checkPermissivePrivacyControlLevel(c('permissive', 'banana'))
+  dsBase::checkPermissivePrivacyControlLevel(c('permissive', 'banana', 'carrot'))
 
   # this filter sets the minimum number of observations that are allowed 
 

R/subsetDS.R

@@ -30,7 +30,7 @@
 subsetDS <- function(dt=NULL, complt=NULL, rs=NULL, cs=NULL, lg=NULL, th=NULL, varname=NULL){
 
   # Check Permissive Privacy Control Level.
-  dsBase::checkPermissivePrivacyControlLevel(c('permissive', 'banana'))
+  dsBase::checkPermissivePrivacyControlLevel(c('permissive', 'banana', 'carrot'))
 
   # this filter sets the minimum number of observations that are allowed 
 

R/vectorDS.R

@@ -10,7 +10,7 @@
 #'
 vectorDS <- function(...){
     # Check Permissive Privacy Control Level.
-    dsBase::checkPermissivePrivacyControlLevel(c('permissive', 'banana'))
+    dsBase::checkPermissivePrivacyControlLevel(c('permissive', 'banana', 'carrot'))
 
     # compute the vector's value
     out <- c(...)

inst/DATASHIELD

@@ -163,7 +163,7 @@ AssignMethods:
     unlist=base::unlist
 Options:
     datashield.privacyLevel=5,
-    default.datashield.privacyControlLevel="banana",
+    default.datashield.privacyControlLevel="permissive",
     default.nfilter.glm=0.33,
     default.nfilter.kNN=3,
     default.nfilter.string=80,
@@ -172,4 +172,4 @@ Options:
     default.nfilter.tab=3,
     default.nfilter.noise=0.25,
     default.nfilter.levels.density=0.33,
-    default.nfilter.levels.max=40
+    default.nfilter.levels.max=40