version 1.2.1

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: LearnNonparam
 Title: Non-parametric Tests
-Version: 1.2.0
+Version: 1.2.1
 Authors@R: 
     person("Yan", "Du", , "[email protected]", role = c("aut", "cre"))
 Description: Implements various non-parametric tests in chapters 1-5 of the book "An introduction to modern nonparametric statistics" by James J. Higgins. 

NAMESPACE

@@ -19,8 +19,8 @@ export(Page)
 export(PairedDifference)
 export(PermuTest)
 export(Quantile)
-export(RCBD)
 export(RCBDANOVA)
+export(RCBDTest)
 export(RatioMeanDeviance)
 export(ScoreSum)
 export(SiegelTukey)

R/ANOVA.R

@@ -24,9 +24,8 @@ ANOVA <- R6Class(
             type = c("permu", "asymp"),
             n_permu = 0L
         ) {
-            private$.init(
-                type = type, n_permu = n_permu
-            )
+            self$type <- type
+            self$n_permu <- n_permu
         }
     ),
     private = list(

R/AnsariBradley.R

@@ -25,9 +25,9 @@ AnsariBradley <- R6Class(
             alternative = c("two_sided", "less", "greater"),
             n_permu = 0L
         ) {
-            private$.init(
-                type = type, alternative = alternative, n_permu = n_permu
-            )
+            self$type <- type
+            self$alternative <- alternative
+            self$n_permu <- n_permu
         }
     ),
     private = list(

R/CDF.R

@@ -23,7 +23,7 @@ CDF <- R6Class(
         initialize = function(
             conf_level = 0.95
         ) {
-            private$.init(conf_level = conf_level)
+            self$conf_level <- conf_level
         },
 
         #' @description Plot the estimate and confidence bounds for population cdf of the data.
@@ -35,7 +35,8 @@ CDF <- R6Class(
             if (!is.null(private$.raw_data)) {
                 if (match.arg(style) == "graphics") {
                     private$.plot()
-                } else if (requireNamespace("ggplot2")) {
+                } else {
+                    requireNamespace("ggplot2")
                     print(private$.autoplot())
                 }
             }

R/ChiSquare.R

@@ -24,20 +24,20 @@ ChiSquare <- R6Class(
             type = c("permu", "asymp"),
             n_permu = 0L
         ) {
-            private$.init(
-                type = type, n_permu = n_permu
-            )
+            self$type <- type
+            self$n_permu <- n_permu
         }
     ),
     private = list(
         .name = "Contingency Table Test Based on Chi-square Statistic",
 
         .define = function() {
-            dim <- dim(private$.data)
+            m <- nrow(private$.data)
+            n <- ncol(private$.data)
             sum <- sum(private$.data)
             private$.statistic_func <- function(data) {
-                row_sum <- .rowSums(data, dim[1], dim[2])
-                col_sum <- .colSums(data, dim[1], dim[2])
+                row_sum <- .rowSums(data, m, n)
+                col_sum <- .colSums(data, m, n)
 
                 expect <- row_sum %*% matrix(col_sum, nrow = 1) / sum
 

R/ContingencyTableTest.R

@@ -1,6 +1,6 @@
 #' @title ContingencyTableTest Class
 #' 
-#' @description Abstract class for permutation tests on contingency tables.
+#' @description Abstract class for tests on contingency tables.
 #' 
 #' 
 #' @export
@@ -13,10 +13,19 @@ ContingencyTableTest <- R6Class(
     inherit = PermuTest,
     cloneable = FALSE,
     private = list(
-        .name = "Contingency Table Permutation Test",
+        .preprocess = function() {
+            if (length(unique(lengths(private$.raw_data))) > 1) {
+                stop_without_call("All samples must be of equal length")
+            }
 
-        .preprocess = function(table) {
-            private$.data <- unname(do_call(cbind, private$.raw_data))
+            private$.data <- unname(
+                do_call(cbind, lapply(private$.raw_data, as.integer))
+            )
+
+            if (any(private$.data < 0)) {
+                private$.data <- NULL
+                stop_without_call("All samples must be non-negative")
+            }
         },
 
         .calculate_statistic = function() {

R/Correlation.R

@@ -27,10 +27,10 @@ Correlation <- R6Class(
             alternative = c("two_sided", "less", "greater"),
             n_permu = 0L
         ) {
-            private$.init(
-                type = type, method = method,
-                alternative = alternative, n_permu = n_permu
-            )
+            self$type <- type
+            self$method <- method
+            self$alternative <- alternative
+            self$n_permu <- n_permu
         }
     ),
     private = list(

R/Difference.R

@@ -25,21 +25,15 @@ Difference <- R6Class(
             alternative = c("two_sided", "less", "greater"),
             n_permu = 0L
         ) {
-            private$.init(
-                method = method, alternative = alternative, n_permu = n_permu
-            )
+            self$method <- method
+            self$alternative <- alternative
+            self$n_permu <- n_permu
         }
     ),
     private = list(
         .name = "Two Sample Test Based on Mean or Median",
 
-        .null_value = 0,
-
         .define = function() {
-            private$.param_name <- paste0(
-                "difference in", " ", private$.method, "s"
-            )
-
             private$.statistic_func <- switch(private$.method,
                 mean = function(x, y) mean(x) - mean(y),
                 median = function(x, y) median(x) - median(y)

R/Friedman.R

@@ -12,7 +12,7 @@
 
 Friedman <- R6Class(
     classname = "Friedman",
-    inherit = RCBD,
+    inherit = RCBDTest,
     cloneable = FALSE,
     public = list(
         #' @description Create a new `Friedman` object.
@@ -24,9 +24,8 @@ Friedman <- R6Class(
             type = c("permu", "asymp"),
             n_permu = 0L
         ) {
-            private$.init(
-                type = type, n_permu = n_permu
-            )
+            self$type <- type
+            self$n_permu <- n_permu
         }
     ),
     private = list(
@@ -35,11 +34,13 @@ Friedman <- R6Class(
         .scoring = "rank",
 
         .define = function() {
+            m <- nrow(private$.data)
+            n <- ncol(private$.data)
             private$.statistic_func <- switch(private$.type,
-                permu = function(data) sum(rowMeans(data)^2),
+                permu = function(data) sum(.rowMeans(data, m, n)^2),
                 asymp = function(data) {
-                    ncol(data)^2 / sum(apply(data, 2, var)) *
-                    sum((rowMeans(data) - (nrow(data) + 1) / 2)^2)
+                    n^2 / sum(apply(data, 2, var)) *
+                    sum((.rowMeans(data, m, n) - (m + 1) / 2)^2)
                 }
             )
         },

R/JonckheereTerpstra.R

@@ -25,9 +25,9 @@ JonckheereTerpstra <- R6Class(
             alternative = c("two_sided", "less", "greater"),
             n_permu = 0L
         ) {
-            private$.init(
-                type = type, alternative = alternative, n_permu = n_permu
-            )
+            self$type <- type
+            self$alternative <- alternative
+            self$n_permu <- n_permu
         }
     ),
     private = list(

R/KSampleTest.R

@@ -13,13 +13,18 @@ KSampleTest <- R6Class(
     inherit = PermuTest,
     cloneable = FALSE,
     private = list(
-        .name = "K Sample Permutation Test",
-
         .preprocess = function() {
-            data <- private$.raw_data
-            private$.data <- `names<-`(
-                unlist(data, recursive = FALSE, use.names = FALSE),
-                rep.int(seq_along(data), vapply(data, length, integer(1)))
+            if (length(private$.raw_data) < 3) {
+                stop_without_call("Must provide at least three samples")
+            }
+
+            private$.data <- unlist(
+                private$.raw_data,
+                recursive = FALSE, use.names = FALSE
+            )
+            names(private$.data) <- rep.int(
+                seq_along(private$.raw_data),
+                lengths(private$.raw_data, use.names = FALSE)
             )
         },
 

R/KolmogorovSmirnov.R

@@ -22,7 +22,7 @@ KolmogorovSmirnov <- R6Class(
         initialize = function(
             n_permu = 0L
         ) {
-            private$.init(n_permu = n_permu)
+            self$n_permu <- n_permu
         }
     ),
     private = list(

R/KruskalWallis.R

@@ -18,17 +18,16 @@ KruskalWallis <- R6Class(
         #' @description Create a new `KruskalWallis` object.
         #' 
         #' @template init_params
-        #' @param type a character string specifying the way to calculate p-values, must be one of `"permu"` (default) or `"asymp"`.
         #' 
         #' @return A `KruskalWallis` object.
         initialize = function(
             type = c("permu", "asymp"),
             scoring = c("rank", "vw", "expon"),
             n_permu = 0L
         ) {
-            private$.init(
-                type = type, scoring = scoring, n_permu = n_permu
-            )
+            self$type <- type
+            self$scoring <- scoring
+            self$n_permu <- n_permu
         }
     ),
     private = list(

R/MultiCompT.R

@@ -18,8 +18,8 @@ MultiCompT <- R6Class(
         #' @description Create a new `MultiCompT` object.
         #' 
         #' @template init_params
-        #' @param conf_level a numeric value between zero and one giving the family-wise confidence level to use.
         #' @param method a character string specifying whether to use bonferroni correction.
+        #' @param conf_level a numeric value between zero and one giving the family-wise confidence level to use.
         #' 
         #' @return A `MultiCompT` object. 
         initialize = function(
@@ -28,20 +28,18 @@ MultiCompT <- R6Class(
             scoring = c("none", "rank", "vw", "expon"),
             conf_level = 0.95, n_permu = 0L
         ) {
-            private$.init(
-                type = type, method = method, scoring = scoring,
-                conf_level = conf_level, n_permu = n_permu
-            )
+            self$type <- type
+            self$method <- method
+            self$scoring <- scoring
+            self$conf_level <- conf_level
+            self$n_permu <- n_permu
         }
     ),
     private = list(
         .name = "Multiple Comparison Based on t Statistic",
 
         .define = function() {
-            lengths <- vapply(
-                X = split(private$.data, names(private$.data)),
-                FUN = length, FUN.VALUE = integer(1), USE.NAMES = FALSE
-            )
+            lengths <- lengths(split(private$.data, names(private$.data)))
 
             if (private$.scoring == "none") {
                 N <- length(private$.data)
@@ -71,15 +69,19 @@ MultiCompT <- R6Class(
             k <- as.integer(names(private$.data)[N])
             df <- if (private$.scoring == "none") N - k else Inf
 
-            private$.p_value <- 2 * get_p_continous(
-                abs(private$.statistic), "t", "r", df = df
+            private$.p_value <- get_p_continous(
+                private$.statistic, "t", "lr", df = df
             )
         },
 
         .calculate_extra = function() {
             private$.differ <- private$.p_value < (1 - private$.conf_level) / (
                 if (private$.method == "bonferroni") length(private$.p_value) else 1
             )
+        },
+
+        .on_method_change = function() {
+            private$.calculate_extra()
         }
     )
 )

R/MultipleComparison.R

@@ -14,13 +14,11 @@ MultipleComparison <- R6Class(
     inherit = KSampleTest,
     cloneable = FALSE,
     private = list(
-        .name = "Multiple Comparison",
-
         .group_ij = NULL,
         .differ = NULL,
 
-        .preprocess = function(...) {
-            super$.preprocess(...)
+        .preprocess = function() {
+            super$.preprocess()
 
             k <- as.integer(names(private$.data)[length(private$.data)])
             private$.group_ij <- list(
@@ -57,8 +55,9 @@ MultipleComparison <- R6Class(
         },
 
         .calculate_p_permu = function() {
-            private$.p_value <- rowMeans(
-                abs(private$.statistic_permu) >= abs(private$.statistic)
+            private$.p_value <- .rowMeans(
+                abs(private$.statistic_permu) >= abs(private$.statistic),
+                nrow(private$.statistic_permu), ncol(private$.statistic_permu)
             )
         },
 

R/OneSampleTest.R

@@ -13,9 +13,11 @@ OneSampleTest <- R6Class(
     inherit = PermuTest,
     cloneable = FALSE,
     private = list(
-        .name = "One Sample Test",
-
         .preprocess = function() {
+            if (length(private$.raw_data) != 1) {
+                stop_without_call("Must provide only one sample")
+            }
+
             private$.data <- private$.raw_data[[1]]
         },