diff --git a/DESCRIPTION b/DESCRIPTION index ad8e28a6d..5203957ad 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 8bdab82e9..bd539a118 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 41c204551..cc4523f32 100644 --- a/R/ds.abs.R +++ b/R/ds.abs.R @@ -17,6 +17,7 @@ #' the input numeric or integer vector specified in the argument \code{x}. The created vectors #' are stored in the servers. #' @author Demetris Avraam for DataSHIELD Development Team +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' @export #' @examples #' \dontrun{ @@ -72,41 +73,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 c0bd4ce0a..623e43dbe 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 @@ -53,115 +51,22 @@ #' #' } #' @author DataSHIELD Development Team +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' @export #' 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 7b4833bbd..bdfa9fdd0 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 @@ -54,113 +50,22 @@ #' #' } #' @author DataSHIELD Development Team +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' @export #' 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 9b3b1a397..0e9670df0 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 @@ -68,109 +65,21 @@ #' #' } #' @author DataSHIELD Development Team +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' @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 d73668785..83007f5a3 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 @@ -54,41 +52,22 @@ #' #' } #' @author DataSHIELD Development Team +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' @export #' 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 2ddc33cfe..85617edcf 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 @@ -54,113 +51,22 @@ #' #' } #' @author DataSHIELD Development Team +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' @export #' 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 1c5b0ced7..f39803773 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 @@ -55,113 +53,22 @@ #' #' } #' @author DataSHIELD Development Team +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' @export #' 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 3e2b445fa..803a6308d 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 @@ -68,112 +65,22 @@ #' #' } #' @author DataSHIELD Development Team +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' @export #' 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.colnames.R b/R/ds.colnames.R index a4b98b1ad..da842ec0e 100644 --- a/R/ds.colnames.R +++ b/R/ds.colnames.R @@ -12,6 +12,7 @@ #' @return \code{ds.colnames} returns the column names of #' the specified server-side data frame or matrix. #' @author DataSHIELD Development Team +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' @seealso \code{\link{ds.dim}} to obtain the dimensions of a matrix or a data frame. #' @examples #' \dontrun{ diff --git a/R/ds.exp.R b/R/ds.exp.R index 5bf325bd8..65102600a 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 @@ -15,6 +15,7 @@ #' @return \code{ds.exp} returns a vector for each study of the exponential values for the numeric vector #' specified in the argument \code{x}. The created vectors are stored in the server-side. #' @author DataSHIELD Development Team +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' @export #' @examples #' \dontrun{ @@ -57,42 +58,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 8c0b2e5d2..cfa2155f2 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)}. @@ -14,6 +14,7 @@ #' @return \code{ds.log} returns a vector for each study of the transformed values for the numeric vector #' specified in the argument \code{x}. The created vectors are stored in the server-side. #' @author DataSHIELD Development Team +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' @export #' @examples #' \dontrun{ @@ -57,42 +58,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 e78011def..3aef21937 100644 --- a/R/ds.sqrt.R +++ b/R/ds.sqrt.R @@ -17,6 +17,7 @@ #' the input numeric or integer vector specified in the argument \code{x}. The created vectors #' are stored in the servers. #' @author Demetris Avraam for DataSHIELD Development Team +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' @export #' @examples #' \dontrun{ @@ -70,41 +71,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 000000000..85d8d7e2f --- /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/armadillo_azure-pipelines.yml b/armadillo_azure-pipelines.yml index 4fbd10739..ebca240bc 100644 --- a/armadillo_azure-pipelines.yml +++ b/armadillo_azure-pipelines.yml @@ -34,6 +34,7 @@ variables: branchName: $(Build.SourceBranchName) test_filter: '*' _r_check_system_clock_: 0 + perf.profile: 'azure-pipeline' ######################################################################################### @@ -274,7 +275,7 @@ jobs: # # "_-|arg-|smk-|datachk-|disc-|math-|expt-|expt_smk-" # testthat::test_package("$(projectName)", filter = "_-|datachk-|smk-|arg-|disc-|perf-|smk_expt-|expt-|math-", reporter = multi_rep, stop_on_failure = FALSE) - sudo R -q -e ' + sudo env PERF_PROFILE=$PERF_PROFILE R -q -e ' library(covr); dsbase.res <- covr::package_coverage( type = c("none"), @@ -396,7 +397,7 @@ jobs: # testthat::testpackage uses a MultiReporter, comprised of a ProgressReporter and JunitReporter # R output and messages are redirected by sink() to test_console_output.txt # junit reporter output is to test_results.xml - sudo R -q -e ' + sudo env PERF_PROFILE=$PERF_PROFILE R -q -e ' library(covr); dsdanger.res <- covr::package_coverage( type = c("none"), @@ -534,7 +535,6 @@ jobs: echo 'branch:'$(branchName) >> $(datetime).txt echo 'os:'$(lsb_release -ds) >> $(datetime).txt echo 'R:'$(R --version | head -n 1) >> $(datetime).txt - echo 'opal:'$(opal system --opal localhost:8443 --user administrator --password "datashield_test&" --version) >> $(datetime).txt workingDirectory: $(Pipeline.Workspace)/logs displayName: 'Write versions to file' diff --git a/azure-pipelines.yml b/azure-pipelines.yml index 04fb284d2..b541a3903 100644 --- a/azure-pipelines.yml +++ b/azure-pipelines.yml @@ -32,6 +32,7 @@ variables: branchName: $(Build.SourceBranchName) test_filter: '*' _r_check_system_clock_: 0 + perf.profile: 'azure-pipeline' ######################################################################################### @@ -214,13 +215,13 @@ jobs: # Install dsBase. # If previous steps have failed then don't run. - bash: | - R -q -e "library(opalr); opal <- opal.login(username = 'administrator', password = 'datashield_test&', url = 'https://localhost:8443', opts = list(ssl_verifyhost=0, ssl_verifypeer=0)); opal.put(opal, 'system', 'conf', 'general', '_rPackage'); opal.logout(o)" + R -q -e "library(opalr); opal <- opal.login(username = 'administrator', password = 'datashield_test&', url = 'http://localhost:8080/'); opal.put(opal, 'system', 'conf', 'general', '_rPackage'); opal.logout(opal)" - R -q -e "library(opalr); opal <- opal.login('administrator','datashield_test&', url='https://localhost:8443/', opts = list(ssl_verifyhost=0, ssl_verifypeer=0)); dsadmin.install_github_package(opal, 'dsBase', username = 'datashield', ref = 'v7.0-dev'); opal.logout(opal)" + R -q -e "library(opalr); opal <- opal.login('administrator','datashield_test&', url='http://localhost:8080/'); dsadmin.install_github_package(opal, 'dsBase', username = 'datashield', ref = 'v7.0-dev'); opal.logout(opal)" sleep 60 - R -q -e "library(opalr); opal <- opal.login('administrator','datashield_test&', url='https://localhost:8443/', opts = list(ssl_verifyhost=0, ssl_verifypeer=0)); dsadmin.set_option(opal, 'default.datashield.privacyControlLevel', 'permissive'); opal.logout(opal)" + R -q -e "library(opalr); opal <- opal.login('administrator','datashield_test&', url='http://localhost:8080/'); dsadmin.set_option(opal, 'default.datashield.privacyControlLevel', 'permissive'); opal.logout(opal)" workingDirectory: $(Pipeline.Workspace)/dsBaseClient/tests/testthat/data_files displayName: 'Install dsBase to Opal, as set disclosure test options' @@ -253,7 +254,7 @@ jobs: # # "_-|arg-|smk-|datachk-|disc-|math-|expt-|expt_smk-" # testthat::test_package("$(projectName)", filter = "_-|datachk-|smk-|arg-|disc-|perf-|smk_expt-|expt-|math-", reporter = multi_rep, stop_on_failure = FALSE) - sudo R -q -e ' + sudo env PERF_PROFILE=$PERF_PROFILE R -q -e ' library(covr); dsbase.res <- covr::package_coverage( type = c("none"), @@ -342,9 +343,9 @@ jobs: # If previous steps have failed then don't run - bash: | - R -q -e "library(opalr); opal <- opal.login(username = 'administrator', password = 'datashield_test&', url = 'https://localhost:8443', opts = list(ssl_verifyhost=0, ssl_verifypeer=0)); opal.put(opal, 'system', 'conf', 'general', '_rPackage'); opal.logout(o)" + R -q -e "library(opalr); opal <- opal.login(username = 'administrator', password = 'datashield_test&', url = 'http://localhost:8080'); opal.put(opal, 'system', 'conf', 'general', '_rPackage'); opal.logout(opal)" - R -q -e "library(opalr); opal <- opal.login('administrator','datashield_test&', url='https://localhost:8443/', opts = list(ssl_verifyhost=0, ssl_verifypeer=0)); dsadmin.install_github_package(opal, 'dsDanger', username = 'datashield', ref = '6.3.4'); opal.logout(opal)" + R -q -e "library(opalr); opal <- opal.login('administrator','datashield_test&', url='http://localhost:8080/'); dsadmin.install_github_package(opal, 'dsDanger', username = 'datashield', ref = '6.3.4'); opal.logout(opal)" workingDirectory: $(Pipeline.Workspace)/dsBaseClient displayName: 'Install dsDanger package on Opal server' @@ -368,7 +369,7 @@ jobs: # testthat::testpackage uses a MultiReporter, comprised of a ProgressReporter and JunitReporter # R output and messages are redirected by sink() to test_console_output.txt # junit reporter output is to test_results.xml - sudo R -q -e ' + sudo env PERF_PROFILE=$PERF_PROFILE R -q -e ' library(covr); dsdanger.res <- covr::package_coverage( type = c("none"), diff --git a/docker-compose_armadillo.yml b/docker-compose_armadillo.yml index 37c44cdae..d7d98b911 100644 --- a/docker-compose_armadillo.yml +++ b/docker-compose_armadillo.yml @@ -3,7 +3,7 @@ services: hostname: armadillo ports: - 8080:8080 - image: datashield/armadillo_citest:5.11.0 + image: datashield/armadillo_citest:latest environment: LOGGING_CONFIG: 'classpath:logback-file.xml' AUDIT_LOG_PATH: '/app/logs/audit.log' @@ -16,7 +16,6 @@ services: default: hostname: default - image: datashield/rock-quebrada-lamda:latest -# image: datashield/rserver-panda-lamda:devel + image: datashield/rock_citest-permissive:latest environment: DEBUG: "FALSE" diff --git a/docker-compose_opal.yml b/docker-compose_opal.yml index a62dec679..70bffd8d1 100644 --- a/docker-compose_opal.yml +++ b/docker-compose_opal.yml @@ -3,6 +3,7 @@ services: image: datashield/opal_citest:latest ports: - 8443:8443 + - 8080:8080 links: - mongo - rock @@ -15,11 +16,11 @@ services: - ROCK_HOSTS=rock:8085 - ROCK_ADMINISTRATOR_PASSWORD=foobar mongo: - image: mongo:4.4.15 + image: mongo:8.0 environment: - MONGO_INITDB_ROOT_USERNAME=root - MONGO_INITDB_ROOT_PASSWORD=foobar rock: - image: datashield/rock-quebrada-lamda-permissive:latest + image: datashield/rock_citest-permissive:latest environment: DEBUG: "FALSE" diff --git a/dsBase_7.0.0-permissive.tar.gz b/dsBase_7.0.0-permissive.tar.gz index ab4b862e2..fd3511233 100644 Binary files a/dsBase_7.0.0-permissive.tar.gz and b/dsBase_7.0.0-permissive.tar.gz differ diff --git a/man/ds.abs.Rd b/man/ds.abs.Rd index 639ebd3e9..6cd9404d8 100644 --- a/man/ds.abs.Rd +++ b/man/ds.abs.Rd @@ -87,4 +87,6 @@ specified by the user through the argument \code{newobj}, otherwise is named by } \author{ Demetris Avraam for DataSHIELD Development Team + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/man/ds.asCharacter.Rd b/man/ds.asCharacter.Rd index 447d9cf9e..e557c9fc1 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. @@ -69,4 +67,6 @@ Server function called: \code{asCharacterDS} } \author{ DataSHIELD Development Team + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/man/ds.asDataMatrix.Rd b/man/ds.asDataMatrix.Rd index e6ea9eb9c..d9e253e6a 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 @@ -73,4 +69,6 @@ Server function called: \code{asDataMatrixDS}. } \author{ DataSHIELD Development Team + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/man/ds.asInteger.Rd b/man/ds.asInteger.Rd index d2f0455be..0bf7ab473 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. @@ -86,4 +83,6 @@ Server function called: \code{asIntegerDS} } \author{ DataSHIELD Development Team + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/man/ds.asList.Rd b/man/ds.asList.Rd index 1e2e3c733..6af6f9607 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. @@ -70,4 +68,6 @@ Server function called: \code{asListDS} } \author{ DataSHIELD Development Team + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/man/ds.asLogical.Rd b/man/ds.asLogical.Rd index c42d2e6aa..ec539cc33 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. @@ -71,4 +68,6 @@ Server function called: \code{asLogicalDS} } \author{ DataSHIELD Development Team + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/man/ds.asMatrix.Rd b/man/ds.asMatrix.Rd index 709480148..8116ac1d1 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. @@ -74,4 +72,6 @@ Server function called: \code{asMatrixDS} } \author{ DataSHIELD Development Team + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/man/ds.asNumeric.Rd b/man/ds.asNumeric.Rd index 9928942a5..73f03693f 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. @@ -85,4 +82,6 @@ Server function called: \code{asNumericDS} } \author{ DataSHIELD Development Team + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/man/ds.colnames.Rd b/man/ds.colnames.Rd index e73910812..6915dd592 100644 --- a/man/ds.colnames.Rd +++ b/man/ds.colnames.Rd @@ -66,4 +66,6 @@ Server function called: \code{colnamesDS} } \author{ DataSHIELD Development Team + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/man/ds.exp.Rd b/man/ds.exp.Rd index 875dbe00e..dd10147ab 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{ @@ -69,4 +69,6 @@ Server function called: \code{exp}. } \author{ DataSHIELD Development Team + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/man/ds.log.Rd b/man/ds.log.Rd index 6ab8fee72..a48ee6aae 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{ @@ -73,4 +73,6 @@ Server function called: \code{log} } \author{ DataSHIELD Development Team + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/man/ds.sqrt.Rd b/man/ds.sqrt.Rd index 638d26a5f..95b5432cd 100644 --- a/man/ds.sqrt.Rd +++ b/man/ds.sqrt.Rd @@ -82,4 +82,6 @@ specified by the user through the argument \code{newobj}, otherwise is named by } \author{ Demetris Avraam for DataSHIELD Development Team + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/opal_azure-pipelines.yml b/opal_azure-pipelines.yml index 76eb2e798..b541a3903 100644 --- a/opal_azure-pipelines.yml +++ b/opal_azure-pipelines.yml @@ -3,11 +3,9 @@ # Starts with a vanilla Opal docker composition, installs dsBase # and dsBaseClient (as well as dependencies - including a fully functional # Opal server). -# Does checks and tests then saves results to testStatus repo. # # Inside the root directory $(Pipeline.Workspace) will be a file tree like: # /dsBaseClient <- Checked out version of datashield/dsBaseClient -# /testStatus <- Checked out version of datashield/testStatus # /logs <- Where results of tests and lots are collated # # As of May 2020 this takes ~ 70 mins to run. @@ -34,18 +32,7 @@ variables: branchName: $(Build.SourceBranchName) test_filter: '*' _r_check_system_clock_: 0 - - -######################################################################################### -# Need to define all the GH repos and their access tokens, see: -# https://docs.microsoft.com/en-us/azure/devops/pipelines/library/service-endpoints?view=azure-devops&tabs=yaml -resources: - repositories: - - repository: testStatusRepo - type: github - endpoint: datashield-testing - name: datashield/testStatus - ref: master + perf.profile: 'azure-pipeline' ######################################################################################### @@ -82,11 +69,6 @@ jobs: - checkout: self path: 'dsBaseClient' - - checkout: testStatusRepo - path: 'testStatus' - persistCredentials: true - condition: and(eq(variables['Build.Repository.Name'], 'datashield/dsBaseClient'), ne(variables['Build.Reason'], 'PullRequest')) - ##################################################################################### # The MySQL install that comes with the VM doesn't seem compatable with our set up @@ -233,13 +215,13 @@ jobs: # Install dsBase. # If previous steps have failed then don't run. - bash: | - R -q -e "library(opalr); opal <- opal.login(username = 'administrator', password = 'datashield_test&', url = 'https://localhost:8443', opts = list(ssl_verifyhost=0, ssl_verifypeer=0)); opal.put(opal, 'system', 'conf', 'general', '_rPackage'); opal.logout(o)" + R -q -e "library(opalr); opal <- opal.login(username = 'administrator', password = 'datashield_test&', url = 'http://localhost:8080/'); opal.put(opal, 'system', 'conf', 'general', '_rPackage'); opal.logout(opal)" - R -q -e "library(opalr); opal <- opal.login('administrator','datashield_test&', url='https://localhost:8443/', opts = list(ssl_verifyhost=0, ssl_verifypeer=0)); dsadmin.install_github_package(opal, 'dsBase', username = 'datashield', ref = 'v7.0-dev'); opal.logout(opal)" + R -q -e "library(opalr); opal <- opal.login('administrator','datashield_test&', url='http://localhost:8080/'); dsadmin.install_github_package(opal, 'dsBase', username = 'datashield', ref = 'v7.0-dev'); opal.logout(opal)" sleep 60 - R -q -e "library(opalr); opal <- opal.login('administrator','datashield_test&', url='https://localhost:8443/', opts = list(ssl_verifyhost=0, ssl_verifypeer=0)); dsadmin.set_option(opal, 'default.datashield.privacyControlLevel', 'permissive'); opal.logout(opal)" + R -q -e "library(opalr); opal <- opal.login('administrator','datashield_test&', url='http://localhost:8080/'); dsadmin.set_option(opal, 'default.datashield.privacyControlLevel', 'permissive'); opal.logout(opal)" workingDirectory: $(Pipeline.Workspace)/dsBaseClient/tests/testthat/data_files displayName: 'Install dsBase to Opal, as set disclosure test options' @@ -272,7 +254,7 @@ jobs: # # "_-|arg-|smk-|datachk-|disc-|math-|expt-|expt_smk-" # testthat::test_package("$(projectName)", filter = "_-|datachk-|smk-|arg-|disc-|perf-|smk_expt-|expt-|math-", reporter = multi_rep, stop_on_failure = FALSE) - sudo R -q -e ' + sudo env PERF_PROFILE=$PERF_PROFILE R -q -e ' library(covr); dsbase.res <- covr::package_coverage( type = c("none"), @@ -361,9 +343,9 @@ jobs: # If previous steps have failed then don't run - bash: | - R -q -e "library(opalr); opal <- opal.login(username = 'administrator', password = 'datashield_test&', url = 'https://localhost:8443', opts = list(ssl_verifyhost=0, ssl_verifypeer=0)); opal.put(opal, 'system', 'conf', 'general', '_rPackage'); opal.logout(o)" + R -q -e "library(opalr); opal <- opal.login(username = 'administrator', password = 'datashield_test&', url = 'http://localhost:8080'); opal.put(opal, 'system', 'conf', 'general', '_rPackage'); opal.logout(opal)" - R -q -e "library(opalr); opal <- opal.login('administrator','datashield_test&', url='https://localhost:8443/', opts = list(ssl_verifyhost=0, ssl_verifypeer=0)); dsadmin.install_github_package(opal, 'dsDanger', username = 'datashield', ref = '6.3.4'); opal.logout(opal)" + R -q -e "library(opalr); opal <- opal.login('administrator','datashield_test&', url='http://localhost:8080/'); dsadmin.install_github_package(opal, 'dsDanger', username = 'datashield', ref = '6.3.4'); opal.logout(opal)" workingDirectory: $(Pipeline.Workspace)/dsBaseClient displayName: 'Install dsDanger package on Opal server' @@ -387,7 +369,7 @@ jobs: # testthat::testpackage uses a MultiReporter, comprised of a ProgressReporter and JunitReporter # R output and messages are redirected by sink() to test_console_output.txt # junit reporter output is to test_results.xml - sudo R -q -e ' + sudo env PERF_PROFILE=$PERF_PROFILE R -q -e ' library(covr); dsdanger.res <- covr::package_coverage( type = c("none"), @@ -524,75 +506,6 @@ jobs: displayName: 'Down Opal Docker Composition' condition: succeeded() - ##################################################################################### - # Windup phase - ##################################################################################### - - ##################################################################################### - # Output some important version numbers to file. This gets added to the testStatus - # commit so it can be parsed and used on the status table. - - bash: | - - echo 'branch:'$(branchName) >> $(datetime).txt - echo 'os:'$(lsb_release -ds) >> $(datetime).txt - echo 'R:'$(R --version | head -n 1) >> $(datetime).txt - echo 'opal:'$(opal system --opal localhost:8443 --user administrator --password "datashield_test&" --version) >> $(datetime).txt - - workingDirectory: $(Pipeline.Workspace)/logs - displayName: 'Write versions to file' - condition: succeededOrFailed() - - - ##################################################################################### - # Checkout the testStatus repo, add the results from here, push back to GH. - # TODO: Automatically pull in better email/name info from somewhere. - # TODO: More debug info in commit message - - bash: | - - # Git needs some config set to be able to push to a repo. - git config --global user.email "you@example.com" - git config --global user.name "Azure pipeline" - - # This repo is checked out in detatched head state, so reconnect it here. - git checkout master - - # It is possible that other commits have been made to the testStatus repo since it - # was checked out. i.e. other pipeline runs might have finished. - git pull - - # Make the directories if they dont already exist - mkdir --parents logs/$(projectName)/$(branchName) - mkdir --parents docs/$(projectName)/$(branchName)/latest - - cp $(Pipeline.Workspace)/logs/coveragelist.csv logs/$(projectName)/$(branchName)/ - cp $(Pipeline.Workspace)/logs/coveragelist.csv logs/$(projectName)/$(branchName)/$(datetime).csv - - cp $(Pipeline.Workspace)/logs/test_results.xml logs/$(projectName)/$(branchName)/ - cp $(Pipeline.Workspace)/logs/test_results.xml logs/$(projectName)/$(branchName)/$(datetime).xml - - cp $(Pipeline.Workspace)/logs/$(datetime).txt logs/$(projectName)/$(branchName)/ - - # Run the script to parse the results and build the html pages. - # status.py JUnit_file.xml coverage_file.csv output_file.html local_repo_path remote_repo_name branch - source/status.py logs/$(projectName)/$(branchName)/$(datetime).xml logs/$(projectName)/$(branchName)/$(datetime).csv logs/$(projectName)/$(branchName)/$(datetime).txt status.html $(Pipeline.Workspace)/$(projectName) $(projectName) $(branchName) - - cp status.html docs/$(projectName)/$(branchName)/latest/index.html - git add logs/$(projectName)/$(branchName)/coveragelist.csv - git add logs/$(projectName)/$(branchName)/test_results.xml - git add logs/$(projectName)/$(branchName)/$(datetime).xml - git add logs/$(projectName)/$(branchName)/$(datetime).csv - git add logs/$(projectName)/$(branchName)/$(datetime).txt - git add docs/$(projectName)/$(branchName)/latest/index.html - - git commit -m "Azure auto test for $(projectName)/$(branchName) @ $(datetime)" -m "Debug info:\nProjectName:$(projectName)\nBranchName:$(branchName)\nDataTime:$(datetime)" - git push - exit 0 - - workingDirectory: $(Pipeline.Workspace)/testStatus - displayName: 'Parse test results' - condition: and(eq(variables['Build.Repository.Name'], 'datashield/dsBaseClient'), ne(variables['Build.Reason'], 'PullRequest')) - - ##################################################################################### # Output the environment information to the console. This is useful for debugging. # Always do this, even if some of the above has failed or the job has been cacelled. diff --git a/tests/testthat/connection_to_datasets/login_details.R b/tests/testthat/connection_to_datasets/login_details.R index 2ce4ca2de..813954749 100644 --- a/tests/testthat/connection_to_datasets/login_details.R +++ b/tests/testthat/connection_to_datasets/login_details.R @@ -22,12 +22,12 @@ if (! is.null(getOption("default_driver"))) { } if ((ds.test_env$driver == "DSLiteDriver") || (ds.test_env$driver == "OpalDriver")) { - ds.test_env$ping_address <- paste("https://", ds.test_env$server_ip_address, ":8443", sep="") - ds.test_env$ping_config <- config(timeout=5, ssl_verifyhost=0, ssl_verifypeer=0) + ds.test_env$ping_address <- paste("http://", ds.test_env$server_ip_address, ":8080", sep="") + ds.test_env$ping_config <- config(timeout=5) - ds.test_env$ip_address_1 <- paste("https://", ds.test_env$server_ip_address, ":8443", sep="") - ds.test_env$ip_address_2 <- paste("https://", ds.test_env$server_ip_address, ":8443", sep="") - ds.test_env$ip_address_3 <- paste("https://", ds.test_env$server_ip_address, ":8443", sep="") + ds.test_env$ip_address_1 <- paste("http://", ds.test_env$server_ip_address, ":8080", sep="") + ds.test_env$ip_address_2 <- paste("http://", ds.test_env$server_ip_address, ":8080", sep="") + ds.test_env$ip_address_3 <- paste("http://", ds.test_env$server_ip_address, ":8080", sep="") ds.test_env$user_1 <- getOption("opal.user", "administrator") ds.test_env$user_2 <- getOption("opal.user", "administrator") @@ -37,9 +37,9 @@ if ((ds.test_env$driver == "DSLiteDriver") || (ds.test_env$driver == "OpalDriver ds.test_env$password_2 <- getOption("opal.password", "datashield_test&") ds.test_env$password_3 <- getOption("opal.password", "datashield_test&") - ds.test_env$options_1 <- "list(ssl_verifyhost=0, ssl_verifypeer=0)" - ds.test_env$options_2 <- "list(ssl_verifyhost=0, ssl_verifypeer=0)" - ds.test_env$options_3 <- "list(ssl_verifyhost=0, ssl_verifypeer=0)" + ds.test_env$options_1 <- "list()" + ds.test_env$options_2 <- "list()" + ds.test_env$options_3 <- "list()" ds.test_env$secure_login_details <- TRUE } else if (ds.test_env$driver == "ArmadilloDriver") { diff --git a/tests/testthat/data_files/obiba_opal-upload_testing_datasets.R b/tests/testthat/data_files/obiba_opal-upload_testing_datasets.R index ae79d2e62..2913e3ecb 100644 --- a/tests/testthat/data_files/obiba_opal-upload_testing_datasets.R +++ b/tests/testthat/data_files/obiba_opal-upload_testing_datasets.R @@ -17,8 +17,8 @@ upload_testing_dataset_table <- function(opal, project_name, table_name, local_f opal.table_save(opal, data, project_name, table_name, id.name = "_row_id_", force = TRUE) } -# opal <- opal.login('administrator','datashield_test&', url='https://192.168.56.100:8443/', opts = list(ssl_verifyhost=0, ssl_verifypeer=0)) -opal <- opal.login('administrator','datashield_test&', url='https://localhost:8443/', opts = list(ssl_verifyhost=0, ssl_verifypeer=0)) +# opal <- opal.login('administrator','datashield_test&', url='https://192.168.56.100:8/', opts = list(ssl_verifyhost=0, ssl_verifypeer=0)) +opal <- opal.login('administrator','datashield_test&', url='http://localhost:8080/', opts = list()) upload_testing_dataset_table(opal, 'ANTHRO', 'anthro1', 'ANTHRO/anthro1.rda') upload_testing_dataset_table(opal, 'ANTHRO', 'anthro2', 'ANTHRO/anthro2.rda') diff --git a/tests/testthat/perf_files/armadillo_azure-pipeline.csv b/tests/testthat/perf_files/armadillo_azure-pipeline.csv deleted file mode 100644 index 03d36d8fe..000000000 --- a/tests/testthat/perf_files/armadillo_azure-pipeline.csv +++ /dev/null @@ -1,14 +0,0 @@ -"refer_name","rate","lower_tolerance","upper_tolerance" -"conndisconn::perf::simple0","0.1651","0.5","2" -"ds.abs::perf::0","6.273","0.5","2" -"ds.asInteger::perf:0","5.731","0.5","2" -"ds.asList::perf:0","12.74","0.5","2" -"ds.asNumeric::perf:0","5.637","0.5","2" -"ds.assign::perf::0","10.46","0.5","2" -"ds.class::perf::combine:0","12.69","0.5","2" -"ds.colnames::perf:0","9.518","0.5","2" -"ds.exists::perf::combine:0","25.33","0.5","2" -"ds.length::perf::combine:0","25.45","0.5","2" -"ds.mean::perf::combine:0","25.37","0.5","2" -"ds.mean::perf::split:0","25.74","0.5","2" -"void::perf::void::0","56310.0","0.5","2" diff --git a/tests/testthat/perf_files/armadillo_azure-pipeline_perf-profile.csv b/tests/testthat/perf_files/armadillo_azure-pipeline_perf-profile.csv new file mode 100644 index 000000000..2ad6282b7 --- /dev/null +++ b/tests/testthat/perf_files/armadillo_azure-pipeline_perf-profile.csv @@ -0,0 +1,20 @@ +"refer_name","rate","lower_tolerance","upper_tolerance" +"conndisconn::perf::simple0","0.1601","0.5","2" +"ds.abs::perf::0","17.68","0.5","2" +"ds.asCharacter::perf:0","16.19","0.5","2" +"ds.asDataMatrix::perf:0","17.28","0.5","2" +"ds.asInteger::perf:0","17.29","0.5","2" +"ds.asList::perf:0","16.78","0.5","2" +"ds.asLogical::perf:0","17.81","0.5","2" +"ds.asMatrix::perf:0","17.22","0.5","2" +"ds.asNumeric::perf:0","17.50","0.5","2" +"ds.assign::perf::0","12.59","0.5","2" +"ds.class::perf::combine:0","12.55","0.5","2" +"ds.colnames::perf:0","9.708","0.5","2" +"ds.exists::perf::combine:0","25.33","0.5","2" +"ds.length::perf::combine:0","25.45","0.5","2" +"ds.log::perf::0","25.37","0.5","2" +"ds.mean::perf::combine:0","25.37","0.5","2" +"ds.mean::perf::split:0","25.74","0.5","2" +"ds.sqrt::perf::0","17.70","0.5","2" +"void::perf::void::0","56310.0","0.5","2" diff --git a/tests/testthat/perf_files/armadillo_hp-laptop_quay.csv b/tests/testthat/perf_files/armadillo_hp-laptop-quay_perf-profile.csv similarity index 55% rename from tests/testthat/perf_files/armadillo_hp-laptop_quay.csv rename to tests/testthat/perf_files/armadillo_hp-laptop-quay_perf-profile.csv index 9ac69853e..89fe83c9f 100644 --- a/tests/testthat/perf_files/armadillo_hp-laptop_quay.csv +++ b/tests/testthat/perf_files/armadillo_hp-laptop-quay_perf-profile.csv @@ -1,9 +1,13 @@ "refer_name","rate","lower_tolerance","upper_tolerance" "conndisconn::perf::simple0","0.04918","0.5","2" -"ds.abs::perf::0","1.184","0.5","2" -"ds.asInteger::perf:0","1.297","0.5","2" -"ds.asList::perf:0","2.884","0.5","2" -"ds.asNumeric::perf:0","1.354","0.5","2" +"ds.abs::perf::0","6.327","0.5","2" +"ds.asCharacter::perf::0","4.048","0.5","2" +"ds.asDataMatrix::perf::0","4.206","0.5","2" +"ds.asInteger::perf:0","4.309","0.5","2" +"ds.asList::perf:0","8.058","0.5","2" +"ds.asLogical::perf::0","4.793","0.5","2" +"ds.asMatrix::perf::0","4.840","0.5","2" +"ds.asNumeric::perf:0","6.555","0.5","2" "ds.assign::perf::0","2.745","0.5","2" "ds.class::perf::combine:0","3.261","0.5","2" "ds.colnames::perf:0","2.404","0.5","2" @@ -11,4 +15,5 @@ "ds.length::perf::combine:0","7.835","0.5","2" "ds.mean::perf::combine:0","8.127","0.5","2" "ds.mean::perf::split:0","8.109","0.5","2" +"ds.sqrt::perf::0","5.569","0.5","2" "void::perf::void::0","20280.0","0.5","2" diff --git a/tests/testthat/perf_files/dslite_hp-laptop_quay.csv b/tests/testthat/perf_files/dslite_hp-laptop-quay_perf-profile.csv similarity index 100% rename from tests/testthat/perf_files/dslite_hp-laptop_quay.csv rename to tests/testthat/perf_files/dslite_hp-laptop-quay_perf-profile.csv diff --git a/tests/testthat/perf_files/opal_azure-pipeline.csv b/tests/testthat/perf_files/opal_azure-pipeline.csv deleted file mode 100644 index 9f1ae6e5e..000000000 --- a/tests/testthat/perf_files/opal_azure-pipeline.csv +++ /dev/null @@ -1,14 +0,0 @@ -"refer_name","rate","lower_tolerance","upper_tolerance" -"conndisconn::perf::simple0","0.2725","0.5","2" -"ds.abs::perf::0","2.677","0.5","2" -"ds.asInteger::perf:0","2.294","0.5","2" -"ds.asList::perf:0","4.587","0.5","2" -"ds.asNumeric::perf:0","2.185","0.5","2" -"ds.assign::perf::0","5.490","0.5","2" -"ds.class::perf::combine:0","4.760","0.5","2" -"ds.colnames::perf:0","4.218","0.5","2" -"ds.exists::perf::combine:0","11.09","0.5","2" -"ds.length::perf::combine:0","9.479","0.5","2" -"ds.mean::perf::combine:0","9.650","0.5","2" -"ds.mean::perf::split:0","11.26","0.5","2" -"void::perf::void::0","46250.0","0.5","2" diff --git a/tests/testthat/perf_files/default_perf_profile.csv b/tests/testthat/perf_files/opal_azure-pipeline_perf-profile.csv similarity index 100% rename from tests/testthat/perf_files/default_perf_profile.csv rename to tests/testthat/perf_files/opal_azure-pipeline_perf-profile.csv diff --git a/tests/testthat/perf_files/opal_hp-laptop_quay.csv b/tests/testthat/perf_files/opal_hp-laptop-quay_perf-profile.csv similarity index 100% rename from tests/testthat/perf_files/opal_hp-laptop_quay.csv rename to tests/testthat/perf_files/opal_hp-laptop-quay_perf-profile.csv diff --git a/tests/testthat/perf_tests/perf_rate.R b/tests/testthat/perf_tests/perf_rate.R index 0384bf637..8d762207c 100644 --- a/tests/testthat/perf_tests/perf_rate.R +++ b/tests/testthat/perf_tests/perf_rate.R @@ -1,5 +1,5 @@ #------------------------------------------------------------------------------- -# Copyright (c) 2024-2025 Arjuna Technologies, Newcastle upon Tyne. All rights reserved. +# Copyright (c) 2024-2026 Arjuna Technologies, Newcastle upon Tyne. All rights reserved. # # This program and the accompanying materials # are made available under the terms of the GNU Public License v3.0. @@ -8,12 +8,36 @@ # along with this program. If not, see . #------------------------------------------------------------------------------- -.perf.reference.filename <- 'perf_files/default_perf_profile.csv' +.perf.reference.filename.base.prefix <- 'perf_files/' +.perf.reference.filename.base.postfix <- '_perf-profile.csv' +.perf.reference.save.filename <- NULL .perf.reference <- NULL .load.pref <- function() { - .perf.reference <<- read.csv(.perf.reference.filename, header = TRUE, sep = ",") + if (ds.test_env$driver == "OpalDriver") + perf.reference.filename.driver.infix <- "opal" + else if (ds.test_env$driver == "ArmadilloDriver") + perf.reference.filename.driver.infix <- "armadillo" + else if (ds.test_env$driver == "DSLiteDriver") + perf.reference.filename.driver.infix <- "dslite" + else + { + perf.reference.filename.infix <- "unknown" + warning("Unknown performance profile driver, using 'unknown'") + } + + perf.profile <- base::Sys.getenv("PERF_PROFILE") + if (nchar(perf.profile) > 0) + perf.reference.filename.platform.infix <- base::tolower(perf.profile) + else + { + perf.reference.filename.platform.infix <- "default" + warning("Unknown performance profile platform, using 'default'") + } + + perf.reference.filename <- paste(.perf.reference.filename.base.prefix, perf.reference.filename.driver.infix, '_', perf.reference.filename.platform.infix, .perf.reference.filename.base.postfix, sep = "") + .perf.reference <<- read.csv(perf.reference.filename, header = TRUE, sep = ",") } perf.reference.save <- function(perf.ref.name, rate, tolerance.lower, tolerance.upper) { @@ -22,11 +46,22 @@ perf.reference.save <- function(perf.ref.name, rate, tolerance.lower, tolerance. .perf.reference[nrow(.perf.reference)+1,] <- c(perf.ref.name, rate, tolerance.lower, tolerance.upper) - write.csv(.perf.reference, .perf.reference.filename, row.names = FALSE) + if (is.null(.perf.reference.save.filename)) + { + .perf.reference.save.filename <<- base::tempfile(pattern = "perf_file_", fileext = ".csv") + message(paste0("Additional perf record added to '", .perf.reference.save.filename, "'")) + } + + write.csv(.perf.reference, .perf.reference.save.filename, row.names = FALSE) .perf.reference <<- .perf.reference } +# Obtain performance test duration from PERF_DURATION_SEC environment variable, otherwise default.duration argument, otherwise "30". +perf.testduration <- function(default.duration = 30) { + base::as.integer(base::Sys.getenv("PERF_DURATION_SEC", unset = base::as.character(default.duration))) +} + perf.reference.rate <- function(perf.ref.name) { if (is.null(.perf.reference)) .load.pref() diff --git a/tests/testthat/test-arg-ds.abs.R b/tests/testthat/test-arg-ds.abs.R new file mode 100644 index 000000000..fc1e26c33 --- /dev/null +++ b/tests/testthat/test-arg-ds.abs.R @@ -0,0 +1,31 @@ +#------------------------------------------------------------------------------- +# Copyright (c) 2018-2022 University of Newcastle upon Tyne. All rights reserved. +# Copyright (c) 2022-2025 Arjuna Technologies, Newcastle upon Tyne. All rights reserved. +# +# This program and the accompanying materials +# are made available under the terms of the GNU Public License v3.0. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . +#------------------------------------------------------------------------------- + +# +# Set up +# + +connect.studies.dataset.cnsim(list("LAB_TSC")) + +# +# Tests +# + +# context("ds.abs::arg::test errors") +test_that("abs_errors", { + expect_error(ds.abs(), "Please provide the name of the input object!", fixed=TRUE) +}) + +# +# Done +# + +disconnect.studies.dataset.cnsim() diff --git a/tests/testthat/test-arg-ds.sqrt.R b/tests/testthat/test-arg-ds.sqrt.R new file mode 100644 index 000000000..fc5baf37f --- /dev/null +++ b/tests/testthat/test-arg-ds.sqrt.R @@ -0,0 +1,31 @@ +#------------------------------------------------------------------------------- +# Copyright (c) 2018-2022 University of Newcastle upon Tyne. All rights reserved. +# Copyright (c) 2022-2025 Arjuna Technologies, Newcastle upon Tyne. All rights reserved. +# +# This program and the accompanying materials +# are made available under the terms of the GNU Public License v3.0. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . +#------------------------------------------------------------------------------- + +# +# Set up +# + +connect.studies.dataset.cnsim(list("LAB_TSC")) + +# +# Tests +# + +# context("ds.sqrt::arg::test errors") +test_that("sqrt_errors", { + expect_error(ds.sqrt(), "Please provide the name of the input object!", fixed=TRUE) +}) + +# +# Done +# + +disconnect.studies.dataset.cnsim() diff --git a/tests/testthat/test-perf-ds.asCharacter.R b/tests/testthat/test-perf-ds.asCharacter.R new file mode 100644 index 000000000..f9c08b7df --- /dev/null +++ b/tests/testthat/test-perf-ds.asCharacter.R @@ -0,0 +1,58 @@ +#------------------------------------------------------------------------------- +# +# This program and the accompanying materials +# are made available under the terms of the GNU Public License v3.0. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . +#------------------------------------------------------------------------------- + +# +# Set up +# + +# context("ds.asCharacter::perf::setup") +connect.studies.dataset.cnsim(list("LAB_TSC", "LAB_TRIG")) + +# +# Tests +# + +# context("ds.asCharacter::perf:0") +test_that("combine - performance", { + .durationSec <- 30 # seconds + .count <- 0 + .start.time <- Sys.time() + .current.time <- .start.time + + while (difftime(.current.time, .start.time, units = "secs")[[1]] < .durationSec) { + ds.asCharacter("D$LAB_TSC", newobj = "perf.newobj") + + .count <- .count + 1 + .current.time <- Sys.time() + } + + .current.rate <- .count / (difftime(.current.time, .start.time, units = "secs")[[1]]) + .reference.rate <- perf.reference.rate("ds.asCharacter::perf::0") + if (any(length(.reference.rate) == 0) || any(is.null(.reference.rate))) { + print(paste("ds.asCharacter::perf::0 ", .current.rate, 0.5, 2.0)) + perf.reference.save("ds.asCharacter::perf::0", .current.rate, 0.5, 2.0) + } else { + print(paste("ds.asCharacter::perf::0 ", format(.current.rate, digits = 8), ", ", format(100.0 * .current.rate / .reference.rate, digits = 4), "%", sep = '')) + } + + .reference.rate <- perf.reference.rate("ds.asCharacter::perf::0") + .reference.tolerance.lower <- perf.reference.tolerance.lower("ds.asCharacter::perf::0") + .reference.tolerance.upper <- perf.reference.tolerance.upper("ds.asCharacter::perf::0") + + expect_gt(.current.rate, .reference.rate * .reference.tolerance.lower, label = "Observed rate", expected.label = "lower threshold on rate") + expect_lt(.current.rate, .reference.rate * .reference.tolerance.upper, label = "Observed rate", expected.label = "upper threshold on rate") +}) + +# +# Done +# + +# context("ds.asCharacter::perf::shutdown") +disconnect.studies.dataset.cnsim() +# context("ds.asCharacter::perf::done") diff --git a/tests/testthat/test-perf-ds.asDataMatrix.R b/tests/testthat/test-perf-ds.asDataMatrix.R new file mode 100644 index 000000000..329c1e2f6 --- /dev/null +++ b/tests/testthat/test-perf-ds.asDataMatrix.R @@ -0,0 +1,58 @@ +#------------------------------------------------------------------------------- +# +# This program and the accompanying materials +# are made available under the terms of the GNU Public License v3.0. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . +#------------------------------------------------------------------------------- + +# +# Set up +# + +# context("ds.asDataMatrix::perf::setup") +connect.studies.dataset.cnsim(list("LAB_TSC", "LAB_TRIG")) + +# +# Tests +# + +# context("ds.asDataMatrix::perf:0") +test_that("combine - performance", { + .durationSec <- 30 # seconds + .count <- 0 + .start.time <- Sys.time() + .current.time <- .start.time + + while (difftime(.current.time, .start.time, units = "secs")[[1]] < .durationSec) { + ds.asDataMatrix(x.name = "D", newobj = "perf.newobj") + + .count <- .count + 1 + .current.time <- Sys.time() + } + + .current.rate <- .count / (difftime(.current.time, .start.time, units = "secs")[[1]]) + .reference.rate <- perf.reference.rate("ds.asDataMatrix::perf::0") + if (any(length(.reference.rate) == 0) || any(is.null(.reference.rate))) { + print(paste("ds.asDataMatrix::perf::0 ", .current.rate, 0.5, 2.0)) + perf.reference.save("ds.asDataMatrix::perf::0", .current.rate, 0.5, 2.0) + } else { + print(paste("ds.asDataMatrix::perf::0 ", format(.current.rate, digits = 8), ", ", format(100.0 * .current.rate / .reference.rate, digits = 4), "%", sep = '')) + } + + .reference.rate <- perf.reference.rate("ds.asDataMatrix::perf::0") + .reference.tolerance.lower <- perf.reference.tolerance.lower("ds.asDataMatrix::perf::0") + .reference.tolerance.upper <- perf.reference.tolerance.upper("ds.asDataMatrix::perf::0") + + expect_gt(.current.rate, .reference.rate * .reference.tolerance.lower, label = "Observed rate", expected.label = "lower threshold on rate") + expect_lt(.current.rate, .reference.rate * .reference.tolerance.upper, label = "Observed rate", expected.label = "upper threshold on rate") +}) + +# +# Done +# + +# context("ds.asDataMatrix::perf::shutdown") +disconnect.studies.dataset.cnsim() +# context("ds.asDataMatrix::perf::done") diff --git a/tests/testthat/test-perf-ds.asLogical.R b/tests/testthat/test-perf-ds.asLogical.R new file mode 100644 index 000000000..f3c4d43d9 --- /dev/null +++ b/tests/testthat/test-perf-ds.asLogical.R @@ -0,0 +1,58 @@ +#------------------------------------------------------------------------------- +# +# This program and the accompanying materials +# are made available under the terms of the GNU Public License v3.0. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . +#------------------------------------------------------------------------------- + +# +# Set up +# + +# context("ds.asLogical::perf::setup") +connect.studies.dataset.cnsim(list("LAB_TSC", "LAB_TRIG")) + +# +# Tests +# + +# context("ds.asLogical::perf:0") +test_that("combine - performance", { + .durationSec <- 30 # seconds + .count <- 0 + .start.time <- Sys.time() + .current.time <- .start.time + + while (difftime(.current.time, .start.time, units = "secs")[[1]] < .durationSec) { + ds.asLogical("D$LAB_TSC", newobj = "perf.newobj") + + .count <- .count + 1 + .current.time <- Sys.time() + } + + .current.rate <- .count / (difftime(.current.time, .start.time, units = "secs")[[1]]) + .reference.rate <- perf.reference.rate("ds.asLogical::perf::0") + if (any(length(.reference.rate) == 0) || any(is.null(.reference.rate))) { + print(paste("ds.asLogical::perf::0 ", .current.rate, 0.5, 2.0)) + perf.reference.save("ds.asLogical::perf::0", .current.rate, 0.5, 2.0) + } else { + print(paste("ds.asLogical::perf::0 ", format(.current.rate, digits = 8), ", ", format(100.0 * .current.rate / .reference.rate, digits = 4), "%", sep = '')) + } + + .reference.rate <- perf.reference.rate("ds.asLogical::perf::0") + .reference.tolerance.lower <- perf.reference.tolerance.lower("ds.asLogical::perf::0") + .reference.tolerance.upper <- perf.reference.tolerance.upper("ds.asLogical::perf::0") + + expect_gt(.current.rate, .reference.rate * .reference.tolerance.lower, label = "Observed rate", expected.label = "lower threshold on rate") + expect_lt(.current.rate, .reference.rate * .reference.tolerance.upper, label = "Observed rate", expected.label = "upper threshold on rate") +}) + +# +# Done +# + +# context("ds.asLogical::perf::shutdown") +disconnect.studies.dataset.cnsim() +# context("ds.asLogical::perf::done") \ No newline at end of file diff --git a/tests/testthat/test-perf-ds.asMatrix.R b/tests/testthat/test-perf-ds.asMatrix.R new file mode 100644 index 000000000..a07e9605a --- /dev/null +++ b/tests/testthat/test-perf-ds.asMatrix.R @@ -0,0 +1,58 @@ +#------------------------------------------------------------------------------- +# +# This program and the accompanying materials +# are made available under the terms of the GNU Public License v3.0. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . +#------------------------------------------------------------------------------- + +# +# Set up +# + +# context("ds.asMatrix::perf::setup") +connect.studies.dataset.cnsim(list("LAB_TSC", "LAB_TRIG")) + +# +# Tests +# + +# context("ds.asMatrix::perf:0") +test_that("combine - performance", { + .durationSec <- 30 # seconds + .count <- 0 + .start.time <- Sys.time() + .current.time <- .start.time + + while (difftime(.current.time, .start.time, units = "secs")[[1]] < .durationSec) { + ds.asMatrix(x.name = "D$LAB_TSC", newobj = "perf.newobj") + + .count <- .count + 1 + .current.time <- Sys.time() + } + + .current.rate <- .count / (difftime(.current.time, .start.time, units = "secs")[[1]]) + .reference.rate <- perf.reference.rate("ds.asMatrix::perf::0") + if (any(length(.reference.rate) == 0) || any(is.null(.reference.rate))) { + print(paste("ds.asMatrix::perf::0 ", .current.rate, 0.5, 2.0)) + perf.reference.save("ds.asMatrix::perf::0", .current.rate, 0.5, 2.0) + } else { + print(paste("ds.asMatrix::perf::0 ", format(.current.rate, digits = 8), ", ", format(100.0 * .current.rate / .reference.rate, digits = 4), "%", sep = '')) + } + + .reference.rate <- perf.reference.rate("ds.asMatrix::perf::0") + .reference.tolerance.lower <- perf.reference.tolerance.lower("ds.asMatrix::perf::0") + .reference.tolerance.upper <- perf.reference.tolerance.upper("ds.asMatrix::perf::0") + + expect_gt(.current.rate, .reference.rate * .reference.tolerance.lower, label = "Observed rate", expected.label = "lower threshold on rate") + expect_lt(.current.rate, .reference.rate * .reference.tolerance.upper, label = "Observed rate", expected.label = "upper threshold on rate") +}) + +# +# Done +# + +# context("ds.asMatrix::perf::shutdown") +disconnect.studies.dataset.cnsim() +# context("ds.asMatrix::perf::done") \ No newline at end of file diff --git a/tests/testthat/test-perf-ds.exp.R b/tests/testthat/test-perf-ds.exp.R new file mode 100644 index 000000000..8ab5b3d95 --- /dev/null +++ b/tests/testthat/test-perf-ds.exp.R @@ -0,0 +1,58 @@ +#------------------------------------------------------------------------------- +# +# This program and the accompanying materials +# are made available under the terms of the GNU Public License v3.0. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . +#------------------------------------------------------------------------------- + +# +# Set up +# + +# context("ds.exp::perf::setup") +connect.studies.dataset.cnsim(list("LAB_TSC", "LAB_TRIG")) + +# +# Tests +# + +# context("ds.exp::perf:0") +test_that("combine - performance", { + .durationSec <- 30 # seconds + .count <- 0 + .start.time <- Sys.time() + .current.time <- .start.time + + while (difftime(.current.time, .start.time, units = "secs")[[1]] < .durationSec) { + ds.exp("D$LAB_TSC", newobj = "perf.newobj") + + .count <- .count + 1 + .current.time <- Sys.time() + } + + .current.rate <- .count / (difftime(.current.time, .start.time, units = "secs")[[1]]) + .reference.rate <- perf.reference.rate("ds.exp::perf::0") + if (any(length(.reference.rate) == 0) || any(is.null(.reference.rate))) { + print(paste("ds.exp::perf::0 ", .current.rate, 0.5, 2.0)) + perf.reference.save("ds.exp::perf::0", .current.rate, 0.5, 2.0) + } else { + print(paste("ds.exp::perf::0 ", format(.current.rate, digits = 8), ", ", format(100.0 * .current.rate / .reference.rate, digits = 4), "%", sep = '')) + } + + .reference.rate <- perf.reference.rate("ds.exp::perf::0") + .reference.tolerance.lower <- perf.reference.tolerance.lower("ds.exp::perf::0") + .reference.tolerance.upper <- perf.reference.tolerance.upper("ds.exp::perf::0") + + expect_gt(.current.rate, .reference.rate * .reference.tolerance.lower, label = "Observed rate", expected.label = "lower threshold on rate") + expect_lt(.current.rate, .reference.rate * .reference.tolerance.upper, label = "Observed rate", expected.label = "upper threshold on rate") +}) + +# +# Done +# + +# context("ds.exp::perf::shutdown") +disconnect.studies.dataset.cnsim() +# context("ds.exp::perf::done") diff --git a/tests/testthat/test-perf-ds.log.R b/tests/testthat/test-perf-ds.log.R new file mode 100644 index 000000000..96ab0be27 --- /dev/null +++ b/tests/testthat/test-perf-ds.log.R @@ -0,0 +1,58 @@ +#------------------------------------------------------------------------------- +# +# This program and the accompanying materials +# are made available under the terms of the GNU Public License v3.0. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . +#------------------------------------------------------------------------------- + +# +# Set up +# + +# context("ds.log::perf::setup") +connect.studies.dataset.cnsim(list("LAB_TSC", "LAB_TRIG")) + +# +# Tests +# + +# context("ds.log::perf:0") +test_that("combine - performance", { + .durationSec <- 30 # seconds + .count <- 0 + .start.time <- Sys.time() + .current.time <- .start.time + + while (difftime(.current.time, .start.time, units = "secs")[[1]] < .durationSec) { + ds.log("D$LAB_TSC", newobj = "perf.newobj") + + .count <- .count + 1 + .current.time <- Sys.time() + } + + .current.rate <- .count / (difftime(.current.time, .start.time, units = "secs")[[1]]) + .reference.rate <- perf.reference.rate("ds.log::perf::0") + if (any(length(.reference.rate) == 0) || any(is.null(.reference.rate))) { + print(paste("ds.log::perf::0 ", .current.rate, 0.5, 2.0)) + perf.reference.save("ds.log::perf::0", .current.rate, 0.5, 2.0) + } else { + print(paste("ds.log::perf::0 ", format(.current.rate, digits = 8), ", ", format(100.0 * .current.rate / .reference.rate, digits = 4), "%", sep = '')) + } + + .reference.rate <- perf.reference.rate("ds.log::perf::0") + .reference.tolerance.lower <- perf.reference.tolerance.lower("ds.log::perf::0") + .reference.tolerance.upper <- perf.reference.tolerance.upper("ds.log::perf::0") + + expect_gt(.current.rate, .reference.rate * .reference.tolerance.lower, label = "Observed rate", expected.label = "lower threshold on rate") + expect_lt(.current.rate, .reference.rate * .reference.tolerance.upper, label = "Observed rate", expected.label = "upper threshold on rate") +}) + +# +# Done +# + +# context("ds.log::perf::shutdown") +disconnect.studies.dataset.cnsim() +# context("ds.log::perf::done") diff --git a/tests/testthat/test-perf-ds.sqrt.R b/tests/testthat/test-perf-ds.sqrt.R new file mode 100644 index 000000000..dffdbbb64 --- /dev/null +++ b/tests/testthat/test-perf-ds.sqrt.R @@ -0,0 +1,58 @@ +#------------------------------------------------------------------------------- +# +# This program and the accompanying materials +# are made available under the terms of the GNU Public License v3.0. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . +#------------------------------------------------------------------------------- + +# +# Set up +# + +# context("ds.sqrt::perf::setup") +connect.studies.dataset.cnsim(list("LAB_TSC", "LAB_TRIG")) + +# +# Tests +# + +# context("ds.sqrt::perf:0") +test_that("combine - performance", { + .durationSec <- 30 # seconds + .count <- 0 + .start.time <- Sys.time() + .current.time <- .start.time + + while (difftime(.current.time, .start.time, units = "secs")[[1]] < .durationSec) { + ds.sqrt("D$LAB_TSC", newobj = "perf.newobj") + + .count <- .count + 1 + .current.time <- Sys.time() + } + + .current.rate <- .count / (difftime(.current.time, .start.time, units = "secs")[[1]]) + .reference.rate <- perf.reference.rate("ds.sqrt::perf::0") + if (any(length(.reference.rate) == 0) || any(is.null(.reference.rate))) { + print(paste("ds.sqrt::perf::0 ", .current.rate, 0.5, 2.0)) + perf.reference.save("ds.sqrt::perf::0", .current.rate, 0.5, 2.0) + } else { + print(paste("ds.sqrt::perf::0 ", format(.current.rate, digits = 8), ", ", format(100.0 * .current.rate / .reference.rate, digits = 4), "%", sep = '')) + } + + .reference.rate <- perf.reference.rate("ds.sqrt::perf::0") + .reference.tolerance.lower <- perf.reference.tolerance.lower("ds.sqrt::perf::0") + .reference.tolerance.upper <- perf.reference.tolerance.upper("ds.sqrt::perf::0") + + expect_gt(.current.rate, .reference.rate * .reference.tolerance.lower, label = "Observed rate", expected.label = "lower threshold on rate") + expect_lt(.current.rate, .reference.rate * .reference.tolerance.upper, label = "Observed rate", expected.label = "upper threshold on rate") +}) + +# +# Done +# + +# context("ds.sqrt::perf::shutdown") +disconnect.studies.dataset.cnsim() +# context("ds.sqrt::perf::done") diff --git a/tests/testthat/test-smk-ds.abs.R b/tests/testthat/test-smk-ds.abs.R index b64b313bf..e35c3b0dd 100644 --- a/tests/testthat/test-smk-ds.abs.R +++ b/tests/testthat/test-smk-ds.abs.R @@ -27,9 +27,7 @@ test_that("setup", { # context("ds.abs::smk") test_that("simple c", { - res <- ds.abs("D$LAB_TSC", newobj = "abs.newobj") - - expect_true(is.null(res)) + expect_silent(ds.abs("D$LAB_TSC", newobj = "abs.newobj")) res.length <- ds.length("abs.newobj") diff --git a/tests/testthat/test-smk-ds.asCharacter.R b/tests/testthat/test-smk-ds.asCharacter.R index ae8b7e60c..09e13e0e2 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") + expect_silent(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 25ef3736a..ea6068280 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") + expect_silent(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 1ef25fbf0..ee841172f 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") + expect_silent(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.asList.R b/tests/testthat/test-smk-ds.asList.R index 9fbcfd425..7e1987456 100644 --- a/tests/testthat/test-smk-ds.asList.R +++ b/tests/testthat/test-smk-ds.asList.R @@ -27,18 +27,12 @@ test_that("setup", { # context("ds.asList::smk::simple test") test_that("simple test", { - res <- ds.asList(x.name="D$GENDER") - - expect_length(res, 3) - expect_length(res$sim1, 2) - expect_equal(res$sim1$return.message, "New object created") - expect_equal(res$sim1$class.of.newobj, "Class of is 'list'") - expect_length(res$sim2, 2) - expect_equal(res$sim2$return.message, "New object created") - expect_equal(res$sim2$class.of.newobj, "Class of is 'list'") - expect_length(res$sim3, 2) - expect_equal(res$sim3$return.message, "New object created") - expect_equal(res$sim3$class.of.newobj, "Class of is 'list'") + expect_silent(ds.asList(x.name="D$GENDER")) + + res.class <- ds.class("aslist.newobj") + expect_equal(res.class$sim1, "list") + expect_equal(res.class$sim2, "list") + expect_equal(res.class$sim3, "list") }) # diff --git a/tests/testthat/test-smk-ds.asLogical.R b/tests/testthat/test-smk-ds.asLogical.R index 6781beab6..34ad87c87 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") + expect_silent(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 b942425b7..aa05040e2 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") + expect_silent(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 e942c82af..6c5c98e20 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") + expect_silent(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") }) # diff --git a/tests/testthat/test-smk-ds.exp.R b/tests/testthat/test-smk-ds.exp.R index fa850fb81..6a7f7b501 100644 --- a/tests/testthat/test-smk-ds.exp.R +++ b/tests/testthat/test-smk-ds.exp.R @@ -27,19 +27,7 @@ test_that("setup", { # context("ds.exp::smk") test_that("simple exp", { - res1 <- ds.exp("D$LAB_TSC", newobj="exp1_obj") - - expect_length(res1, 0) - - res1_exists <- ds.exists("exp1_obj") - - expect_length(res1_exists, 3) - expect_length(res1_exists$sim1, 1) - expect_equal(res1_exists$sim1, TRUE) - expect_length(res1_exists$sim2, 1) - expect_equal(res1_exists$sim2, TRUE) - expect_length(res1_exists$sim3, 1) - expect_equal(res1_exists$sim3, TRUE) + expect_silent(ds.exp("D$LAB_TSC", newobj="exp1_obj")) res1_class <- ds.class("exp1_obj") @@ -53,21 +41,9 @@ test_that("simple exp", { res_as <- ds.asInteger("D$LAB_TSC", newobj="new_data") - res2 <- ds.exp("new_data", newobj="exp2_obj") - - expect_length(res2, 0) - - res2_exists <- ds.exists("exp2_obj") - - expect_length(res2_exists, 3) - expect_length(res2_exists$sim1, 1) - expect_equal(res2_exists$sim1, TRUE) - expect_length(res2_exists$sim2, 1) - expect_equal(res2_exists$sim2, TRUE) - expect_length(res2_exists$sim3, 1) - expect_equal(res2_exists$sim3, TRUE) + expect_silent(ds.exp("new_data", newobj="exp2_obj")) - res2_class <- ds.class("exp1_obj") + res2_class <- ds.class("exp2_obj") expect_length(res2_class, 3) expect_length(res2_class$sim1, 1) diff --git a/tests/testthat/test-smk-ds.listServersideFunctions.R b/tests/testthat/test-smk-ds.listServersideFunctions.R index 0e3221fb2..df0d5fe49 100644 --- a/tests/testthat/test-smk-ds.listServersideFunctions.R +++ b/tests/testthat/test-smk-ds.listServersideFunctions.R @@ -26,8 +26,8 @@ test_that("check results", { "asFactorDS2", "asFactorSimpleDS", "asIntegerDS", "asListDS", "asLogicalDS", "asMatrixDS", "asNumericDS", "asin", "atan", "attach", "blackBoxRanksDS", "blackBoxRanksDS", "boxPlotGG_data_TreatmentDS", "boxPlotGG_data_Treatment_numericDS", "cDS", "cbindDS", "changeRefGroupDS", "completeCasesDS", "complete.cases", "dataFrameDS", "dataFrameFillDS", "dataFrameSortDS", - "dataFrameSubsetDS2", "dataFrameDS", "dmtC2SDS", "exp", "glmPredictDS.as", "glmSLMADS.assign", "glmSummaryDS.as", "glmerSLMADS.assign", - "lexisDS2", "lexisDS3", "list", "listDS", "log", "lsplineDS", + "dataFrameSubsetDS2", "dataFrameDS", "dmtC2SDS", "expDS", "glmPredictDS.as", "glmSLMADS.assign", "glmSummaryDS.as", "glmerSLMADS.assign", + "lexisDS2", "lexisDS3", "list", "listDS", "logDS", "lsplineDS", "matrixDS", "matrixDetDS2", "matrixDiagDS", "matrixDimnamesDS", "matrixInvertDS", "matrixMultDS", "matrixTransposeDS", "mergeDS", "nsDS", "qlsplineDS", "rBinomDS", "rNormDS", "rPoisDS", "rUnifDS", "ranksSecureDS2", "ranksSecureDS4", "ranksSecureDS5", "rbindDS", "reShapeDS", "recodeLevelsDS", "recodeValuesDS", "repDS", diff --git a/tests/testthat/test-smk-ds.log.R b/tests/testthat/test-smk-ds.log.R index c857408db..3d4699ac2 100644 --- a/tests/testthat/test-smk-ds.log.R +++ b/tests/testthat/test-smk-ds.log.R @@ -27,19 +27,7 @@ test_that("setup", { # context("ds.log::smk") test_that("simple log", { - res1 <- ds.log("D$LAB_TSC", newobj="log1_obj") - - expect_length(res1, 0) - - res1_exists <- ds.exists("log1_obj") - - expect_length(res1_exists, 3) - expect_length(res1_exists$sim1, 1) - expect_equal(res1_exists$sim1, TRUE) - expect_length(res1_exists$sim2, 1) - expect_equal(res1_exists$sim2, TRUE) - expect_length(res1_exists$sim3, 1) - expect_equal(res1_exists$sim3, TRUE) + expect_silent(ds.log("D$LAB_TSC", newobj="log1_obj")) res1_class <- ds.class("log1_obj") @@ -53,19 +41,7 @@ test_that("simple log", { res_as <- ds.asInteger("D$LAB_TSC", newobj="new_data") - res2 <- ds.log("new_data", newobj="log2_obj") - - expect_length(res2, 0) - - res2_exists <- ds.exists("log2_obj") - - expect_length(res2_exists, 3) - expect_length(res2_exists$sim1, 1) - expect_equal(res2_exists$sim1, TRUE) - expect_length(res2_exists$sim2, 1) - expect_equal(res2_exists$sim2, TRUE) - expect_length(res2_exists$sim3, 1) - expect_equal(res2_exists$sim3, TRUE) + expect_silent(ds.log("new_data", newobj="log2_obj")) res2_class <- ds.class("log2_obj") diff --git a/tests/testthat/test-smk-ds.sqrt.R b/tests/testthat/test-smk-ds.sqrt.R index ccb50c0ca..de6e3336f 100644 --- a/tests/testthat/test-smk-ds.sqrt.R +++ b/tests/testthat/test-smk-ds.sqrt.R @@ -27,9 +27,7 @@ test_that("setup", { # context("ds.sqrt::smk") test_that("simple c", { - res <- ds.sqrt("D$LAB_TSC", newobj = "sqrt.newobj") - - expect_true(is.null(res)) + expect_silent(ds.sqrt("D$LAB_TSC", newobj = "sqrt.newobj")) res.length <- ds.length("sqrt.newobj") diff --git a/tests/testthat/test-smk_dgr-ds.asCharacter.R b/tests/testthat/test-smk_dgr-ds.asCharacter.R index 48a2fbd12..224c86161 100644 --- a/tests/testthat/test-smk_dgr-ds.asCharacter.R +++ b/tests/testthat/test-smk_dgr-ds.asCharacter.R @@ -30,10 +30,13 @@ test_that("setup", { # context("ds.asCharacter::smk_dgr::simple test") test_that("simple test", { res <- ds.asCharacter("D$LAB_TSC") + expect_equal(length(res), 0) - 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") + newobj <- ds.DANGERvarsEXTRACT('ascharacter.newobj') + + expect_equal(length(newobj), 2) + expect_true(all(c("list") %in% class(newobj[[1]]))) + expect_true(all(c("data.frame") %in% class(newobj[[2]]))) }) #