for version 1.2.1 (but not enough)

qddyy · Jan 24, 2024 · 02e860d · 02e860d
1 parent 3362115
commit 02e860d
Show file tree

Hide file tree

Showing 57 changed files with 773 additions and 392 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -50,4 +50,5 @@ importFrom(stats,pt)
 importFrom(stats,ptukey)
 importFrom(stats,pwilcox)
 importFrom(stats,qnorm)
+importFrom(stats,stepfun)
 useDynLib(LearnNonparam, .registration = TRUE)
diff --git a/R/ANOVA.R b/R/ANOVA.R
@@ -24,9 +24,9 @@ ANOVA <- R6Class(
             type = c("permu", "asymp"),
             n_permu = 0L
         ) {
-            private$.type <- match.arg(type)
-
-            super$initialize(alternative = "greater", n_permu = n_permu)
+            private$.init(
+                type = type, n_permu = n_permu
+            )
         }
     ),
     private = list(
@@ -58,6 +58,10 @@ ANOVA <- R6Class(
             )
         },
 
+        .calculate_side = function() {
+            private$.side <- "r"
+        },
+
         .calculate_p = function() {
             N <- length(private$.data)
             k <- as.integer(names(private$.data)[N])

diff --git a/R/AnsariBradley.R b/R/AnsariBradley.R
@@ -22,19 +22,20 @@ AnsariBradley <- R6Class(
         #' @return A `AnsariBradley` object.
         initialize = function(
             type = c("permu", "asymp"),
-            alternative = c("two_sided", "less", "greater"), n_permu = 0L
+            alternative = c("two_sided", "less", "greater"),
+            n_permu = 0L
         ) {
-            private$.type <- match.arg(type)
-
-            super$initialize(null_value = 1, alternative = match.arg(alternative), n_permu = n_permu)
-
-            private$.scoring <- "ansari-bradley rank"
+            private$.init(
+                type = type, alternative = alternative, n_permu = n_permu
+            )
         }
     ),
     private = list(
         .name = "Ansari-Bradley Test",
         .param_name = "ratio of scales",
 
+        .scoring = "Ansari-Bradley rank",
+        .null_value = 1,
         .trend = "-",
 
         .calculate_score = function() {

diff --git a/R/CDF.R b/R/CDF.R
@@ -7,7 +7,7 @@
 #' @export
 #' 
 #' @importFrom R6 R6Class
-#' @importFrom stats qnorm plot.stepfun
+#' @importFrom stats qnorm stepfun plot.stepfun
 
 
 CDF <- R6Class(
@@ -19,9 +19,11 @@ CDF <- R6Class(
         #' 
         #' @param conf_level a number specifying confidence level of the confidence bounds.
         #' 
-        #' @return A `CDF` object. 
-        initialize = function(conf_level = 0.95) {
-            super$initialize(conf_level = conf_level)
+        #' @return A `CDF` object.
+        initialize = function(
+            conf_level = 0.95
+        ) {
+            private$.init(conf_level = conf_level)
         },
 
         #' @description Plot the estimate and confidence bounds for population cdf of the data.
@@ -30,9 +32,13 @@ CDF <- R6Class(
         #' 
         #' @return The object itself (invisibly).
         plot = function(style = c("graphics", "ggplot2")) {
-            private$.type <- "permu"
-            super$plot(style = style)
-            private$.type <- "asymp"
+            if (!is.null(private$.raw_data)) {
+                if (match.arg(style) == "graphics") {
+                    private$.plot()
+                } else if (requireNamespace("ggplot2")) {
+                    print(private$.autoplot())
+                }
+            }
 
             invisible(self)
         }
@@ -44,67 +50,92 @@ CDF <- R6Class(
 
         .lims_for_plot = NULL,
 
+        .preprocess = function() {
+            super$.preprocess()
+
+            private$.data <- sort(private$.data)
+        },
+
         .calculate_extra = function() {
             n <- length(private$.data)
-            sorted <- sort(private$.data)
 
             F_n <- seq.int(0, n) / n
-            private$.estimate <- stepfun(sorted, F_n, right = TRUE)
+            private$.estimate <- stepfun(private$.data, F_n)
 
             A <- 1 / sqrt(n) * qnorm(1 - (1 - private$.conf_level) / 2)
             delta_n <- A * sqrt(F_n * (1 - F_n))
             private$.ci <- list(
-                lower = stepfun(sorted, F_n - delta_n, right = TRUE),
-                upper = stepfun(sorted, F_n + delta_n, right = TRUE)
+                lower = stepfun(private$.data, F_n - delta_n),
+                upper = stepfun(private$.data, F_n + delta_n)
             )
 
             private$.lims_for_plot <- list(
-                x = c(sorted[1], get_last(sorted)),
+                x = c(private$.data[1], private$.data[n]),
                 y = c(min(F_n - delta_n), max(F_n + delta_n))
             )
         },
 
         .print = function(...) {},
 
-        .plot = function(...) {
+        .plot = function() {
             plot.stepfun(
-                private$.estimate, lty = "solid",
+                private$.estimate,
+                lty = "solid", do.points = FALSE,
                 xlim = private$.lims_for_plot$x,
                 ylim = private$.lims_for_plot$y,
-                main = "Empirical CDF with Confidence Bounds",
-                xlab = expression(x), ylab = expression(F[n](x))
+                main = paste(
+                    "Empirical CDF with",
+                    paste0(private$.conf_level * 100, "%"),
+                    "Confidence Bounds"
+                ), xlab = expression(x), ylab = expression(F[n](x))
+            )
+            plot.stepfun(
+                private$.ci$lower, lty = "dashed", do.points = FALSE, add = TRUE
+            )
+            plot.stepfun(
+                private$.ci$upper, lty = "dashed", do.points = FALSE, add = TRUE
             )
-            plot.stepfun(private$.ci$lower, lty = "dashed", add = TRUE)
-            plot.stepfun(private$.ci$upper, lty = "dashed", add = TRUE)
         },
 
-        .autoplot = function(...) {
-            ggplot2::ggplot(
-                data = data.frame(
-                    x = private$.data,
-                    ecdf = private$.estimate(private$.data),
-                    lower = private$.ci$lower(private$.data),
-                    upper = private$.ci$upper(private$.data)
-                ), mapping = ggplot2::aes(x = .data$x)
-            ) +
+        .autoplot = function() {
+            ggplot2::ggplot() +
                 ggplot2::geom_step(
-                    mapping = ggplot2::aes(y = .data$ecdf), linetype = "solid"
+                    mapping = ggplot2::aes(x = .data$x, y = .data$ecdf),
+                    data = data.frame(
+                        x = c(private$.data[1], private$.data),
+                        ecdf = c(0, private$.estimate(private$.data))
+                    ), linetype = "solid"
                 ) +
-                ggplot2::geom_step(
-                    mapping = ggplot2::aes(y = .data$lower), linetype = "dashed"
-                ) +
-                ggplot2::geom_step(
-                    mapping = ggplot2::aes(y = .data$upper), linetype = "dashed"
+                ggplot2::geom_rect(
+                    mapping = ggplot2::aes(
+                        xmin = .data$xmin, xmax = .data$xmax,
+                        ymin = .data$ymin, ymax = .data$ymax
+                    ),
+                    data = {
+                        n <- length(private$.data)
+                        data.frame(
+                            xmin = private$.data[-n],
+                            xmax = private$.data[-1],
+                            ymin = private$.ci$lower(private$.data[-n]),
+                            ymax = private$.ci$upper(private$.data[-n])
+                        )
+                    }, alpha = 0.25
                 ) +
+                ggplot2::geom_hline(yintercept = c(0, 1), linetype = "dashed") +
                 ggplot2::lims(
                     x = private$.lims_for_plot$x, y = private$.lims_for_plot$y
                 ) +
                 ggplot2::labs(
-                    title = "Empirical CDF with Confidence Bounds",
-                    x = expression(x), y = expression(F[n](x))
+                    title = paste(
+                        "Empirical CDF with",
+                        paste0(private$.conf_level * 100, "%"),
+                        "Confidence Bounds"
+                    ), x = expression(x), y = expression(F[n](x))
                 ) +
                 ggplot2::theme(
-                    plot.title = ggplot2::element_text(face = "bold", hjust = 0.5)
+                    plot.title = ggplot2::element_text(
+                        face = "bold", hjust = 0.5
+                    )
                 )
         }
     )

diff --git a/R/ChiSquare.R b/R/ChiSquare.R
@@ -24,9 +24,9 @@ ChiSquare <- R6Class(
             type = c("permu", "asymp"),
             n_permu = 0L
         ) {
-            private$.type <- match.arg(type)
-
-            super$initialize(alternative = "greater", n_permu = n_permu)
+            private$.init(
+                type = type, n_permu = n_permu
+            )
         }
     ),
     private = list(
@@ -45,6 +45,10 @@ ChiSquare <- R6Class(
             }
         },
 
+        .calculate_side = function() {
+            private$.side <- "r"
+        },
+
         .calculate_p = function() {
             r <- nrow(private$.data)
             c <- ncol(private$.data)

diff --git a/R/ContingencyTableTest.R b/R/ContingencyTableTest.R
@@ -1,6 +1,6 @@
 #' @title ContingencyTableTest Class
 #' 
-#' @description This class specializes `PermuTest` for permutation tests for contingency tables. Note that it is not recommended to create objects of this class directly.
+#' @description Abstract class for permutation tests on contingency tables.
 #' 
 #' 
 #' @export
@@ -15,8 +15,6 @@ ContingencyTableTest <- R6Class(
     private = list(
         .name = "Contingency Table Permutation Test",
 
-        .check = function() {},
-
         .preprocess = function(table) {
             private$.data <- unname(do_call(cbind, private$.raw_data))
         },

diff --git a/R/Correlation.R b/R/Correlation.R
@@ -18,22 +18,26 @@ Correlation <- R6Class(
         #' @description Create a new `Correlation` object.
         #' 
         #' @template init_params
-        #' @param method a character string indicating which correlation coefficient is to be computed.
+        #' @param method a character string specifying the correlation coefficient to be used.
         #' 
         #' @return A `Correlation` object.
         initialize = function(
-            type = c("permu", "asymp"), method = c("pearson", "kendall", "spearman"),
-            alternative = c("two_sided", "less", "greater"), n_permu = 0L
+            type = c("permu", "asymp"),
+            method = c("pearson", "kendall", "spearman"),
+            alternative = c("two_sided", "less", "greater"),
+            n_permu = 0L
         ) {
-            private$.type <- match.arg(type)
-            private$.method <- match.arg(method)
-
-            super$initialize(alternative = match.arg(alternative), n_permu = n_permu)
+            private$.init(
+                type = type, method = method,
+                alternative = alternative, n_permu = n_permu
+            )
         }
     ),
     private = list(
         .name = "Two Sample Test Based on Correlation Coefficient",
 
+        .null_value = 0,
+
         .define = function() {
             private$.param_name <- switch(private$.method,
                 pearson = "correlation", kendall = "tau", spearman = "rho"
@@ -95,7 +99,9 @@ Correlation <- R6Class(
             } else {
                 t <- r * sqrt((n - 2) / (1 - r^2))
 
-                private$.p_value <- get_p_continous(t, "t", private$.side, df = n - 2)
+                private$.p_value <- get_p_continous(
+                    t, "t", private$.side, df = n - 2
+                )
             }
         }
     )

diff --git a/R/Difference.R b/R/Difference.R
@@ -17,22 +17,28 @@ Difference <- R6Class(
         #' @description Create a new `Difference` object.
         #' 
         #' @template init_params
+        #' @param method a character string specifying whether to use the mean or the median.
         #' 
         #' @return A `Difference` object.
         initialize = function(
             method = c("mean", "median"),
-            alternative = c("two_sided", "less", "greater"), n_permu = 0L
+            alternative = c("two_sided", "less", "greater"),
+            n_permu = 0L
         ) {
-            private$.method <- match.arg(method)
-
-            super$initialize(alternative = match.arg(alternative), n_permu = n_permu)
+            private$.init(
+                method = method, alternative = alternative, n_permu = n_permu
+            )
         }
     ),
     private = list(
         .name = "Two Sample Test Based on Mean or Median",
 
+        .null_value = 0,
+
         .define = function() {
-            private$.param_name <- paste("difference", "in", paste0(private$.method, "s"))
+            private$.param_name <- paste0(
+                "difference in", " ", private$.method, "s"
+            )
 
             private$.statistic_func <- switch(private$.method,
                 mean = function(x, y) mean(x) - mean(y),

diff --git a/R/Friedman.R b/R/Friedman.R
@@ -24,14 +24,16 @@ Friedman <- R6Class(
             type = c("permu", "asymp"),
             n_permu = 0L
         ) {
-            private$.type <- match.arg(type)
-
-            super$initialize(scoring = "rank", alternative = "greater", n_permu = n_permu)
+            private$.init(
+                type = type, n_permu = n_permu
+            )
         }
     ),
     private = list(
         .name = "Friedman Test",
 
+        .scoring = "rank",
+
         .define = function() {
             private$.statistic_func <- switch(private$.type,
                 permu = function(data) sum(rowMeans(data)^2),
@@ -42,6 +44,10 @@ Friedman <- R6Class(
             )
         },
 
+        .calculate_side = function() {
+            private$.side <- "r"
+        },
+
         .calculate_p = function() {
             k <- nrow(private$.data)