diff --git a/R/ds.matrix.R b/R/ds.matrix.R index 69ad3a72..5a0ed315 100644 --- a/R/ds.matrix.R +++ b/R/ds.matrix.R @@ -48,11 +48,9 @@ #' @param datasources a list of \code{\link[DSI]{DSConnection-class}} #' 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.matrix} returns the created matrix which is written on the server-side. -#' In addition, two validity messages are returned -#' indicating whether the new matrix has been created in each data source and if so whether -#' it is in a valid form. +#' @return \code{ds.matrix} returns the created matrix which is written on the server-side. #' @author DataSHIELD Development Team +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' @examples #' \dontrun{ #' @@ -147,15 +145,7 @@ ds.matrix <- function(mdata = NA, from="clientside.scalar", nrows.scalar=NULL, ncols.scalar=NULL, byrow = FALSE, dimnames = 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) # check if a value has been provided for mdata if(is.null(mdata)){ @@ -208,85 +198,5 @@ ds.matrix <- function(mdata = NA, from="clientside.scalar", nrows.scalar=NULL, n -############################################################################################################# -#DataSHIELD CLIENTSIDE MODULE: CHECK KEY DATA OBJECTS SUCCESSFULLY CREATED # - # -#SET APPROPRIATE PARAMETERS FOR THIS PARTICULAR FUNCTION # -test.obj.name<-newobj # - # -#TRACER # -#return(test.obj.name) # -#} # - # - # -# 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.matrix diff --git a/R/ds.matrixDet.R b/R/ds.matrixDet.R index 5fcd81a5..2f4d4960 100644 --- a/R/ds.matrixDet.R +++ b/R/ds.matrixDet.R @@ -16,12 +16,10 @@ #' @param datasources a list of \code{\link[DSI]{DSConnection-class}} #' 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.matrixDet} returns the determinant of an existing matrix on the server-side. -#' The created new object is stored on the server-side. -#' Also, two validity messages are returned -#' indicating whether the matrix has been created in each data source and if so whether -#' it is in a valid form. +#' @return \code{ds.matrixDet} returns the determinant of an existing matrix on the server-side. +#' The created new object is stored on the server-side. #' @author DataSHIELD Development Team +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' @examples #' \dontrun{ #' @@ -83,23 +81,12 @@ #' ds.matrixDet<-function(M1=NULL, newobj=NULL, logarithm=FALSE, 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) # check if user has provided the name of matrix representing M1 if(is.null(M1)){ return("Error: Please provide the name of the matrix representing M1") } - - # check if the input object is defined in all the studies - isDefined(datasources, M1) # if no value or invalid value specified for logarithm, then specify a default if(is.null(logarithm)){ @@ -119,85 +106,5 @@ ds.matrixDet<-function(M1=NULL, newobj=NULL, logarithm=FALSE, datasources=NULL){ calltext <- call("matrixDetDS2", M1, logarithm) 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 # - # -#TRACER # -#return(test.obj.name) # -#} # - # - # -# 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 CORRECTLY MODULE # -############################################################################################################# - } #ds.matrixDet diff --git a/R/ds.matrixDet.report.R b/R/ds.matrixDet.report.R index be21aaa7..4d914d5c 100644 --- a/R/ds.matrixDet.report.R +++ b/R/ds.matrixDet.report.R @@ -18,6 +18,7 @@ #' @return \code{ds.matrixDet.report} returns to the client-side #' the determinant of a matrix that is stored on the server-side. #' @author DataSHIELD Development Team +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' @examples #' \dontrun{ #' @@ -76,15 +77,7 @@ #' ds.matrixDet.report<-function(M1=NULL, logarithm=FALSE, 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) # check if user has provided the name of matrix representing M1 if(is.null(M1)){ diff --git a/R/ds.matrixDiag.R b/R/ds.matrixDiag.R index 1ea1341a..7b78d9ba 100644 --- a/R/ds.matrixDiag.R +++ b/R/ds.matrixDiag.R @@ -56,11 +56,9 @@ #' @param datasources a list of \code{\link[DSI]{DSConnection-class}} #' 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.matrixDiag} returns to the server-side the square matrix diagonal. -#' Also, two validity messages are returned -#' indicating whether the new object has been created in each data source and if so whether -#' it is in a valid form. +#' @return \code{ds.matrixDiag} returns to the server-side the square matrix diagonal. #' @author DataSHIELD Development Team +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' @examples #' \dontrun{ #' @@ -177,15 +175,7 @@ #' ds.matrixDiag<-function(x1=NULL, aim=NULL, nrows.scalar=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) # check if a value has been provided for x1 if(is.null(x1)){ @@ -235,85 +225,5 @@ ds.matrixDiag<-function(x1=NULL, aim=NULL, nrows.scalar=NULL, newobj=NULL, datas 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 # - # -#TRACER # -#return(test.obj.name) # -#} # - # - # -# 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.matrixDiag diff --git a/R/ds.matrixDimnames.R b/R/ds.matrixDimnames.R index 6f4a37ea..be7cb169 100644 --- a/R/ds.matrixDimnames.R +++ b/R/ds.matrixDimnames.R @@ -15,11 +15,9 @@ #' 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.matrixDimnames} returns to the server-side -#' the matrix with specified row and column names. -#' Also, two validity messages are returned to the client-side -#' indicating the new object that has been created in each data source and if so whether -#' it is in a valid form. +#' the matrix with specified row and column names. #' @author DataSHIELD Development Team +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' @examples #' \dontrun{ #' @@ -84,15 +82,8 @@ #' @export ds.matrixDimnames<-function(M1=NULL, dimnames=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) # check if user has provided the name of matrix representing M1 if(is.null(M1)){ @@ -110,85 +101,5 @@ ds.matrixDimnames<-function(M1=NULL, dimnames=NULL, newobj=NULL, datasources=NUL calltext <- call("matrixDimnamesDS", M1, dimnames) 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 # - # -#TRACER # -#return(test.obj.name) # -#} # - # - # -# 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.matrixDimnames diff --git a/R/ds.matrixInvert.R b/R/ds.matrixInvert.R index 8cc3c447..d92591c4 100644 --- a/R/ds.matrixInvert.R +++ b/R/ds.matrixInvert.R @@ -12,11 +12,9 @@ #' @param datasources a list of \code{\link[DSI]{DSConnection-class}} #' 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.matrixInvert} returns to the server-side the inverts square matrix. -#' Also, two validity messages are returned to the client-side -#' indicating whether the new object has been created in each data source and if so whether -#' it is in a valid form. +#' @return \code{ds.matrixInvert} returns to the server-side the inverts square matrix. #' @author DataSHIELD Development Team +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' @examples #' \dontrun{ #' @@ -81,15 +79,7 @@ #' ds.matrixInvert<-function(M1=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) # check if user has provided the name of matrix representing M1 if(is.null(M1)){ @@ -105,85 +95,5 @@ ds.matrixInvert<-function(M1=NULL, newobj=NULL, datasources=NULL){ calltext <- call("matrixInvertDS", M1) 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 # - # -#TRACER # -#return(test.obj.name) # -#} # - # - # -# 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.matrixInvert diff --git a/R/ds.matrixMult.R b/R/ds.matrixMult.R index cf5349fe..35e9d711 100644 --- a/R/ds.matrixMult.R +++ b/R/ds.matrixMult.R @@ -15,12 +15,10 @@ #' @param datasources a list of \code{\link[DSI]{DSConnection-class}} #' 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.matrixMult} returns to the server-side +#' @return \code{ds.matrixMult} returns to the server-side #' the result of the two matrix multiplication. -#' Also, two validity messages are returned to the client-side -#' indicating whether the new object has been created in each data source and if so whether -#' it is in a valid form. #' @author DataSHIELD Development Team +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' #' @examples #' \dontrun{ @@ -96,15 +94,7 @@ #' ds.matrixMult<-function(M1=NULL, M2=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) # check if user has provided the name of matrix representing M1 if(is.null(M1)){ @@ -129,85 +119,5 @@ ds.matrixMult<-function(M1=NULL, M2=NULL, newobj=NULL, datasources=NULL){ calltext <- call("matrixMultDS", M1, M2) 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 # - # -#TRACER # -#return(test.obj.name) # -#} # - # - # -# 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.matrixMult diff --git a/R/ds.matrixTranspose.R b/R/ds.matrixTranspose.R index bbd73a1a..4de06471 100644 --- a/R/ds.matrixTranspose.R +++ b/R/ds.matrixTranspose.R @@ -15,11 +15,9 @@ #' @param datasources a list of \code{\link[DSI]{DSConnection-class}} #' 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.matrixTranspose} returns to the server-side the transpose matrix. -#' Also, two validity messages are returned to the client-side -#' indicating whether the new object has been created in each data source and if so whether -#' it is in a valid form. +#' @return \code{ds.matrixTranspose} returns to the server-side the transpose matrix. #' @author DataSHIELD Development Team +#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands #' @examples #' \dontrun{ #' @@ -84,15 +82,7 @@ #' ds.matrixTranspose<-function(M1=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) # check if user has provided the name of matrix representing M1 if(is.null(M1)){ @@ -108,85 +98,5 @@ ds.matrixTranspose<-function(M1=NULL, newobj=NULL, datasources=NULL){ calltext <- call("matrixTransposeDS", M1) 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 # - # -#TRACER # -#return(test.obj.name) # -#} # - # - # -# 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.matrixTranspose diff --git a/dsBase_7.0.0-permissive.tar.gz b/dsBase_7.0.0-permissive.tar.gz index 359fcc73..38b61965 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.matrix.Rd b/man/ds.matrix.Rd index d60a9183..c005e7ad 100644 --- a/man/ds.matrix.Rd +++ b/man/ds.matrix.Rd @@ -48,10 +48,7 @@ objects obtained after login. If the \code{datasources} argument is not specifie the default set of connections will be used: see \code{\link[DSI]{datashield.connections_default}}.} } \value{ -\code{ds.matrix} returns the created matrix which is written on the server-side. -In addition, two validity messages are returned -indicating whether the new matrix has been created in each data source and if so whether -it is in a valid form. +\code{ds.matrix} returns the created matrix which is written on the server-side. } \description{ Creates a matrix on the server-side @@ -174,4 +171,6 @@ Server function called: \code{matrixDS} } \author{ DataSHIELD Development Team + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/man/ds.matrixDet.Rd b/man/ds.matrixDet.Rd index e827e815..6870ae60 100644 --- a/man/ds.matrixDet.Rd +++ b/man/ds.matrixDet.Rd @@ -20,11 +20,8 @@ objects obtained after login. If the \code{datasources} argument is not specifie the default set of connections will be used: see \code{\link[DSI]{datashield.connections_default}}.} } \value{ -\code{ds.matrixDet} returns the determinant of an existing matrix on the server-side. -The created new object is stored on the server-side. -Also, two validity messages are returned -indicating whether the matrix has been created in each data source and if so whether -it is in a valid form. +\code{ds.matrixDet} returns the determinant of an existing matrix on the server-side. +The created new object is stored on the server-side. } \description{ Calculates the determinant of a square matrix that is @@ -98,4 +95,6 @@ Server function called: \code{matrixDetDS2} } \author{ DataSHIELD Development Team + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/man/ds.matrixDet.report.Rd b/man/ds.matrixDet.report.Rd index 0a5c021d..c9f039f0 100644 --- a/man/ds.matrixDet.report.Rd +++ b/man/ds.matrixDet.report.Rd @@ -90,4 +90,6 @@ Server function called: \code{matrixDetDS1} } \author{ DataSHIELD Development Team + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/man/ds.matrixDiag.Rd b/man/ds.matrixDiag.Rd index 268e5148..ab9385f1 100644 --- a/man/ds.matrixDiag.Rd +++ b/man/ds.matrixDiag.Rd @@ -40,10 +40,7 @@ objects obtained after login. If the \code{datasources} argument is not specifie the default set of connections will be used: see \code{\link[DSI]{datashield.connections_default}}.} } \value{ -\code{ds.matrixDiag} returns to the server-side the square matrix diagonal. -Also, two validity messages are returned -indicating whether the new object has been created in each data source and if so whether -it is in a valid form. +\code{ds.matrixDiag} returns to the server-side the square matrix diagonal. } \description{ Extracts the diagonal vector from a square matrix or @@ -200,4 +197,6 @@ Server function called: \code{matrixDiagDS} } \author{ DataSHIELD Development Team + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/man/ds.matrixDimnames.Rd b/man/ds.matrixDimnames.Rd index af56f76a..86311432 100644 --- a/man/ds.matrixDimnames.Rd +++ b/man/ds.matrixDimnames.Rd @@ -28,10 +28,7 @@ the default set of connections will be used: see \code{\link[DSI]{datashield.con } \value{ \code{ds.matrixDimnames} returns to the server-side -the matrix with specified row and column names. -Also, two validity messages are returned to the client-side -indicating the new object that has been created in each data source and if so whether -it is in a valid form. +the matrix with specified row and column names. } \description{ Adds the row names, the column names or both to @@ -106,4 +103,6 @@ Server function called: \code{matrixDimnamesDS} } \author{ DataSHIELD Development Team + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/man/ds.matrixInvert.Rd b/man/ds.matrixInvert.Rd index 842baee4..6159b4f3 100644 --- a/man/ds.matrixInvert.Rd +++ b/man/ds.matrixInvert.Rd @@ -18,10 +18,7 @@ objects obtained after login. If the \code{datasources} argument is not specifie the default set of connections will be used: see \code{\link[DSI]{datashield.connections_default}}.} } \value{ -\code{ds.matrixInvert} returns to the server-side the inverts square matrix. -Also, two validity messages are returned to the client-side -indicating whether the new object has been created in each data source and if so whether -it is in a valid form. +\code{ds.matrixInvert} returns to the server-side the inverts square matrix. } \description{ Inverts a square matrix and writes the output to the server-side @@ -96,4 +93,6 @@ Server function called: \code{matrixInvertDS} } \author{ DataSHIELD Development Team + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/man/ds.matrixMult.Rd b/man/ds.matrixMult.Rd index 136db26d..e43c83d4 100644 --- a/man/ds.matrixMult.Rd +++ b/man/ds.matrixMult.Rd @@ -19,11 +19,8 @@ objects obtained after login. If the \code{datasources} argument is not specifie the default set of connections will be used: see \code{\link[DSI]{datashield.connections_default}}.} } \value{ -\code{ds.matrixMult} returns to the server-side +\code{ds.matrixMult} returns to the server-side the result of the two matrix multiplication. -Also, two validity messages are returned to the client-side -indicating whether the new object has been created in each data source and if so whether -it is in a valid form. } \description{ Calculates the matrix product of two matrices and @@ -110,4 +107,6 @@ Server function called: \code{matrixMultDS} } \author{ DataSHIELD Development Team + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/man/ds.matrixTranspose.Rd b/man/ds.matrixTranspose.Rd index 67e06867..55fcd239 100644 --- a/man/ds.matrixTranspose.Rd +++ b/man/ds.matrixTranspose.Rd @@ -18,10 +18,7 @@ objects obtained after login. If the \code{datasources} argument is not specifie the default set of connections will be used: see \code{\link[DSI]{datashield.connections_default}}.} } \value{ -\code{ds.matrixTranspose} returns to the server-side the transpose matrix. -Also, two validity messages are returned to the client-side -indicating whether the new object has been created in each data source and if so whether -it is in a valid form. +\code{ds.matrixTranspose} returns to the server-side the transpose matrix. } \description{ Transposes a matrix and writes the output to the server-side @@ -98,4 +95,6 @@ Server function called: \code{matrixTransposeDS} } \author{ DataSHIELD Development Team + +Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands } diff --git a/tests/testthat/test-perf-ds.matrix.R b/tests/testthat/test-perf-ds.matrix.R new file mode 100644 index 00000000..8af68bfb --- /dev/null +++ b/tests/testthat/test-perf-ds.matrix.R @@ -0,0 +1,50 @@ + +# +# Set up +# + +# context("ds.matrix::perf::setup") +connect.studies.dataset.cnsim(list("LAB_TSC")) + +# +# Tests +# + +# context("ds.matrix::perf::0") +test_that("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.matrix(mdata=0, nrows.scalar=3, ncols.scalar=3, newobj="matrix.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.matrix::perf::0") + if (any(length(.reference.rate) == 0) || any(is.null(.reference.rate))) { + print(paste("ds.matrix::perf::0 ", .current.rate, 0.5, 2.0)) + perf.reference.save("ds.matrix::perf::0", .current.rate, 0.5, 2.0) + } else { + print(paste("ds.matrix::perf::0 ", format(.current.rate, digits = 8), ", ", format(100.0 * .current.rate / .reference.rate, digits = 4), "%", sep = '')) + } + + .reference.rate <- perf.reference.rate("ds.matrix::perf::0") + .reference.tolerance.lower <- perf.reference.tolerance.lower("ds.matrix::perf::0") + .reference.tolerance.upper <- perf.reference.tolerance.upper("ds.matrix::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.matrix::perf::shutdown") +disconnect.studies.dataset.cnsim() +# context("ds.matrix::perf::done") diff --git a/tests/testthat/test-perf-ds.matrixDet.R b/tests/testthat/test-perf-ds.matrixDet.R new file mode 100644 index 00000000..68b8285e --- /dev/null +++ b/tests/testthat/test-perf-ds.matrixDet.R @@ -0,0 +1,51 @@ + +# +# Set up +# + +# context("ds.matrixDet::perf::setup") +connect.studies.dataset.cnsim(list("LAB_TSC")) + +# +# Tests +# + +# context("ds.matrixDet::perf::0") +test_that("performance", { + ds.matrix(mdata=0, nrows.scalar=3, ncols.scalar=3, newobj="matrix.newobj") + .durationSec <- 30 # seconds + .count <- 0 + .start.time <- Sys.time() + .current.time <- .start.time + + while (difftime(.current.time, .start.time, units = "secs")[[1]] < .durationSec) { + ds.matrixDet(M1="matrix.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.matrixDet::perf::0") + if (any(length(.reference.rate) == 0) || any(is.null(.reference.rate))) { + print(paste("ds.matrixDet::perf::0 ", .current.rate, 0.5, 2.0)) + perf.reference.save("ds.matrixDet::perf::0", .current.rate, 0.5, 2.0) + } else { + print(paste("ds.matrixDet::perf::0 ", format(.current.rate, digits = 8), ", ", format(100.0 * .current.rate / .reference.rate, digits = 4), "%", sep = '')) + } + + .reference.rate <- perf.reference.rate("ds.matrixDet::perf::0") + .reference.tolerance.lower <- perf.reference.tolerance.lower("ds.matrixDet::perf::0") + .reference.tolerance.upper <- perf.reference.tolerance.upper("ds.matrixDet::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.matrixDet::perf::shutdown") +disconnect.studies.dataset.cnsim() +# context("ds.matrixDet::perf::done") diff --git a/tests/testthat/test-perf-ds.matrixDet.report.R b/tests/testthat/test-perf-ds.matrixDet.report.R new file mode 100644 index 00000000..76d2a458 --- /dev/null +++ b/tests/testthat/test-perf-ds.matrixDet.report.R @@ -0,0 +1,51 @@ + +# +# Set up +# + +# context("ds.matrixDet.report::perf::setup") +connect.studies.dataset.cnsim(list("LAB_TSC")) + +# +# Tests +# + +# context("ds.matrixDet.report::perf::0") +test_that("performance", { + ds.matrix(mdata=0, nrows.scalar=3, ncols.scalar=3, newobj="matrix.newobj") + .durationSec <- 30 # seconds + .count <- 0 + .start.time <- Sys.time() + .current.time <- .start.time + + while (difftime(.current.time, .start.time, units = "secs")[[1]] < .durationSec) { + ds.matrixDet.report(M1="matrix.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.matrixDet.report::perf::0") + if (any(length(.reference.rate) == 0) || any(is.null(.reference.rate))) { + print(paste("ds.matrixDet.report::perf::0 ", .current.rate, 0.5, 2.0)) + perf.reference.save("ds.matrixDet.report::perf::0", .current.rate, 0.5, 2.0) + } else { + print(paste("ds.matrixDet.report::perf::0 ", format(.current.rate, digits = 8), ", ", format(100.0 * .current.rate / .reference.rate, digits = 4), "%", sep = '')) + } + + .reference.rate <- perf.reference.rate("ds.matrixDet.report::perf::0") + .reference.tolerance.lower <- perf.reference.tolerance.lower("ds.matrixDet.report::perf::0") + .reference.tolerance.upper <- perf.reference.tolerance.upper("ds.matrixDet.report::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.matrixDet.report::perf::shutdown") +disconnect.studies.dataset.cnsim() +# context("ds.matrixDet.report::perf::done") diff --git a/tests/testthat/test-perf-ds.matrixDiag.R b/tests/testthat/test-perf-ds.matrixDiag.R new file mode 100644 index 00000000..f95fd815 --- /dev/null +++ b/tests/testthat/test-perf-ds.matrixDiag.R @@ -0,0 +1,51 @@ + +# +# Set up +# + +# context("ds.matrixDiag::perf::setup") +connect.studies.dataset.cnsim(list("LAB_TSC")) + +# +# Tests +# + +# context("ds.matrixDiag::perf::0") +test_that("performance", { + ds.matrix(mdata=0, nrows.scalar=3, ncols.scalar=3, newobj="matrix.newobj") + .durationSec <- 30 # seconds + .count <- 0 + .start.time <- Sys.time() + .current.time <- .start.time + + while (difftime(.current.time, .start.time, units = "secs")[[1]] < .durationSec) { + ds.matrixDiag(x1="matrix.newobj", aim="serverside.matrix.2.vector", newobj="diag.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.matrixDiag::perf::0") + if (any(length(.reference.rate) == 0) || any(is.null(.reference.rate))) { + print(paste("ds.matrixDiag::perf::0 ", .current.rate, 0.5, 2.0)) + perf.reference.save("ds.matrixDiag::perf::0", .current.rate, 0.5, 2.0) + } else { + print(paste("ds.matrixDiag::perf::0 ", format(.current.rate, digits = 8), ", ", format(100.0 * .current.rate / .reference.rate, digits = 4), "%", sep = '')) + } + + .reference.rate <- perf.reference.rate("ds.matrixDiag::perf::0") + .reference.tolerance.lower <- perf.reference.tolerance.lower("ds.matrixDiag::perf::0") + .reference.tolerance.upper <- perf.reference.tolerance.upper("ds.matrixDiag::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.matrixDiag::perf::shutdown") +disconnect.studies.dataset.cnsim() +# context("ds.matrixDiag::perf::done") diff --git a/tests/testthat/test-perf-ds.matrixDimnames.R b/tests/testthat/test-perf-ds.matrixDimnames.R new file mode 100644 index 00000000..d0ae33f6 --- /dev/null +++ b/tests/testthat/test-perf-ds.matrixDimnames.R @@ -0,0 +1,51 @@ + +# +# Set up +# + +# context("ds.matrixDimnames::perf::setup") +connect.studies.dataset.cnsim(list("LAB_TSC")) + +# +# Tests +# + +# context("ds.matrixDimnames::perf::0") +test_that("performance", { + ds.matrix(mdata=0, nrows.scalar=3, ncols.scalar=3, newobj="matrix.newobj") + .durationSec <- 30 # seconds + .count <- 0 + .start.time <- Sys.time() + .current.time <- .start.time + + while (difftime(.current.time, .start.time, units = "secs")[[1]] < .durationSec) { + ds.matrixDimnames(M1="matrix.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.matrixDimnames::perf::0") + if (any(length(.reference.rate) == 0) || any(is.null(.reference.rate))) { + print(paste("ds.matrixDimnames::perf::0 ", .current.rate, 0.5, 2.0)) + perf.reference.save("ds.matrixDimnames::perf::0", .current.rate, 0.5, 2.0) + } else { + print(paste("ds.matrixDimnames::perf::0 ", format(.current.rate, digits = 8), ", ", format(100.0 * .current.rate / .reference.rate, digits = 4), "%", sep = '')) + } + + .reference.rate <- perf.reference.rate("ds.matrixDimnames::perf::0") + .reference.tolerance.lower <- perf.reference.tolerance.lower("ds.matrixDimnames::perf::0") + .reference.tolerance.upper <- perf.reference.tolerance.upper("ds.matrixDimnames::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.matrixDimnames::perf::shutdown") +disconnect.studies.dataset.cnsim() +# context("ds.matrixDimnames::perf::done") diff --git a/tests/testthat/test-perf-ds.matrixInvert.R b/tests/testthat/test-perf-ds.matrixInvert.R new file mode 100644 index 00000000..1f8492f8 --- /dev/null +++ b/tests/testthat/test-perf-ds.matrixInvert.R @@ -0,0 +1,51 @@ + +# +# Set up +# + +# context("ds.matrixInvert::perf::setup") +connect.studies.dataset.cnsim(list("LAB_TSC")) + +# +# Tests +# + +# context("ds.matrixInvert::perf::0") +test_that("performance", { + ds.matrix(mdata=c(1,0,0,0,1,0,0,0,1), nrows.scalar=3, ncols.scalar=3, newobj="matrix.newobj") + .durationSec <- 30 # seconds + .count <- 0 + .start.time <- Sys.time() + .current.time <- .start.time + + while (difftime(.current.time, .start.time, units = "secs")[[1]] < .durationSec) { + ds.matrixInvert(M1="matrix.newobj", newobj="inv.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.matrixInvert::perf::0") + if (any(length(.reference.rate) == 0) || any(is.null(.reference.rate))) { + print(paste("ds.matrixInvert::perf::0 ", .current.rate, 0.5, 2.0)) + perf.reference.save("ds.matrixInvert::perf::0", .current.rate, 0.5, 2.0) + } else { + print(paste("ds.matrixInvert::perf::0 ", format(.current.rate, digits = 8), ", ", format(100.0 * .current.rate / .reference.rate, digits = 4), "%", sep = '')) + } + + .reference.rate <- perf.reference.rate("ds.matrixInvert::perf::0") + .reference.tolerance.lower <- perf.reference.tolerance.lower("ds.matrixInvert::perf::0") + .reference.tolerance.upper <- perf.reference.tolerance.upper("ds.matrixInvert::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.matrixInvert::perf::shutdown") +disconnect.studies.dataset.cnsim() +# context("ds.matrixInvert::perf::done") diff --git a/tests/testthat/test-perf-ds.matrixMult.R b/tests/testthat/test-perf-ds.matrixMult.R new file mode 100644 index 00000000..7abfdf00 --- /dev/null +++ b/tests/testthat/test-perf-ds.matrixMult.R @@ -0,0 +1,51 @@ + +# +# Set up +# + +# context("ds.matrixMult::perf::setup") +connect.studies.dataset.cnsim(list("LAB_TSC")) + +# +# Tests +# + +# context("ds.matrixMult::perf::0") +test_that("performance", { + ds.matrix(mdata=0, nrows.scalar=3, ncols.scalar=3, newobj="matrix.newobj") + .durationSec <- 30 # seconds + .count <- 0 + .start.time <- Sys.time() + .current.time <- .start.time + + while (difftime(.current.time, .start.time, units = "secs")[[1]] < .durationSec) { + ds.matrixMult(M1="matrix.newobj", M2="matrix.newobj", newobj="mult.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.matrixMult::perf::0") + if (any(length(.reference.rate) == 0) || any(is.null(.reference.rate))) { + print(paste("ds.matrixMult::perf::0 ", .current.rate, 0.5, 2.0)) + perf.reference.save("ds.matrixMult::perf::0", .current.rate, 0.5, 2.0) + } else { + print(paste("ds.matrixMult::perf::0 ", format(.current.rate, digits = 8), ", ", format(100.0 * .current.rate / .reference.rate, digits = 4), "%", sep = '')) + } + + .reference.rate <- perf.reference.rate("ds.matrixMult::perf::0") + .reference.tolerance.lower <- perf.reference.tolerance.lower("ds.matrixMult::perf::0") + .reference.tolerance.upper <- perf.reference.tolerance.upper("ds.matrixMult::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.matrixMult::perf::shutdown") +disconnect.studies.dataset.cnsim() +# context("ds.matrixMult::perf::done") diff --git a/tests/testthat/test-perf-ds.matrixTranspose.R b/tests/testthat/test-perf-ds.matrixTranspose.R new file mode 100644 index 00000000..2c1d58ce --- /dev/null +++ b/tests/testthat/test-perf-ds.matrixTranspose.R @@ -0,0 +1,51 @@ + +# +# Set up +# + +# context("ds.matrixTranspose::perf::setup") +connect.studies.dataset.cnsim(list("LAB_TSC")) + +# +# Tests +# + +# context("ds.matrixTranspose::perf::0") +test_that("performance", { + ds.matrix(mdata=0, nrows.scalar=3, ncols.scalar=3, newobj="matrix.newobj") + .durationSec <- 30 # seconds + .count <- 0 + .start.time <- Sys.time() + .current.time <- .start.time + + while (difftime(.current.time, .start.time, units = "secs")[[1]] < .durationSec) { + ds.matrixTranspose(M1="matrix.newobj", newobj="trans.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.matrixTranspose::perf::0") + if (any(length(.reference.rate) == 0) || any(is.null(.reference.rate))) { + print(paste("ds.matrixTranspose::perf::0 ", .current.rate, 0.5, 2.0)) + perf.reference.save("ds.matrixTranspose::perf::0", .current.rate, 0.5, 2.0) + } else { + print(paste("ds.matrixTranspose::perf::0 ", format(.current.rate, digits = 8), ", ", format(100.0 * .current.rate / .reference.rate, digits = 4), "%", sep = '')) + } + + .reference.rate <- perf.reference.rate("ds.matrixTranspose::perf::0") + .reference.tolerance.lower <- perf.reference.tolerance.lower("ds.matrixTranspose::perf::0") + .reference.tolerance.upper <- perf.reference.tolerance.upper("ds.matrixTranspose::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.matrixTranspose::perf::shutdown") +disconnect.studies.dataset.cnsim() +# context("ds.matrixTranspose::perf::done") diff --git a/tests/testthat/test-smk-ds.matrix.R b/tests/testthat/test-smk-ds.matrix.R index d4836760..273986c2 100644 --- a/tests/testthat/test-smk-ds.matrix.R +++ b/tests/testthat/test-smk-ds.matrix.R @@ -29,11 +29,9 @@ test_that("setup", { test_that("simplest ds.matrix", { matrix <- c(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11) - res <- ds.matrix(mdata=matrix, nrows.scalar=3, ncols.scalar=4) + ds.matrix(mdata=matrix, nrows.scalar=3, ncols.scalar=4) - expect_length(res, 2) - expect_equal(res[[1]], "A data object has been created in all specified data sources") - expect_equal(res[[2]], " appears valid in all sources") + ds_expect_variables(c("D", "matrix.newobj")) check.class<-ds.class("matrix.newobj",datasources=ds.test_env$connections) diff --git a/tests/testthat/test-smk-ds.matrixDet.R b/tests/testthat/test-smk-ds.matrixDet.R index 74626cbc..cc9a6ae9 100644 --- a/tests/testthat/test-smk-ds.matrixDet.R +++ b/tests/testthat/test-smk-ds.matrixDet.R @@ -32,9 +32,7 @@ test_that("simplest ds.matrixDet", { ds.matrix(mdata=matrix, nrows.scalar=3, ncols.scalar=3) res <- ds.matrixDet("matrix.newobj") - expect_length(res, 2) - expect_equal(res$is.object.created, "A data object has been created in all specified data sources") - expect_equal(res$validity.check, " appears valid in all sources") + ds_expect_variables(c("D", "matrix.newobj", "matrixdet.newobj")) check.class<-ds.class("matrixdet.newobj",datasources=ds.test_env$connections) diff --git a/tests/testthat/test-smk-ds.matrixDiag.R b/tests/testthat/test-smk-ds.matrixDiag.R index 2a9b30d7..c231f42d 100644 --- a/tests/testthat/test-smk-ds.matrixDiag.R +++ b/tests/testthat/test-smk-ds.matrixDiag.R @@ -31,9 +31,7 @@ test_that("simplest ds.matrixDiag", { res <- ds.matrixDiag(matrix, aim="clientside.vector.2.matrix", newobj="matrix_diag") - expect_length(res, 2) - expect_equal(res$is.object.created, "A data object has been created in all specified data sources") - expect_equal(res$validity.check, " appears valid in all sources") + ds_expect_variables(c("D", "matrix_diag")) check.class<-ds.class("matrix_diag") @@ -49,9 +47,7 @@ test_that("simplest ds.matrixDiag", { res <- ds.matrixDiag(matrix, aim="clientside.vector.2.matrix") - expect_length(res, 2) - expect_equal(res$is.object.created, "A data object has been created in all specified data sources") - expect_equal(res$validity.check, " appears valid in all sources") + ds_expect_variables(c("D", "matrix_diag", "matrixdiag.newobj")) check.class<-ds.class("matrixdiag.newobj",datasources=ds.test_env$connections) diff --git a/tests/testthat/test-smk-ds.matrixDimnames.R b/tests/testthat/test-smk-ds.matrixDimnames.R index 6ac87d2f..8dbc3308 100644 --- a/tests/testthat/test-smk-ds.matrixDimnames.R +++ b/tests/testthat/test-smk-ds.matrixDimnames.R @@ -35,9 +35,7 @@ test_that("simplest ds.matrixDimnames", { res <- ds.matrixDimnames("matrix.newobj", dimnames=dimnames) - expect_length(res, 2) - expect_equal(res$is.object.created, "A data object has been created in all specified data sources") - expect_equal(res$validity.check, " appears valid in all sources") + ds_expect_variables(c("D", "matrix.newobj", "matrixdimnames.newobj")) check.class<-ds.class("matrixdimnames.newobj",datasources=ds.test_env$connections) diff --git a/tests/testthat/test-smk-ds.matrixInvert.R b/tests/testthat/test-smk-ds.matrixInvert.R index 8cd89a41..a634a5d8 100644 --- a/tests/testthat/test-smk-ds.matrixInvert.R +++ b/tests/testthat/test-smk-ds.matrixInvert.R @@ -32,9 +32,7 @@ test_that("simplest ds.matrixInvert", { ds.matrix(mdata=matrix, nrows.scalar=3, ncols.scalar=3) res <- ds.matrixInvert("matrix.newobj") - expect_length(res, 2) - expect_equal(res$is.object.created, "A data object has been created in all specified data sources") - expect_equal(res$validity.check, " appears valid in all sources") + ds_expect_variables(c("D", "matrix.newobj", "matrixinvert.newobj")) check.class<-ds.class("matrixinvert.newobj",datasources=ds.test_env$connections) diff --git a/tests/testthat/test-smk-ds.matrixMult.R b/tests/testthat/test-smk-ds.matrixMult.R index 001e36ef..0925fa0d 100644 --- a/tests/testthat/test-smk-ds.matrixMult.R +++ b/tests/testthat/test-smk-ds.matrixMult.R @@ -34,9 +34,7 @@ test_that("simplest ds.matrixMult", { ds.matrix(mdata=matrix2, nrows.scalar=3, ncols.scalar=3, newobj="mat2") res <- ds.matrixMult("mat1", "mat2") - expect_length(res, 2) - expect_equal(res$is.object.created, "A data object has been created in all specified data sources") - expect_equal(res$validity.check, " appears valid in all sources") + ds_expect_variables(c("D", "mat1", "mat2", "matrixmult.newobj")) check.class<-ds.class("matrixmult.newobj",datasources=ds.test_env$connections) diff --git a/tests/testthat/test-smk-ds.matrixTranspose.R b/tests/testthat/test-smk-ds.matrixTranspose.R index fa1920a7..3cef80bf 100644 --- a/tests/testthat/test-smk-ds.matrixTranspose.R +++ b/tests/testthat/test-smk-ds.matrixTranspose.R @@ -30,11 +30,9 @@ test_that("simplest ds.matrixTranspose", { matrix <- c(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11) ds.matrix(mdata=matrix, nrows.scalar=3, ncols.scalar=4) - res <- ds.matrixTranspose("matrix.newobj") + ds.matrixTranspose("matrix.newobj") - expect_length(res, 2) - expect_equal(res[[1]], "A data object has been created in all specified data sources") - expect_equal(res[[2]], " appears valid in all sources") + ds_expect_variables(c("D", "matrix.newobj", "matrixtranspose.newobj")) check.class<-ds.class("matrixtranspose.newobj",datasources=ds.test_env$connections)