minor improvements

qddyy · Feb 8, 2024 · aa0174d · aa0174d
1 parent 85ef501
commit aa0174d
Show file tree

Hide file tree

Showing 23 changed files with 470 additions and 434 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,9 +1,9 @@
 Package: LearnNonparam
-Title: Non-parametric Tests
+Title: Nonparametric Tests
 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. 
+Description: Implements various nonparametric tests in chapters 1-5 of the book "An introduction to modern nonparametric statistics" by James J. Higgins. 
 License: GPL (>= 2)
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)

diff --git a/R/AnsariBradley.R b/R/AnsariBradley.R
@@ -36,7 +36,7 @@ AnsariBradley <- R6Class(
 
         .scoring = "Ansari-Bradley rank",
         .null_value = 1,
-        .trend = "-",
+        .link = "-",
 
         .calculate_score = function() {
             rank <- rank(c(private$.data$x, private$.data$y))

diff --git a/R/CDF.R b/R/CDF.R
@@ -1,6 +1,6 @@
 #' @title `r CDF$private_fields$.name`
 #' 
-#' @description Performs statistical inference on population CDF.
+#' @description Performs statistical inference on population cumulative distribution function.
 #' 
 #' @aliases onesample.cdf
 #' 
@@ -26,7 +26,7 @@ CDF <- R6Class(
             self$conf_level <- conf_level
         },
 
-        #' @description Plot the estimate and confidence bounds for population CDF.
+        #' @description Plot the estimate and confidence bounds for population cumulative distribution function.
         #' 
         #' @template plot_params
         #' 
@@ -40,7 +40,7 @@ CDF <- R6Class(
         }
     ),
     private = list(
-        .name = "Cumulative Distribution Function",
+        .name = "Inference on Cumulative Distribution Function",
 
         .type = "asymp",
 

diff --git a/R/ChiSquare.R b/R/ChiSquare.R
@@ -1,6 +1,6 @@
 #' @title `r ChiSquare$private_fields$.name`
 #' 
-#' @description Performs chi-square statistic based test on a contingency table.
+#' @description Performs chi-square test on a contingency table.
 #' 
 #' @aliases table.chisq
 #' 
@@ -29,7 +29,7 @@ ChiSquare <- R6Class(
         }
     ),
     private = list(
-        .name = "Contingency Table Test Based on Chi-square Statistic",
+        .name = "Chi-Square Test on Contingency Table",
 
         .define = function() {
             m <- nrow(private$.data)

diff --git a/R/Correlation.R b/R/Correlation.R
@@ -34,7 +34,7 @@ Correlation <- R6Class(
         }
     ),
     private = list(
-        .name = "Test for Association Based on Correlation Coefficients",
+        .name = "Test for Association Between Paired Samples",
 
         .null_value = 0,
 

diff --git a/R/MultipleComparison.R b/R/MultipleComparison.R
@@ -57,7 +57,17 @@ MultipleComparison <- R6Class(
         },
 
         .calculate_extra = function() {
-            private$.differ <- (private$.p_value < 1 - private$.conf_level)
+            private$.differ <- (
+                private$.p_value < 1 - private$.conf_level
+            )
+        },
+
+        .on_n_permu_change = function() {
+            if (private$.type == "permu") {
+                private$.calculate_statistic_permu()
+                private$.calculate_p_permu()
+                private$.calculate_extra()
+            }
         },
 
         .print = function(digits) {

diff --git a/R/PairedDifference.R b/R/PairedDifference.R
@@ -80,12 +80,12 @@ PairedDifference <- R6Class(
         }
     ),
     active = list(
-        #' @template active_params
+        #' @field correct Whether to apply continuity correction when `scoring` is set to `"rank"`.
         correct = function(value) {
             if (missing(value)) {
                 private$.correct
             } else if (length(value) == 1 & is.logical(value)) {
-                private$.correct <- value
+                private$.correct <- as.logical(value)
                 if (
                     !is.null(private$.raw_data) &
                     private$.type == "asymp" & private$.scoring == "rank"

diff --git a/R/PermuTest.R b/R/PermuTest.R
@@ -88,7 +88,7 @@ PermuTest <- R6Class(
         .statistic_permu = NULL,
 
         .alternative = "two_sided",
-        .trend = "+",
+        .link = "+",
         .side = NULL,
 
         .p_value = NULL,
@@ -150,7 +150,7 @@ PermuTest <- R6Class(
         },
 
         .calculate_side = function() {
-            private$.side <- switch(private$.trend,
+            private$.side <- switch(private$.link,
                 "+" = switch(private$.alternative,
                     greater = "r", less = "l", two_sided = "lr"
                 ),
@@ -168,6 +168,26 @@ PermuTest <- R6Class(
             ))
         },
 
+        .on_type_change = function() private$.calculate(),
+        .on_method_change = function() private$.calculate(),
+        .on_scoring_change = function() private$.calculate(),
+        .on_null_value_change = function() private$.calculate(),
+        .on_conf_level_change = function() private$.calculate_extra(),
+        .on_alternative_change = function() {
+            private$.calculate_side()
+            if (private$.type == "permu") {
+                private$.calculate_p_permu()
+            } else {
+                private$.calculate_p()
+            }
+        },
+        .on_n_permu_change = function() {
+            if (private$.type == "permu") {
+                private$.calculate_statistic_permu()
+                private$.calculate_p_permu()
+            }
+        },
+
         .print = function(digits) {
             cat("\n", "\t", private$.name, "\n\n")
 
@@ -273,25 +293,6 @@ PermuTest <- R6Class(
                         face = "bold", hjust = 0.5
                     )
                 )
-        },
-
-        .on_type_change = function() private$.calculate(),
-        .on_method_change = function() private$.calculate(),
-        .on_scoring_change = function() private$.calculate(),
-        .on_null_value_change = function() private$.calculate(),
-        .on_conf_level_change = function() private$.calculate_extra(),
-        .on_alternative_change = function() {
-            private$.calculate_side()
-            if (private$.type == "permu") {
-                private$.calculate_p_permu()
-            } else {
-                private$.calculate_p()
-            }
-        },
-        .on_n_permu_change = function() {
-            if (private$.type == "permu") {
-                private$.calculate()
-            }
         }
     ),
     active = list(
@@ -369,7 +370,7 @@ PermuTest <- R6Class(
                     "<", class(self)[1], ">", " object"
                 )
             } else if (length(value) == 1 & !is.na(value)) {
-                private$.null_value <- value
+                private$.null_value <- as.numeric(value)
                 if (!is.null(private$.raw_data)) {
                     private$.on_null_value_change()
                 }
@@ -389,7 +390,7 @@ PermuTest <- R6Class(
             } else if (
                 length(value) == 1 & is.finite(value) & value > 0 & value < 1
             ) {
-                private$.conf_level <- value
+                private$.conf_level <- as.numeric(value)
                 if (!is.null(private$.raw_data)) {
                     private$.on_conf_level_change()
                 }

diff --git a/R/Quantile.R b/R/Quantile.R
@@ -38,6 +38,8 @@ Quantile <- R6Class(
     private = list(
         .name = "Quantile Test",
 
+        .link = "-",
+
         .quantile = NULL,
         .correct = NULL,
 
@@ -50,8 +52,8 @@ Quantile <- R6Class(
         },
 
         .calculate_p = function() {
-            n <- length(private$.data)
             p <- private$.quantile
+            n <- length(private$.data)
 
             private$.estimate <- quantile(private$.data, p, names = FALSE)
 
@@ -73,13 +75,12 @@ Quantile <- R6Class(
         },
 
         .calculate_extra = function() {
-            n <- length(private$.data)
-            beta <- 1 - (1 - private$.conf_level) / 2
             p <- private$.quantile
+            n <- length(private$.data)
 
-            d <- qnorm(beta) * sqrt(n * p * (1 - p))
-            a <- round(p * n - d)
-            b <- round(p * n + 1 + d)
+            d <- qnorm(1 - (1 - private$.conf_level) / 2) * sqrt(n * p * (1 - p))
+            a <- round(n * p - d)
+            b <- round(n * p + 1 + d)
 
             y <- sort(private$.data)
 
@@ -100,9 +101,9 @@ Quantile <- R6Class(
             if (missing(value)) {
                 private$.quantile
             } else if (
-                length(value) == 1 & is.finite(value) & value >= 0 & value <= 1
+                length(value) == 1 & is.finite(value) & value > 0 & value < 1
             ) {
-                private$.quantile <- value
+                private$.quantile <- as.numeric(value)
                 if (!is.null(private$.raw_data)) {
                     private$.define()
                     private$.calculate_p()
@@ -117,7 +118,7 @@ Quantile <- R6Class(
             if (missing(value)) {
                 private$.correct
             } else if (length(value) == 1 & is.logical(value)) {
-                private$.correct <- value
+                private$.correct <- as.logical(value)
                 if (!is.null(private$.raw_data) & private$.type == "asymp") {
                     private$.calculate_p()
                 }

diff --git a/R/RCBDF.R b/R/RCBDF.R
@@ -29,7 +29,7 @@ RCBDF <- R6Class(
         }
     ),
     private = list(
-        .name = "Test for Randomized Complete Block Design Based on F Statistic",
+        .name = "Test for RCBD Based on F Statistic",
 
         .define = function() {
             m <- nrow(private$.data)

diff --git a/R/SiegelTukey.R b/R/SiegelTukey.R
@@ -36,7 +36,7 @@ SiegelTukey <- R6Class(
 
         .scoring = "Siegel-Tukey rank",
         .null_value = 1,
-        .trend = "-",
+        .link = "-",
 
         .calculate_score = function() {
             c_xy <- c(private$.data$x, private$.data$y)

diff --git a/R/Sign.R b/R/Sign.R
@@ -69,7 +69,7 @@ Sign <- R6Class(
             if (missing(value)) {
                 private$.correct
             } else if (length(value) == 1 & is.logical(value)) {
-                private$.correct <- value
+                private$.correct <- as.logical(value)
                 if (!is.null(private$.raw_data) & private$.type == "asymp") {
                     private$.calculate_p()
                 }

diff --git a/R/Wilcoxon.R b/R/Wilcoxon.R
@@ -108,7 +108,7 @@ Wilcoxon <- R6Class(
             if (missing(value)) {
                 private$.correct
             } else if (length(value) == 1 & is.logical(value)) {
-                private$.correct <- value
+                private$.correct <- as.logical(value)
                 if (!is.null(private$.raw_data) & private$.type == "asymp") {
                     private$.calculate_p()
                 }

diff --git a/R/pmt.R b/R/pmt.R
@@ -31,12 +31,15 @@ pmt <- function(key, ...) {
 #' @export
 pmts <- function(
     which = c(
-        "onesample", "twosample",
-        "ksample", "multicomp",
-        "paired", "rcbd",
+        "all",
+        "onesample",
+        "twosample",
+        "ksample",
+        "multicomp",
+        "paired",
+        "rcbd",
         "association",
-        "table",
-        "all"
+        "table"
     )
 ) {
     which <- match.arg(which)

diff --git a/README.Rmd b/README.Rmd
@@ -13,7 +13,6 @@ knitr::opts_chunk$set(
     collapse = TRUE, comment = "#>",
     fig.path = "man/figures/README-", out.width = "100%"
 )
-
 library(LearnNonparam)
 ```
 

diff --git a/README.md b/README.md
@@ -56,19 +56,19 @@ pak::pkg_install("qddyy/LearnNonparam")
 
   ``` r
   t$statistic
-  #> [1] 495
+  #> [1] 539
   t$p_value
-  #> [1] 0.010332
+  #> [1] 0.000148
 
   t$print(digits = 2)
   #> 
   #>       Two Sample Wilcoxon Test 
   #> 
   #> scoring: rank    type: permu(1e+06)    method: default
-  #> statistic = 495, p-value = 0.01
+  #> statistic = 539, p-value = 0.00015
   #> alternative hypothesis: true location shift is not equal to 0
-  #> estimate: 0.99
-  #> 95% confidence interval: (0.097, 1.6)
+  #> estimate: 1.5
+  #> 95% confidence interval: (0.67, 2.1)
 
   t$plot(style = "ggplot2", binwidth = 1)
   #> Loading required namespace: ggplot2
@@ -82,7 +82,7 @@ pak::pkg_install("qddyy/LearnNonparam")
   t$type <- "asymp"
 
   t$p_value
-  #> [1] 0.02226991
+  #> [1] 0.0005090729
   ```
 
 Tests implemented in this package:
@@ -93,10 +93,28 @@ pmts()
 
 <div class="kable-table">
 
-| key                | class    | test                             |
-|:-------------------|:---------|:---------------------------------|
-| onesample.quantile | Quantile | Quantile Test                    |
-| onesample.cdf      | CDF      | Cumulative Distribution Function |
+| key                   | class              | test                                               |
+|:----------------------|:-------------------|:---------------------------------------------------|
+| onesample.quantile    | Quantile           | Quantile Test                                      |
+| onesample.cdf         | CDF                | Inference on Cumulative Distribution Function      |
+| twosample.difference  | Difference         | Two Sample Test Based on Mean or Median            |
+| twosample.wilcoxon    | Wilcoxon           | Two Sample Wilcoxon Test                           |
+| twosample.scoresum    | ScoreSum           | Two Sample Test Based on Sum of Scores             |
+| twosample.ansari      | AnsariBradley      | Ansari-Bradley Test                                |
+| twosample.siegel      | SiegelTukey        | Siegel-Tukey Test                                  |
+| twosample.rmd         | RatioMeanDeviance  | Ratio Mean Deviance Test                           |
+| twosample.ks          | KolmogorovSmirnov  | Two Sample Kolmogorov-Smirnov Test                 |
+| ksample.f             | KSampleF           | K Sample Test Based on F Statistic                 |
+| ksample.kw            | KruskalWallis      | Kruskal-Wallis Test                                |
+| ksample.jt            | JonckheereTerpstra | Jonckheere-Terpstra Test                           |
+| multicomp.studentized | Studentized        | Multiple Comparison Based on Studentized Statistic |
+| paired.sign           | Sign               | Two Sample Sign Test                               |
+| paired.difference     | PairedDifference   | Paired Comparison Based on Differences             |
+| rcbd.f                | RCBDF              | Test for RCBD Based on F Statistic                 |
+| rcbd.friedman         | Friedman           | Friedman Test                                      |
+| rcbd.page             | Page               | Page Test                                          |
+| association.corr      | Correlation        | Test for Association Between Paired Samples        |
+| table.chisq           | ChiSquare          | Chi-Square Test on Contingency Table               |
 
 </div>
-Original file line number
+Diff line change
@@ Expand Up / @@ -13,7 +13,6 @@ knitr::opts_chunk$set( @@
         collapse = TRUE, comment = "#>",
         fig.path = "man/figures/README-", out.width = "100%"
     )
     library(LearnNonparam)
     ```
@@ Expand Down @@