diff --git a/DESCRIPTION b/DESCRIPTION index ad8e28a6..5203957a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -62,6 +62,7 @@ Depends: R (>= 4.0.0), DSI (>= 1.7.1) Imports: + cli, fields, metafor, meta, diff --git a/NAMESPACE b/NAMESPACE index 8bdab82e..bd539a11 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -119,6 +119,8 @@ export(ds.var) export(ds.vectorCalc) import(DSI) import(data.table) +importFrom(DSI,datashield.connections_find) +importFrom(cli,cli_abort) importFrom(stats,as.formula) importFrom(stats,na.omit) importFrom(stats,ts) diff --git a/R/ds.abs.R b/R/ds.abs.R index 41c20455..22c16648 100644 --- a/R/ds.abs.R +++ b/R/ds.abs.R @@ -72,41 +72,17 @@ #' ds.abs <- function(x=NULL, newobj=NULL, datasources=NULL){ - # look for DS connections - if(is.null(datasources)){ - datasources <- datashield.connections_find() - } - - # ensure datasources is a list of DSConnection-class - if(!(is.list(datasources) && all(unlist(lapply(datasources, function(d) {methods::is(d,"DSConnection")}))))){ - stop("The 'datasources' were expected to be a list of DSConnection-class objects", call.=FALSE) - } + datasources <- .set_datasources(datasources) if(is.null(x)){ stop("Please provide the name of the input object!", call.=FALSE) } - # check if the input object is defined in all the studies - isDefined(datasources, x) - - # call the internal function that checks the input object is of the same class in all studies. - typ <- checkClass(datasources, x) - - # call the internal function that checks the input object(s) is(are) of the same class in all studies. - if(!('numeric' %in% typ) && !('integer' %in% typ)){ - stop("Only objects of type 'numeric' or 'integer' are allowed.", call.=FALSE) - } - - # create a name by default if the user did not provide a name for the new variable if(is.null(newobj)){ newobj <- "abs.newobj" } - # call the server side function that does the operation cally <- call("absDS", x) DSI::datashield.assign(datasources, newobj, cally) - # check that the new object has been created and display a message accordingly - finalcheck <- isAssigned(datasources, newobj) - } diff --git a/R/ds.asCharacter.R b/R/ds.asCharacter.R index c0bd4ce0..60b9d20a 100644 --- a/R/ds.asCharacter.R +++ b/R/ds.asCharacter.R @@ -13,9 +13,7 @@ #' objects obtained after login. If the \code{datasources} argument is not specified #' the default set of connections will be used: see \code{\link[DSI]{datashield.connections_default}}. #' @return \code{ds.asCharacter} returns the object converted into a class character -#' that is written to the server-side. Also, two validity messages are returned to the client-side -#' indicating the name of the \code{newobj} which has been created in each data source and if -#' it is in a valid form. +#' that is written to the server-side. #' @examples #' \dontrun{ #' ## Version 6, for version 5 see the Wiki @@ -57,111 +55,17 @@ #' ds.asCharacter <- function(x.name=NULL, newobj=NULL, datasources=NULL){ - # look for DS connections - if(is.null(datasources)){ - datasources <- datashield.connections_find() - } - - # ensure datasources is a list of DSConnection-class - if(!(is.list(datasources) && all(unlist(lapply(datasources, function(d) {methods::is(d,"DSConnection")}))))){ - stop("The 'datasources' were expected to be a list of DSConnection-class objects", call.=FALSE) - } + datasources <- .set_datasources(datasources) if(is.null(x.name)){ stop("Please provide the name of the input vector!", call.=FALSE) } - # check if the input object is defined in all the studies - isDefined(datasources, x.name) - - # create a name by default if user did not provide a name for the new variable if(is.null(newobj)){ newobj <- "ascharacter.newobj" } - # call the server side function that does the job - calltext <- call("asCharacterDS", x.name) - DSI::datashield.assign(datasources, newobj, calltext) - -############################################################################################################# -#DataSHIELD CLIENTSIDE MODULE: CHECK KEY DATA OBJECTS SUCCESSFULLY CREATED # - # -#SET APPROPRIATE PARAMETERS FOR THIS PARTICULAR FUNCTION # -test.obj.name<-newobj # - # # - # -# CALL SEVERSIDE FUNCTION # -calltext <- call("testObjExistsDS", test.obj.name) # - # -object.info<-DSI::datashield.aggregate(datasources, calltext) # - # -# CHECK IN EACH SOURCE WHETHER OBJECT NAME EXISTS # -# AND WHETHER OBJECT PHYSICALLY EXISTS WITH A NON-NULL CLASS # -num.datasources<-length(object.info) # - # - # -obj.name.exists.in.all.sources<-TRUE # -obj.non.null.in.all.sources<-TRUE # - # -for(j in 1:num.datasources){ # - if(!object.info[[j]]$test.obj.exists){ # - obj.name.exists.in.all.sources<-FALSE # - } # - if(is.null(object.info[[j]]$test.obj.class) || ("ABSENT" %in% object.info[[j]]$test.obj.class)){ # - obj.non.null.in.all.sources<-FALSE # - } # - } # - # -if(obj.name.exists.in.all.sources && obj.non.null.in.all.sources){ # - # - return.message<- # - paste0("A data object <", test.obj.name, "> has been created in all specified data sources") # - # - # - }else{ # - # - return.message.1<- # - paste0("Error: A valid data object <", test.obj.name, "> does NOT exist in ALL specified data sources") # - # - return.message.2<- # - paste0("It is either ABSENT and/or has no valid content/class,see return.info above") # - # - return.message.3<- # - paste0("Please use ds.ls() to identify where missing") # - # - # - return.message<-list(return.message.1,return.message.2,return.message.3) # - # - } # - # - calltext <- call("messageDS", test.obj.name) # - studyside.message<-DSI::datashield.aggregate(datasources, calltext) # - # - no.errors<-TRUE # - for(nd in 1:num.datasources){ # - if(studyside.message[[nd]]!="ALL OK: there are no studysideMessage(s) on this datasource"){ # - no.errors<-FALSE # - } # - } # - # - # - if(no.errors){ # - validity.check<-paste0("<",test.obj.name, "> appears valid in all sources") # - return(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:") # - return(list(is.object.created=return.message,validity.check=validity.check, # - studyside.messages=studyside.message)) # - } # - # -#END OF CHECK OBJECT CREATED CORECTLY MODULE # -############################################################################################################# - - } -# ds.asCharacter diff --git a/R/ds.asDataMatrix.R b/R/ds.asDataMatrix.R index 7b4833bb..d705dc95 100644 --- a/R/ds.asDataMatrix.R +++ b/R/ds.asDataMatrix.R @@ -12,11 +12,7 @@ #' objects obtained after login. If the \code{datasources} argument is not specified #' the default set of connections will be used: see \code{\link[DSI]{datashield.connections_default}}. #' @return \code{ds.asDataMatrix} returns the object converted into a matrix -#' that is written to the server-side. Also, two validity messages are returned -#' to the client-side -#' indicating the name of the \code{newobj} which -#' has been created in each data source and if -#' it is in a valid form. +#' that is written to the server-side. #' @examples #' \dontrun{ #' ## Version 6, for version 5 see the Wiki @@ -58,109 +54,17 @@ #' ds.asDataMatrix <- function(x.name=NULL, newobj=NULL, datasources=NULL){ - # look for DS connections - if(is.null(datasources)){ - datasources <- datashield.connections_find() - } - - # ensure datasources is a list of DSConnection-class - if(!(is.list(datasources) && all(unlist(lapply(datasources, function(d) {methods::is(d,"DSConnection")}))))){ - stop("The 'datasources' were expected to be a list of DSConnection-class objects", call.=FALSE) - } + datasources <- .set_datasources(datasources) if(is.null(x.name)){ stop("Please provide the name of the input vector!", call.=FALSE) } - # check if the input object is defined in all the studies - isDefined(datasources, x.name) - - # create a name by default if user did not provide a name for the new variable if(is.null(newobj)){ newobj <- "asdatamatrix.newobj" } - # call the server side function that does the job calltext <- call("asDataMatrixDS", x.name) DSI::datashield.assign(datasources, newobj, calltext) - -############################################################################################################# -#DataSHIELD CLIENTSIDE MODULE: CHECK KEY DATA OBJECTS SUCCESSFULLY CREATED # - # -#SET APPROPRIATE PARAMETERS FOR THIS PARTICULAR FUNCTION # -test.obj.name<-newobj # - # # - # -# CALL SEVERSIDE FUNCTION # -calltext <- call("testObjExistsDS", test.obj.name) # - # -object.info<-DSI::datashield.aggregate(datasources, calltext) # - # -# CHECK IN EACH SOURCE WHETHER OBJECT NAME EXISTS # -# AND WHETHER OBJECT PHYSICALLY EXISTS WITH A NON-NULL CLASS # -num.datasources<-length(object.info) # - # - # -obj.name.exists.in.all.sources<-TRUE # -obj.non.null.in.all.sources<-TRUE # - # -for(j in 1:num.datasources){ # - if(!object.info[[j]]$test.obj.exists){ # - obj.name.exists.in.all.sources<-FALSE # - } # - if(is.null(object.info[[j]]$test.obj.class) || ("ABSENT" %in% object.info[[j]]$test.obj.class)){ # - obj.non.null.in.all.sources<-FALSE # - } # - } # - # -if(obj.name.exists.in.all.sources && obj.non.null.in.all.sources){ # - # - return.message<- # - paste0("A data object <", test.obj.name, "> has been created in all specified data sources") # - # - # - }else{ # - # - return.message.1<- # - paste0("Error: A valid data object <", test.obj.name, "> does NOT exist in ALL specified data sources") # - # - return.message.2<- # - paste0("It is either ABSENT and/or has no valid content/class,see return.info above") # - # - return.message.3<- # - paste0("Please use ds.ls() to identify where missing") # - # - # - return.message<-list(return.message.1,return.message.2,return.message.3) # - # - } # - # - calltext <- call("messageDS", test.obj.name) # - studyside.message<-DSI::datashield.aggregate(datasources, calltext) # - # - no.errors<-TRUE # - for(nd in 1:num.datasources){ # - if(studyside.message[[nd]]!="ALL OK: there are no studysideMessage(s) on this datasource"){ # - no.errors<-FALSE # - } # - } # - # - # - if(no.errors){ # - validity.check<-paste0("<",test.obj.name, "> appears valid in all sources") # - return(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:") # - return(list(is.object.created=return.message,validity.check=validity.check, # - studyside.messages=studyside.message)) # - } # - # -#END OF CHECK OBJECT CREATED CORECTLY MODULE # -############################################################################################################# - - } -# ds.asDataMatrix diff --git a/R/ds.asInteger.R b/R/ds.asInteger.R index 9b3b1a39..da5117aa 100644 --- a/R/ds.asInteger.R +++ b/R/ds.asInteger.R @@ -26,10 +26,7 @@ #' objects obtained after login. If the \code{datasources} argument is not specified #' the default set of connections will be used: see \code{\link[DSI]{datashield.connections_default}}. #' @return \code{ds.asInteger} returns the R object converted into an integer -#' that is written to the server-side. Also, two validity messages are returned to the -#' client-side indicating the name of the \code{newobj} which -#' has been created in each data source and if -#' it is in a valid form. +#' that is written to the server-side. #' @examples #' \dontrun{ #' ## Version 6, for version 5 see the Wiki @@ -71,106 +68,17 @@ #' @export ds.asInteger <- function(x.name=NULL, newobj=NULL, datasources=NULL){ - # look for DS connections - if(is.null(datasources)){ - datasources <- datashield.connections_find() - } - - # ensure datasources is a list of DSConnection-class - if(!(is.list(datasources) && all(unlist(lapply(datasources, function(d) {methods::is(d,"DSConnection")}))))){ - stop("The 'datasources' were expected to be a list of DSConnection-class objects", call.=FALSE) - } + datasources <- .set_datasources(datasources) if(is.null(x.name)){ stop("Please provide the name of the input vector!", call.=FALSE) } - # check if the input object is defined in all the studies - isDefined(datasources, x.name) - - # create a name by default if user did not provide a name for the new variable if(is.null(newobj)){ newobj <- "asinteger.newobj" } - # call the server side function that does the job calltext <- call("asIntegerDS", x.name) DSI::datashield.assign(datasources, newobj, calltext) -############################################################################################################# -#DataSHIELD CLIENTSIDE MODULE: CHECK KEY DATA OBJECTS SUCCESSFULLY CREATED # - # -#SET APPROPRIATE PARAMETERS FOR THIS PARTICULAR FUNCTION # -test.obj.name<-newobj # - # # # -# CALL SEVERSIDE FUNCTION # -calltext <- call("testObjExistsDS", test.obj.name) # - # -object.info<-DSI::datashield.aggregate(datasources, calltext) # - # -# CHECK IN EACH SOURCE WHETHER OBJECT NAME EXISTS # -# AND WHETHER OBJECT PHYSICALLY EXISTS WITH A NON-NULL CLASS # -num.datasources<-length(object.info) # - # - # -obj.name.exists.in.all.sources<-TRUE # -obj.non.null.in.all.sources<-TRUE # - # -for(j in 1:num.datasources){ # - if(!object.info[[j]]$test.obj.exists){ # - obj.name.exists.in.all.sources<-FALSE # - } # - if(is.null(object.info[[j]]$test.obj.class) || ("ABSENT" %in% object.info[[j]]$test.obj.class)){ # - obj.non.null.in.all.sources<-FALSE # - } # - } # - # -if(obj.name.exists.in.all.sources && obj.non.null.in.all.sources){ # - # - return.message<- # - paste0("A data object <", test.obj.name, "> has been created in all specified data sources") # - # - # - }else{ # - # - return.message.1<- # - paste0("Error: A valid data object <", test.obj.name, "> does NOT exist in ALL specified data sources") # - # - return.message.2<- # - paste0("It is either ABSENT and/or has no valid content/class,see return.info above") # - # - return.message.3<- # - paste0("Please use ds.ls() to identify where missing") # - # - # - return.message<-list(return.message.1,return.message.2,return.message.3) # - # - } # - # - calltext <- call("messageDS", test.obj.name) # - studyside.message<-DSI::datashield.aggregate(datasources, calltext) # - # - no.errors<-TRUE # - for(nd in 1:num.datasources){ # - if(studyside.message[[nd]]!="ALL OK: there are no studysideMessage(s) on this datasource"){ # - no.errors<-FALSE # - } # - } # - # - # - if(no.errors){ # - validity.check<-paste0("<",test.obj.name, "> appears valid in all sources") # - return(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:") # - return(list(is.object.created=return.message,validity.check=validity.check, # - studyside.messages=studyside.message)) # - } # - # -#END OF CHECK OBJECT CREATED CORECTLY MODULE # -############################################################################################################# - } -# ds.asInteger diff --git a/R/ds.asList.R b/R/ds.asList.R index d7366878..5c869d34 100644 --- a/R/ds.asList.R +++ b/R/ds.asList.R @@ -13,9 +13,7 @@ #' objects obtained after login. If the \code{datasources} argument is not specified #' the default set of connections will be used: see \code{\link[DSI]{datashield.connections_default}}. #' @return \code{ds.asList} returns the R object converted into a list -#' which is written to the server-side. Also, two validity messages are returned to the -#' client-side indicating the name of the \code{newobj} which has been created in each data -#' source and if it is in a valid form. +#' which is written to the server-side. #' @examples #' \dontrun{ #' ## Version 6, for version 5 see the Wiki @@ -58,37 +56,17 @@ #' ds.asList <- function(x.name=NULL, newobj=NULL, datasources=NULL){ - # look for DS connections - if(is.null(datasources)){ - datasources <- datashield.connections_find() - } - - # ensure datasources is a list of DSConnection-class - if(!(is.list(datasources) && all(unlist(lapply(datasources, function(d) {methods::is(d,"DSConnection")}))))){ - stop("The 'datasources' were expected to be a list of DSConnection-class objects", call.=FALSE) - } + datasources <- .set_datasources(datasources) if(is.null(x.name)){ stop("Please provide the name of the input vector!", call.=FALSE) } - # check if the input object is defined in all the studies - isDefined(datasources, x.name) - - # create a name by default if user did not provide a name for the new variable if(is.null(newobj)){ newobj <- "aslist.newobj" } - # call the server side function that does the job - calltext <- call("asListDS", x.name, newobj) - out.message <- DSI::datashield.aggregate(datasources, calltext) -# print(out.message) - -#Don't include assign function completion module as it can print out an unhelpful -#warning message when newobj is a list } -# ds.asList diff --git a/R/ds.asLogical.R b/R/ds.asLogical.R index 2ddc33cf..ca3fec8c 100644 --- a/R/ds.asLogical.R +++ b/R/ds.asLogical.R @@ -12,10 +12,7 @@ #' objects obtained after login. If the \code{datasources} argument is not specified #' the default set of connections will be used: see \code{\link[DSI]{datashield.connections_default}}. #' @return \code{ds.asLogical} returns the R object converted into a logical -#' that is written to the server-side. Also, two validity messages are returned -#' to the client-side indicating the name of the \code{newobj} which -#' has been created in each data source and if -#' it is in a valid form. +#' that is written to the server-side. #' @examples #' \dontrun{ #' ## Version 6, for version 5 see the Wiki @@ -58,109 +55,17 @@ #' ds.asLogical <- function(x.name=NULL, newobj=NULL, datasources=NULL){ - # look for DS connections - if(is.null(datasources)){ - datasources <- datashield.connections_find() - } - - # ensure datasources is a list of DSConnection-class - if(!(is.list(datasources) && all(unlist(lapply(datasources, function(d) {methods::is(d,"DSConnection")}))))){ - stop("The 'datasources' were expected to be a list of DSConnection-class objects", call.=FALSE) - } + datasources <- .set_datasources(datasources) if(is.null(x.name)){ stop("Please provide the name of the input vector!", call.=FALSE) } - # check if the input object is defined in all the studies - isDefined(datasources, x.name) - - # create a name by default if user did not provide a name for the new variable if(is.null(newobj)){ newobj <- "aslogical.newobj" } - # call the server side function that does the job calltext <- call("asLogicalDS", x.name) DSI::datashield.assign(datasources, newobj, calltext) - -############################################################################################################# -#DataSHIELD CLIENTSIDE MODULE: CHECK KEY DATA OBJECTS SUCCESSFULLY CREATED # - # -#SET APPROPRIATE PARAMETERS FOR THIS PARTICULAR FUNCTION # -test.obj.name<-newobj # - # # - # -# CALL SEVERSIDE FUNCTION # -calltext <- call("testObjExistsDS", test.obj.name) # - # -object.info<-DSI::datashield.aggregate(datasources, calltext) # - # -# CHECK IN EACH SOURCE WHETHER OBJECT NAME EXISTS # -# AND WHETHER OBJECT PHYSICALLY EXISTS WITH A NON-NULL CLASS # -num.datasources<-length(object.info) # - # - # -obj.name.exists.in.all.sources<-TRUE # -obj.non.null.in.all.sources<-TRUE # - # -for(j in 1:num.datasources){ # - if(!object.info[[j]]$test.obj.exists){ # - obj.name.exists.in.all.sources<-FALSE # - } # - if(is.null(object.info[[j]]$test.obj.class) || ("ABSENT" %in% object.info[[j]]$test.obj.class)){ # - obj.non.null.in.all.sources<-FALSE # - } # - } # - # -if(obj.name.exists.in.all.sources && obj.non.null.in.all.sources){ # - # - return.message<- # - paste0("A data object <", test.obj.name, "> has been created in all specified data sources") # - # - # - }else{ # - # - return.message.1<- # - paste0("Error: A valid data object <", test.obj.name, "> does NOT exist in ALL specified data sources") # - # - return.message.2<- # - paste0("It is either ABSENT and/or has no valid content/class,see return.info above") # - # - return.message.3<- # - paste0("Please use ds.ls() to identify where missing") # - # - # - return.message<-list(return.message.1,return.message.2,return.message.3) # - # - } # - # - calltext <- call("messageDS", test.obj.name) # - studyside.message<-DSI::datashield.aggregate(datasources, calltext) # - # - no.errors<-TRUE # - for(nd in 1:num.datasources){ # - if(studyside.message[[nd]]!="ALL OK: there are no studysideMessage(s) on this datasource"){ # - no.errors<-FALSE # - } # - } # - # - # - if(no.errors){ # - validity.check<-paste0("<",test.obj.name, "> appears valid in all sources") # - return(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:") # - return(list(is.object.created=return.message,validity.check=validity.check, # - studyside.messages=studyside.message)) # - } # - # -#END OF CHECK OBJECT CREATED CORECTLY MODULE # -############################################################################################################# - - } -# ds.asLogical diff --git a/R/ds.asMatrix.R b/R/ds.asMatrix.R index 1c5b0ced..0adcb969 100644 --- a/R/ds.asMatrix.R +++ b/R/ds.asMatrix.R @@ -15,9 +15,7 @@ #' objects obtained after login. If the \code{datasources} argument is not specified #' the default set of connections will be used: see \code{\link[DSI]{datashield.connections_default}}. #' @return \code{ds.asMatrix} returns the object converted into a matrix -#' that is written to the server-side. Also, two validity messages are returned -#' to the client-side indicating the name of the \code{newobj} which -#' has been created in each data source and if it is in a valid form. +#' that is written to the server-side. #' @examples #' \dontrun{ #' ## Version 6, for version 5 see the Wiki @@ -59,109 +57,17 @@ #' ds.asMatrix <- function(x.name=NULL, newobj=NULL, datasources=NULL){ - # look for DS connections - if(is.null(datasources)){ - datasources <- datashield.connections_find() - } - - # ensure datasources is a list of DSConnection-class - if(!(is.list(datasources) && all(unlist(lapply(datasources, function(d) {methods::is(d,"DSConnection")}))))){ - stop("The 'datasources' were expected to be a list of DSConnection-class objects", call.=FALSE) - } + datasources <- .set_datasources(datasources) if(is.null(x.name)){ stop("Please provide the name of the input vector!", call.=FALSE) } - # check if the input object is defined in all the studies - isDefined(datasources, x.name) - - # create a name by default if user did not provide a name for the new variable if(is.null(newobj)){ newobj <- "asmatrix.newobj" } - # call the server side function that does the job calltext <- call("asMatrixDS", x.name) DSI::datashield.assign(datasources, newobj, calltext) - -############################################################################################################# -#DataSHIELD CLIENTSIDE MODULE: CHECK KEY DATA OBJECTS SUCCESSFULLY CREATED # - # -#SET APPROPRIATE PARAMETERS FOR THIS PARTICULAR FUNCTION # -test.obj.name<-newobj # - # # - # -# CALL SEVERSIDE FUNCTION # -calltext <- call("testObjExistsDS", test.obj.name) # - # -object.info<-DSI::datashield.aggregate(datasources, calltext) # - # -# CHECK IN EACH SOURCE WHETHER OBJECT NAME EXISTS # -# AND WHETHER OBJECT PHYSICALLY EXISTS WITH A NON-NULL CLASS # -num.datasources<-length(object.info) # - # - # -obj.name.exists.in.all.sources<-TRUE # -obj.non.null.in.all.sources<-TRUE # - # -for(j in 1:num.datasources){ # - if(!object.info[[j]]$test.obj.exists){ # - obj.name.exists.in.all.sources<-FALSE # - } # - if(is.null(object.info[[j]]$test.obj.class) || ("ABSENT" %in% object.info[[j]]$test.obj.class)){ # - obj.non.null.in.all.sources<-FALSE # - } # - } # - # -if(obj.name.exists.in.all.sources && obj.non.null.in.all.sources){ # - # - return.message<- # - paste0("A data object <", test.obj.name, "> has been created in all specified data sources") # - # - # - }else{ # - # - return.message.1<- # - paste0("Error: A valid data object <", test.obj.name, "> does NOT exist in ALL specified data sources") # - # - return.message.2<- # - paste0("It is either ABSENT and/or has no valid content/class,see return.info above") # - # - return.message.3<- # - paste0("Please use ds.ls() to identify where missing") # - # - # - return.message<-list(return.message.1,return.message.2,return.message.3) # - # - } # - # - calltext <- call("messageDS", test.obj.name) # - studyside.message<-DSI::datashield.aggregate(datasources, calltext) # - # - no.errors<-TRUE # - for(nd in 1:num.datasources){ # - if(studyside.message[[nd]]!="ALL OK: there are no studysideMessage(s) on this datasource"){ # - no.errors<-FALSE # - } # - } # - # - # - if(no.errors){ # - validity.check<-paste0("<",test.obj.name, "> appears valid in all sources") # - return(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:") # - return(list(is.object.created=return.message,validity.check=validity.check, # - studyside.messages=studyside.message)) # - } # - # -#END OF CHECK OBJECT CREATED CORECTLY MODULE # -############################################################################################################# - - } -# ds.asMatrix diff --git a/R/ds.asNumeric.R b/R/ds.asNumeric.R index 3e2b445f..2067bb53 100644 --- a/R/ds.asNumeric.R +++ b/R/ds.asNumeric.R @@ -26,10 +26,7 @@ #' objects obtained after login. If the \code{datasources} argument is not specified #' the default set of connections will be used: see \code{\link[DSI]{datashield.connections_default}}. #' @return \code{ds.asNumeric} returns the R object converted into a numeric class -#' that is written to the server-side. Also, two validity messages are returned -#' to the client-side indicating the name of the \code{newobj} which -#' has been created in each data source and if -#' it is in a valid form. +#' that is written to the server-side. #' @examples #' \dontrun{ #' ## Version 6, for version 5 see the Wiki @@ -72,108 +69,17 @@ #' ds.asNumeric <- function(x.name=NULL, newobj=NULL, datasources=NULL){ - # look for DS connections - if(is.null(datasources)){ - datasources <- datashield.connections_find() - } - - # ensure datasources is a list of DSConnection-class - if(!(is.list(datasources) && all(unlist(lapply(datasources, function(d) {methods::is(d,"DSConnection")}))))){ - stop("The 'datasources' were expected to be a list of DSConnection-class objects", call.=FALSE) - } + datasources <- .set_datasources(datasources) if(is.null(x.name)){ stop("Please provide the name of the input vector!", call.=FALSE) } - # check if the input object is defined in all the studies - isDefined(datasources, x.name) - - # create a name by default if user did not provide a name for the new variable if(is.null(newobj)){ newobj <- "asnumeric.newobj" } - # call the server side function that does the job calltext <- call("asNumericDS", x.name) DSI::datashield.assign(datasources, newobj, calltext) - -############################################################################################################# -#DataSHIELD CLIENTSIDE MODULE: CHECK KEY DATA OBJECTS SUCCESSFULLY CREATED # - # -#SET APPROPRIATE PARAMETERS FOR THIS PARTICULAR FUNCTION # -test.obj.name<-newobj # - # # - # -# CALL SEVERSIDE FUNCTION # -calltext <- call("testObjExistsDS", test.obj.name) # - # -object.info<-DSI::datashield.aggregate(datasources, calltext) # - # -# CHECK IN EACH SOURCE WHETHER OBJECT NAME EXISTS # -# AND WHETHER OBJECT PHYSICALLY EXISTS WITH A NON-NULL CLASS # -num.datasources<-length(object.info) # - # - # -obj.name.exists.in.all.sources<-TRUE # -obj.non.null.in.all.sources<-TRUE # - # -for(j in 1:num.datasources){ # - if(!object.info[[j]]$test.obj.exists){ # - obj.name.exists.in.all.sources<-FALSE # - } # - if(is.null(object.info[[j]]$test.obj.class) || ("ABSENT" %in% object.info[[j]]$test.obj.class)){ # - obj.non.null.in.all.sources<-FALSE # - } # - } # - # -if(obj.name.exists.in.all.sources && obj.non.null.in.all.sources){ # - # - return.message<- # - paste0("A data object <", test.obj.name, "> has been created in all specified data sources") # - # - # - }else{ # - # - return.message.1<- # - paste0("Error: A valid data object <", test.obj.name, "> does NOT exist in ALL specified data sources") # - # - return.message.2<- # - paste0("It is either ABSENT and/or has no valid content/class,see return.info above") # - # - return.message.3<- # - paste0("Please use ds.ls() to identify where missing") # - # - # - return.message<-list(return.message.1,return.message.2,return.message.3) # - # - } # - # - calltext <- call("messageDS", test.obj.name) # - studyside.message<-DSI::datashield.aggregate(datasources, calltext) # - # - no.errors<-TRUE # - for(nd in 1:num.datasources){ # - if(studyside.message[[nd]]!="ALL OK: there are no studysideMessage(s) on this datasource"){ # - no.errors<-FALSE # - } # - } # - # - # - if(no.errors){ # - validity.check<-paste0("<",test.obj.name, "> appears valid in all sources") # - return(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:") # - return(list(is.object.created=return.message,validity.check=validity.check, # - studyside.messages=studyside.message)) # - } # - # -#END OF CHECK OBJECT CREATED CORECTLY MODULE # -############################################################################################################# - } -# ds.asNumeric diff --git a/R/ds.exp.R b/R/ds.exp.R index 5bf325bd..03454aed 100644 --- a/R/ds.exp.R +++ b/R/ds.exp.R @@ -4,7 +4,7 @@ #' This function is similar to R function \code{exp}. #' @details #' -#' Server function called: \code{exp}. +#' Server function called: \code{expDS}. #' #' @param x a character string providing the name of a numerical vector. #' @param newobj a character string that provides the name for the output variable @@ -57,42 +57,17 @@ #' ds.exp <- function(x=NULL, newobj=NULL, datasources=NULL){ - # look for DS connections - if(is.null(datasources)){ - datasources <- datashield.connections_find() - } - - # ensure datasources is a list of DSConnection-class - if(!(is.list(datasources) && all(unlist(lapply(datasources, function(d) {methods::is(d,"DSConnection")}))))){ - stop("The 'datasources' were expected to be a list of DSConnection-class objects", call.=FALSE) - } + datasources <- .set_datasources(datasources) if(is.null(x)){ stop("Please provide the name of the input object!", call.=FALSE) } - # check if the input object is defined in all the studies - isDefined(datasources, x) - - # call the internal function that checks the input object is of the same class in all studies. - typ <- checkClass(datasources, x) - - # call the internal function that checks the input object(s) is(are) of the same class in all studies. - if(!('numeric' %in% typ) && !('integer' %in% typ)){ - stop(" Only objects of type 'numeric' and 'integer' are allowed.", call.=FALSE) - } - - # create a name by default if user did not provide a name for the new variable if(is.null(newobj)){ newobj <- "exp.newobj" } - # call the server side function that does the job - cally <- paste0('exp(', x, ')') - DSI::datashield.assign(datasources, newobj, as.symbol(cally)) - - - # check that the new object has been created and display a message accordingly - finalcheck <- isAssigned(datasources, newobj) + cally <- call("expDS", x) + DSI::datashield.assign(datasources, newobj, cally) } diff --git a/R/ds.log.R b/R/ds.log.R index 8c0b2e5d..4e5b13f3 100644 --- a/R/ds.log.R +++ b/R/ds.log.R @@ -2,7 +2,7 @@ #' @title Computes logarithms in the server-side #' @description Computes the logarithms for a specified numeric vector. #' This function is similar to the R \code{log} function. by default natural logarithms. -#' @details Server function called: \code{log} +#' @details Server function called: \code{logDS} #' @param x a character string providing the name of a numerical vector. #' @param base a positive number, the base for which logarithms are computed. #' Default \code{exp(1)}. @@ -57,42 +57,17 @@ #' ds.log <- function(x=NULL, base=exp(1), newobj=NULL, datasources=NULL){ - # look for DS connections - if(is.null(datasources)){ - datasources <- datashield.connections_find() - } - - # ensure datasources is a list of DSConnection-class - if(!(is.list(datasources) && all(unlist(lapply(datasources, function(d) {methods::is(d,"DSConnection")}))))){ - stop("The 'datasources' were expected to be a list of DSConnection-class objects", call.=FALSE) - } + datasources <- .set_datasources(datasources) if(is.null(x)){ stop("Please provide the name of the input vector!", call.=FALSE) } - # check if the input object is defined in all the studies - isDefined(datasources, x) - - # call the internal function that checks the input object is of the same class in all studies. - typ <- checkClass(datasources, x) - - # the input object must be a vector - if(!('integer' %in% typ) & !('numeric' %in% typ)){ - message(paste0(x, " is of type ", typ, "!")) - stop("The input object must be an integer or numeric vector.", call.=FALSE) - } - - # create a name by default if user did not provide a name for the new variable if(is.null(newobj)){ newobj <- "log.newobj" } - # call the server side function that does the job - cally <- paste0("log(", x, ",", base, ")") - DSI::datashield.assign(datasources, newobj, as.symbol(cally)) - - # check that the new object has been created and display a message accordingly - finalcheck <- isAssigned(datasources, newobj) + cally <- call("logDS", x, base) + DSI::datashield.assign(datasources, newobj, cally) } diff --git a/R/ds.sqrt.R b/R/ds.sqrt.R index e78011de..0f37fb6e 100644 --- a/R/ds.sqrt.R +++ b/R/ds.sqrt.R @@ -70,41 +70,17 @@ #' ds.sqrt <- function(x=NULL, newobj=NULL, datasources=NULL){ - # look for DS connections - if(is.null(datasources)){ - datasources <- datashield.connections_find() - } - - # ensure datasources is a list of DSConnection-class - if(!(is.list(datasources) && all(unlist(lapply(datasources, function(d) {methods::is(d,"DSConnection")}))))){ - stop("The 'datasources' were expected to be a list of DSConnection-class objects", call.=FALSE) - } + datasources <- .set_datasources(datasources) if(is.null(x)){ stop("Please provide the name of the input object!", call.=FALSE) } - # check if the input object is defined in all the studies - isDefined(datasources, x) - - # call the internal function that checks the input object is of the same class in all studies. - typ <- checkClass(datasources, x) - - # call the internal function that checks the input object(s) is(are) of the same class in all studies. - if(!('numeric' %in% typ) && !('integer' %in% typ)){ - stop("Only objects of type 'numeric' or 'integer' are allowed.", call.=FALSE) - } - - # create a name by default if the user did not provide a name for the new variable if(is.null(newobj)){ newobj <- "sqrt.newobj" } - # call the server side function that does the operation cally <- call("sqrtDS", x) DSI::datashield.assign(datasources, newobj, cally) - # check that the new object has been created and display a message accordingly - finalcheck <- isAssigned(datasources, newobj) - } diff --git a/R/utils.R b/R/utils.R new file mode 100644 index 00000000..85d8d7e2 --- /dev/null +++ b/R/utils.R @@ -0,0 +1,51 @@ +#' Retrieve datasources if not specified +#' +#' @param datasources An optional list of data sources. If not provided, the function will attempt +#' to find available data sources. +#' @importFrom DSI datashield.connections_find +#' @return A list of data sources. +#' @noRd +.get_datasources <- function(datasources) { + if (is.null(datasources)) { + datasources <- datashield.connections_find() + } + return(datasources) +} + +#' Verify that the provided data sources are of class 'DSConnection'. +#' +#' @param datasources A list of data sources. +#' @importFrom cli cli_abort +#' @noRd +.verify_datasources <- function(datasources) { + is_connection_class <- sapply(datasources, function(x) inherits(unlist(x), "DSConnection")) + if (!all(is_connection_class)) { + cli_abort("The 'datasources' were expected to be a list of DSConnection-class objects") + } +} + +#' Set and verify data sources. +#' +#' @param datasources An optional list of data sources. If not provided, the function will attempt +#' to find available data sources. +#' @return A list of verified data sources. +#' @noRd +.set_datasources <- function(datasources) { + datasources <- .get_datasources(datasources) + .verify_datasources(datasources) + return(datasources) +} + +#' Check That a Data Frame Name Is Provided +#' +#' Internal helper that checks whether a data frame or matrix object +#' has been provided. If `NULL`, it aborts with a user-friendly error. +#' +#' @param df A data.frame or matrix. +#' @return Invisibly returns `NULL`. Called for its side effect (error checking). +#' @noRd +.check_df_name_provided <- function(df) { + if(is.null(df)){ + cli_abort("Please provide the name of a data.frame or matrix!", call.=FALSE) + } +} diff --git a/man/ds.asCharacter.Rd b/man/ds.asCharacter.Rd index 447d9cf9..29ceabe0 100644 --- a/man/ds.asCharacter.Rd +++ b/man/ds.asCharacter.Rd @@ -19,9 +19,7 @@ the default set of connections will be used: see \code{\link[DSI]{datashield.con } \value{ \code{ds.asCharacter} returns the object converted into a class character -that is written to the server-side. Also, two validity messages are returned to the client-side -indicating the name of the \code{newobj} which has been created in each data source and if -it is in a valid form. +that is written to the server-side. } \description{ Converts the input object into a character class. diff --git a/man/ds.asDataMatrix.Rd b/man/ds.asDataMatrix.Rd index e6ea9eb9..7cc1206c 100644 --- a/man/ds.asDataMatrix.Rd +++ b/man/ds.asDataMatrix.Rd @@ -19,11 +19,7 @@ the default set of connections will be used: see \code{\link[DSI]{datashield.con } \value{ \code{ds.asDataMatrix} returns the object converted into a matrix -that is written to the server-side. Also, two validity messages are returned -to the client-side -indicating the name of the \code{newobj} which -has been created in each data source and if -it is in a valid form. +that is written to the server-side. } \description{ Coerces an R object into a matrix maintaining original diff --git a/man/ds.asInteger.Rd b/man/ds.asInteger.Rd index d2f0455b..d8c696db 100644 --- a/man/ds.asInteger.Rd +++ b/man/ds.asInteger.Rd @@ -19,10 +19,7 @@ the default set of connections will be used: see \code{\link[DSI]{datashield.con } \value{ \code{ds.asInteger} returns the R object converted into an integer -that is written to the server-side. Also, two validity messages are returned to the -client-side indicating the name of the \code{newobj} which -has been created in each data source and if -it is in a valid form. +that is written to the server-side. } \description{ Coerces an R object into an integer class. diff --git a/man/ds.asList.Rd b/man/ds.asList.Rd index 1e2e3c73..1b96bb02 100644 --- a/man/ds.asList.Rd +++ b/man/ds.asList.Rd @@ -19,9 +19,7 @@ the default set of connections will be used: see \code{\link[DSI]{datashield.con } \value{ \code{ds.asList} returns the R object converted into a list -which is written to the server-side. Also, two validity messages are returned to the -client-side indicating the name of the \code{newobj} which has been created in each data -source and if it is in a valid form. +which is written to the server-side. } \description{ Coerces an R object into a list. diff --git a/man/ds.asLogical.Rd b/man/ds.asLogical.Rd index c42d2e6a..8b277f51 100644 --- a/man/ds.asLogical.Rd +++ b/man/ds.asLogical.Rd @@ -19,10 +19,7 @@ the default set of connections will be used: see \code{\link[DSI]{datashield.con } \value{ \code{ds.asLogical} returns the R object converted into a logical -that is written to the server-side. Also, two validity messages are returned -to the client-side indicating the name of the \code{newobj} which -has been created in each data source and if -it is in a valid form. +that is written to the server-side. } \description{ Coerces an R object into a logical class. diff --git a/man/ds.asMatrix.Rd b/man/ds.asMatrix.Rd index 70948014..e68d9703 100644 --- a/man/ds.asMatrix.Rd +++ b/man/ds.asMatrix.Rd @@ -19,9 +19,7 @@ the default set of connections will be used: see \code{\link[DSI]{datashield.con } \value{ \code{ds.asMatrix} returns the object converted into a matrix -that is written to the server-side. Also, two validity messages are returned -to the client-side indicating the name of the \code{newobj} which -has been created in each data source and if it is in a valid form. +that is written to the server-side. } \description{ Coerces an R object into a matrix. diff --git a/man/ds.asNumeric.Rd b/man/ds.asNumeric.Rd index 9928942a..6e948d36 100644 --- a/man/ds.asNumeric.Rd +++ b/man/ds.asNumeric.Rd @@ -19,10 +19,7 @@ the default set of connections will be used: see \code{\link[DSI]{datashield.con } \value{ \code{ds.asNumeric} returns the R object converted into a numeric class -that is written to the server-side. Also, two validity messages are returned -to the client-side indicating the name of the \code{newobj} which -has been created in each data source and if -it is in a valid form. +that is written to the server-side. } \description{ Coerces an R object into a numeric class. diff --git a/man/ds.exp.Rd b/man/ds.exp.Rd index 875dbe00..97ba1567 100644 --- a/man/ds.exp.Rd +++ b/man/ds.exp.Rd @@ -25,7 +25,7 @@ Computes the exponential values for a specified numeric vector. This function is similar to R function \code{exp}. } \details{ -Server function called: \code{exp}. +Server function called: \code{expDS}. } \examples{ \dontrun{ diff --git a/man/ds.log.Rd b/man/ds.log.Rd index 6ab8fee7..661954cd 100644 --- a/man/ds.log.Rd +++ b/man/ds.log.Rd @@ -28,7 +28,7 @@ Computes the logarithms for a specified numeric vector. This function is similar to the R \code{log} function. by default natural logarithms. } \details{ -Server function called: \code{log} +Server function called: \code{logDS} } \examples{ \dontrun{ diff --git a/tests/testthat/test-smk-ds.asCharacter.R b/tests/testthat/test-smk-ds.asCharacter.R index ae8b7e60..07d633b6 100644 --- a/tests/testthat/test-smk-ds.asCharacter.R +++ b/tests/testthat/test-smk-ds.asCharacter.R @@ -27,11 +27,12 @@ test_that("setup", { # context("ds.asCharacter::smk::simple test") test_that("simple test", { - res <- ds.asCharacter("D$LAB_TSC") + ds.asCharacter("D$LAB_TSC") - expect_equal(length(res), 2) - expect_equal(res$is.object.created, "A data object has been created in all specified data sources") - expect_equal(res$validity.check, " appears valid in all sources") + res.class <- ds.class("ascharacter.newobj") + expect_equal(res.class$sim1, "character") + expect_equal(res.class$sim2, "character") + expect_equal(res.class$sim3, "character") }) # diff --git a/tests/testthat/test-smk-ds.asDataMatrix.R b/tests/testthat/test-smk-ds.asDataMatrix.R index 25ef3736..4f421725 100644 --- a/tests/testthat/test-smk-ds.asDataMatrix.R +++ b/tests/testthat/test-smk-ds.asDataMatrix.R @@ -27,11 +27,7 @@ test_that("setup", { # context("ds.asDataMatrix::smk::simple test") test_that("simple test", { - res <- ds.asDataMatrix(x.name="D$GENDER") - - expect_length(res, 2) - expect_equal(res$is.object.created, "A data object has been created in all specified data sources") - expect_equal(res$validity.check, " appears valid in all sources") + ds.asDataMatrix(x.name="D$GENDER") res.class <- ds.class("asdatamatrix.newobj") expect_length(res.class, 3) diff --git a/tests/testthat/test-smk-ds.asInteger.R b/tests/testthat/test-smk-ds.asInteger.R index 1ef25fbf..0045cb80 100644 --- a/tests/testthat/test-smk-ds.asInteger.R +++ b/tests/testthat/test-smk-ds.asInteger.R @@ -27,11 +27,12 @@ test_that("setup", { # context("ds.asInteger::smk::simple test") test_that("simple test", { - res <- ds.asInteger("D$GENDER") + ds.asInteger("D$GENDER") - expect_equal(length(res), 2) - expect_equal(res$is.object.created, "A data object has been created in all specified data sources") - expect_equal(res$validity.check, " appears valid in all sources") + res.class <- ds.class("asinteger.newobj") + expect_equal(res.class$sim1, "integer") + expect_equal(res.class$sim2, "integer") + expect_equal(res.class$sim3, "integer") }) # diff --git a/tests/testthat/test-smk-ds.asLogical.R b/tests/testthat/test-smk-ds.asLogical.R index 6781beab..6e31ecce 100644 --- a/tests/testthat/test-smk-ds.asLogical.R +++ b/tests/testthat/test-smk-ds.asLogical.R @@ -27,11 +27,12 @@ test_that("setup", { # context("ds.asLogical::smk::simple test") test_that("simple test", { - res <- ds.asLogical("D$LAB_TSC") + ds.asLogical("D$LAB_TSC") - expect_equal(length(res), 2) - expect_equal(res$is.object.created, "A data object has been created in all specified data sources") - expect_equal(res$validity.check, " appears valid in all sources") + res.class <- ds.class("aslogical.newobj") + expect_equal(res.class$sim1, "logical") + expect_equal(res.class$sim2, "logical") + expect_equal(res.class$sim3, "logical") }) # diff --git a/tests/testthat/test-smk-ds.asMatrix.R b/tests/testthat/test-smk-ds.asMatrix.R index b942425b..b17066c2 100644 --- a/tests/testthat/test-smk-ds.asMatrix.R +++ b/tests/testthat/test-smk-ds.asMatrix.R @@ -27,11 +27,12 @@ test_that("setup", { # context("ds.asMatrix::smk::simple test") test_that("simple test", { - res <- ds.asMatrix(x.name="D$GENDER") + ds.asMatrix(x.name="D$GENDER") - expect_length(res, 2) - expect_equal(res$is.object.created, "A data object has been created in all specified data sources") - expect_equal(res$validity.check, " appears valid in all sources") + res.class <- ds.class("asmatrix.newobj") + expect_true("matrix" %in% res.class$sim1) + expect_true("matrix" %in% res.class$sim2) + expect_true("matrix" %in% res.class$sim3) }) # diff --git a/tests/testthat/test-smk-ds.asNumeric.R b/tests/testthat/test-smk-ds.asNumeric.R index e942c82a..aa2fdf2f 100644 --- a/tests/testthat/test-smk-ds.asNumeric.R +++ b/tests/testthat/test-smk-ds.asNumeric.R @@ -27,11 +27,12 @@ test_that("setup", { # context("ds.asNumeric::smk::simple test") test_that("simple test", { - res <- ds.asNumeric("D$GENDER") + ds.asNumeric("D$GENDER") - expect_equal(length(res), 2) - expect_equal(res$is.object.created, "A data object has been created in all specified data sources") - expect_equal(res$validity.check, " appears valid in all sources") + res.class <- ds.class("asnumeric.newobj") + expect_equal(res.class$sim1, "numeric") + expect_equal(res.class$sim2, "numeric") + expect_equal(res.class$sim3, "numeric") }) #