refactor: return class for consistency checking, remove ValidityMessage

Author: timcadman

R/corTestDS.R

@@ -29,9 +29,9 @@ corTestDS <- function(x, y, method, exact, conf.level){
   # runs a two-sided correlation test
   corTest <- stats::cor.test(x=x.var, y=y.var, method=method, exact=exact, conf.level=conf.level)
 
-  out <- list(n, corTest)
-  names(out) <- c("Number of pairwise complete cases", "Correlation test")
-  
+  out <- list(n, corTest, class = class(x.var))
+  names(out)[1:2] <- c("Number of pairwise complete cases", "Correlation test")
+
   # return the results
   return(out)
 

R/kurtosisDS1.R

@@ -34,19 +34,16 @@ kurtosisDS1 <- function (x, method){
 
     if(method==1){
       kurtosis.out <- g2
-      studysideMessage <- "VALID ANALYSIS"
     }
     if(method==2){
       kurtosis.out <- ((length(x) + 1) * g2 + 6) * (length(x) - 1)/((length(x) - 2) * (length(x) - 3))
-      studysideMessage <- "VALID ANALYSIS"
     }
     if(method==3){
       kurtosis.out <- (g2 + 3) * (1 - 1/length(x))^2 - 3
-      studysideMessage <- "VALID ANALYSIS"
     }
   }
-  
-  out.obj <- list(Kurtosis=kurtosis.out, Nvalid=length(x), ValidityMessage=studysideMessage)
+
+  out.obj <- list(Kurtosis=kurtosis.out, Nvalid=length(x), class=class(x.val))
   return(out.obj)
 
 }

R/kurtosisDS2.R

@@ -29,16 +29,13 @@ kurtosisDS2 <- function(x, global.mean){
   x <- x.val[stats::complete.cases(x.val)]
 
   if(length(x) < nfilter.tab){
-    sum_quartics.out <- NA
-    sum_squares.out <- NA
-    studysideMessage <- "FAILED: Nvalid less than nfilter.tab"
-  }else{
-    sum_quartics.out <- sum((x - global.mean)^4)
-    sum_squares.out <- sum((x - global.mean)^2)
-    studysideMessage <- "VALID ANALYSIS"
+    stop("FAILED: Nvalid less than nfilter.tab", call. = FALSE)
   }
-  
-  out.obj <- list(Sum.quartics=sum_quartics.out, Sum.squares=sum_squares.out, Nvalid=length(x), ValidityMessage=studysideMessage)
+
+  sum_quartics.out <- sum((x - global.mean)^4)
+  sum_squares.out <- sum((x - global.mean)^2)
+
+  out.obj <- list(Sum.quartics=sum_quartics.out, Sum.squares=sum_squares.out, Nvalid=length(x), class=class(x.val))
   return(out.obj)
 
 }

R/quantileMeanDS.R

@@ -21,10 +21,10 @@ quantileMeanDS <- function (x) {
     qq <- stats::quantile(xvect,c(0.05,0.1,0.25,0.5,0.75,0.9,0.95), na.rm=TRUE)
     mm <- mean(xvect,na.rm=TRUE)
     quantile.obj <- c(qq, mm)
-    names(quantile.obj) <- c("5%","10%","25%","50%","75%","90%","95%","Mean")    
+    names(quantile.obj) <- c("5%","10%","25%","50%","75%","90%","95%","Mean")
   }else{
     quantile.obj <- NA
   }
-  
-  return(quantile.obj)
+
+  return(list(quantiles = quantile.obj, class = class(xvect)))
 }

R/skewnessDS1.R

@@ -34,19 +34,16 @@ skewnessDS1 <- function(x, method){
 
     if(method==1){
       skewness.out <- g1
-      studysideMessage <- "VALID ANALYSIS"
     }
     if(method==2){
       skewness.out <- g1 * sqrt(length(x)*(length(x)-1))/(length(x)-2)
-      studysideMessage <- "VALID ANALYSIS"
     }
     if(method==3){
       skewness.out <- g1 * ((length(x)-1)/(length(x)))^(3/2)
-      studysideMessage <- "VALID ANALYSIS"
     }
   }
 
-  out.obj <- list(Skewness=skewness.out, Nvalid=length(x), ValidityMessage=studysideMessage)
+  out.obj <- list(Skewness=skewness.out, Nvalid=length(x), class=class(x.val))
   return(out.obj)
 
 }

R/skewnessDS2.R

@@ -29,17 +29,13 @@ skewnessDS2 <- function(x, global.mean){
   x <- x.val[stats::complete.cases(x.val)]
 
   if(length(x) < nfilter.tab){
-    sum_cubes.out <- NA
-    sum_squares.out <- NA
-    studysideMessage <- "FAILED: Nvalid less than nfilter.tab"
-    stop(studysideMessage, call. = FALSE)
-  }else{
-    sum_cubes.out <- sum((x - global.mean)^3)
-    sum_squares.out <- sum((x - global.mean)^2)
-    studysideMessage <- "VALID ANALYSIS"
+    stop("FAILED: Nvalid less than nfilter.tab", call. = FALSE)
   }
-  
-  out.obj <- list(Sum.cubes=sum_cubes.out, Sum.squares=sum_squares.out, Nvalid=length(x), ValidityMessage=studysideMessage)
+
+  sum_cubes.out <- sum((x - global.mean)^3)
+  sum_squares.out <- sum((x - global.mean)^2)
+
+  out.obj <- list(Sum.cubes=sum_cubes.out, Sum.squares=sum_squares.out, Nvalid=length(x), class=class(x.val))
   return(out.obj)
 
 }