refactor: return class for consistency checking, remove ValidityMessage

Author: timcadman

R/meanDS.R

@@ -27,14 +27,11 @@ meanDS <- function(x){
   out.numNa <- length(which(is.na(xvect)))
   out.totN <- length(xvect)
   out.validN <- out.totN-out.numNa
-  studysideMessage <- "VALID ANALYSIS"
-
   if((out.validN != 0) && (out.validN < nfilter.tab)){
-    out.mean <- NA
     stop("FAILED: Nvalid less than nfilter.tab", call. = FALSE)
   }
 
-  out.obj <- list(EstimatedMean=out.mean,Nmissing=out.numNa,Nvalid=out.validN,Ntotal=out.totN,ValidityMessage=studysideMessage)
+  out.obj <- list(EstimatedMean=out.mean,Nmissing=out.numNa,Nvalid=out.validN,Ntotal=out.totN,class=class(xvect))
   return(out.obj)
 
 }

R/meanSdGpDS.R

@@ -28,6 +28,8 @@ meanSdGpDS <- function (x, index){
   .checkClass(obj = X, obj_name = x, permitted_classes = c("numeric", "integer"))
   INDEX <- .loadServersideObject(index)
   .checkClass(obj = INDEX, obj_name = index, permitted_classes = c("factor", "character", "integer"))
+  x.class <- class(X)
+  index.class <- class(INDEX)
 
   FUN.mean <- function(x) {mean(x,na.rm=TRUE)}
   FUN.var <- function(x)  {stats::var(x,na.rm=TRUE)}
@@ -120,17 +122,17 @@ meanSdGpDS <- function (x, index){
   {
     table.valid<-TRUE
     cell.count.warning<-paste0("All tables valid") 
-    result<-list(table.valid,ansmat.mean,ansmat.sd,ansmat.count,Nvalid,Nmissing,Ntotal,cell.count.warning)
-    names(result)<-list("Table_valid","Mean_gp","StDev_gp", "N_gp","Nvalid","Nmissing","Ntotal","Message")
+    result<-list(table.valid,ansmat.mean,ansmat.sd,ansmat.count,Nvalid,Nmissing,Ntotal,cell.count.warning,x.class,index.class)
+    names(result)<-list("Table_valid","Mean_gp","StDev_gp", "N_gp","Nvalid","Nmissing","Ntotal","Message","class.x","class.index")
     return(result)
   }
 
   if(any.invalid.cell)
   {
     table.valid<-FALSE
     cell.count.warning<-paste0("At least one group has between 1 and ", nfilter.tab-1, " observations. Please change groups") 
-    result<-list(table.valid,Nvalid,Nmissing,Ntotal,cell.count.warning)
-    names(result)<-list("Table_valid","Nvalid","Nmissing","Ntotal","Warning")
+    result<-list(table.valid,Nvalid,Nmissing,Ntotal,cell.count.warning,x.class,index.class)
+    names(result)<-list("Table_valid","Nvalid","Nmissing","Ntotal","Warning","class.x","class.index")
     return(result)
   }
 

R/varDS.R

@@ -31,16 +31,11 @@ varDS <- function(x){
   out.numNa <- length(which(is.na(xvect)))
   out.totN <- length(xvect)
   out.validN <- out.totN-out.numNa
-  studysideMessage <- "VALID ANALYSIS"
-
   if((out.validN != 0) && (out.validN < nfilter.tab)){
-    out.sum <- NA
-    out.sumSquares <- NA
-    studysideMessage <- "FAILED: Nvalid less than nfilter.tab"
-    stop(studysideMessage, call. = FALSE)
+    stop("FAILED: Nvalid less than nfilter.tab", call. = FALSE)
   }
 
-  out.obj <- list(Sum=out.sum,SumOfSquares=out.sumSquares,Nmissing=out.numNa,Nvalid=out.validN,Ntotal=out.totN,ValidityMessage=studysideMessage)
+  out.obj <- list(Sum=out.sum,SumOfSquares=out.sumSquares,Nmissing=out.numNa,Nvalid=out.validN,Ntotal=out.totN,class=class(xvect))
   return(out.obj)
 
 }