diff --git a/DESCRIPTION b/DESCRIPTION index 5fee45b2..c19f294e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: LearnNonparam Title: Non-parametric Tests -Version: 1.2.0 +Version: 1.2.1 Authors@R: person("Yan", "Du", , "isduyan@outlook.com", 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. diff --git a/NAMESPACE b/NAMESPACE index 046e497b..cb1c6106 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/ANOVA.R b/R/ANOVA.R index e68283a5..f75a6697 100644 --- a/R/ANOVA.R +++ b/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( diff --git a/R/AnsariBradley.R b/R/AnsariBradley.R index aa8fcf3d..78b0d662 100644 --- a/R/AnsariBradley.R +++ b/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( diff --git a/R/CDF.R b/R/CDF.R index c2e2c1fa..f2755db7 100644 --- a/R/CDF.R +++ b/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()) } } diff --git a/R/ChiSquare.R b/R/ChiSquare.R index d00d40bb..ccf9075c 100644 --- a/R/ChiSquare.R +++ b/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 diff --git a/R/ContingencyTableTest.R b/R/ContingencyTableTest.R index 7fa5959d..9a5c0623 100644 --- a/R/ContingencyTableTest.R +++ b/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() { diff --git a/R/Correlation.R b/R/Correlation.R index 1f8cee54..eef573ba 100644 --- a/R/Correlation.R +++ b/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( diff --git a/R/Difference.R b/R/Difference.R index 14389d53..91aa4d5b 100644 --- a/R/Difference.R +++ b/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) diff --git a/R/Friedman.R b/R/Friedman.R index 37601cc3..d64c69f8 100644 --- a/R/Friedman.R +++ b/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) } ) }, diff --git a/R/JonckheereTerpstra.R b/R/JonckheereTerpstra.R index 44dc3d8d..40beb9ac 100644 --- a/R/JonckheereTerpstra.R +++ b/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( diff --git a/R/KSampleTest.R b/R/KSampleTest.R index a1150e23..bb75dc4e 100644 --- a/R/KSampleTest.R +++ b/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) ) }, diff --git a/R/KolmogorovSmirnov.R b/R/KolmogorovSmirnov.R index 5f4fc49f..de7e6c7a 100644 --- a/R/KolmogorovSmirnov.R +++ b/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( diff --git a/R/KruskalWallis.R b/R/KruskalWallis.R index 08a9e460..83b6ea19 100644 --- a/R/KruskalWallis.R +++ b/R/KruskalWallis.R @@ -18,7 +18,6 @@ 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( @@ -26,9 +25,9 @@ KruskalWallis <- R6Class( 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( diff --git a/R/MultiCompT.R b/R/MultiCompT.R index a813a0b7..aec4b55b 100644 --- a/R/MultiCompT.R +++ b/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,8 +69,8 @@ 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 ) }, @@ -80,6 +78,10 @@ MultiCompT <- R6Class( 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() } ) ) \ No newline at end of file diff --git a/R/MultipleComparison.R b/R/MultipleComparison.R index 88ea92e5..80272b9a 100644 --- a/R/MultipleComparison.R +++ b/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) ) }, diff --git a/R/OneSampleTest.R b/R/OneSampleTest.R index 206ac739..f5612f45 100644 --- a/R/OneSampleTest.R +++ b/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]] }, diff --git a/R/Page.R b/R/Page.R index 3ce6ccd4..c767bf90 100644 --- a/R/Page.R +++ b/R/Page.R @@ -12,7 +12,7 @@ Page <- R6Class( classname = "Page", - inherit = RCBD, + inherit = RCBDTest, cloneable = FALSE, public = list( #' @description Create a new `Page` object. @@ -25,9 +25,9 @@ Page <- 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( @@ -36,8 +36,12 @@ Page <- R6Class( .scoring = "rank", .define = function() { + m <- nrow(private$.data) + n <- ncol(private$.data) seq_row <- seq_len(nrow(private$.data)) - private$.statistic_func <- function(data) sum(seq_row * rowSums(data)) + private$.statistic_func <- function(data) { + sum(seq_row * .rowSums(data, m, n)) + } }, .calculate_p = function() { diff --git a/R/PairedDifference.R b/R/PairedDifference.R index 8994c49c..eebb185f 100644 --- a/R/PairedDifference.R +++ b/R/PairedDifference.R @@ -18,7 +18,6 @@ PairedDifference <- R6Class( #' @description Create a new `PairedDifference` object. #' #' @template init_params - #' @param scoring a character string specifying which scoring system to be used on the absolute differences. #' @param method a character string specifying the method of ranking data in computing adjusted signed ranks for tied data, must be one of `"with_zeros"` (default) or `"ignore"`. Note that the data will be modified when this parameter is set to `"ignore"`. #' @param correct a logical indicating whether to apply continuity correction in the normal approximation for the p-value when `scoring` is set to `"rank"`. #' @@ -30,10 +29,12 @@ PairedDifference <- R6Class( alternative = c("two_sided", "less", "greater"), n_permu = 0L, correct = TRUE ) { - private$.init( - type = type, method = method, scoring = scoring, - alternative = alternative, n_permu = n_permu, correct = correct - ) + self$type <- type + self$method <- method + self$scoring <- scoring + self$alternative <- alternative + self$n_permu <- n_permu + self$correct <- correct } ), private = list( @@ -43,18 +44,6 @@ PairedDifference <- R6Class( .abs_diff = NULL, - .init = function(correct, ...) { - super$.init(...) - - if (!missing(correct)) { - if (length(correct) == 1 & is.logical(correct)) { - private$.correct <- correct - } else { - stop("'correct' must be a single logical value") - } - } - }, - .define = function() { diff <- private$.data$x - private$.data$y @@ -95,11 +84,16 @@ PairedDifference <- R6Class( correct = function(value) { if (missing(value)) { private$.correct - } else { - private$.init(correct = value) - if (!is.null(private$.raw_data) & private$.type == "asymp") { + } else if (length(value) == 1 & is.logical(value)) { + private$.correct <- value + if ( + !is.null(private$.raw_data) & + private$.type == "asymp" & private$.scoring == "rank" + ) { private$.calculate_p() } + } else { + stop_without_call("'correct' must be a single logical value") } } ) diff --git a/R/PermuTest.R b/R/PermuTest.R index e15c43df..90f066d9 100644 --- a/R/PermuTest.R +++ b/R/PermuTest.R @@ -14,7 +14,7 @@ PermuTest <- R6Class( cloneable = FALSE, public = list( initialize = function(...) { - stop("Can't construct an object from abstract class") + stop_without_call("Can't construct an object from abstract class") }, #' @description Perform test on data. @@ -52,7 +52,8 @@ PermuTest <- R6Class( if (!is.null(private$.raw_data) & private$.type == "permu") { if (match.arg(style) == "graphics") { private$.plot(...) - } else if (requireNamespace("ggplot2")) { + } else { + requireNamespace("ggplot2") print(private$.autoplot(...)) } } @@ -61,7 +62,7 @@ PermuTest <- R6Class( } ), private = list( - .name = "Permutation Test", + .name = NULL, .param_name = NULL, .type = "permu", @@ -92,60 +93,6 @@ PermuTest <- R6Class( .ci = NULL, .conf_level = NULL, - .init = function( - type, method, scoring, n_permu, - null_value, alternative, conf_level - ) { - if (!missing(n_permu)) { - if (length(n_permu) == 1 & is.finite(n_permu) & n_permu >= 0) { - private$.n_permu <- n_permu - } else { - stop("'n_permu' must be a non-negative integer") - } - } - - if (!missing(null_value)) { - if (length(null_value) == 1 & !is.na(null_value)) { - private$.null_value <- null_value - } else { - stop("'null_value' must be a single number") - } - } - - if (!missing(conf_level)) { - if ( - length(conf_level) == 1 & is.finite(conf_level) & - conf_level > 0 & conf_level < 1 - ) { - private$.conf_level <- conf_level - } else { - stop("'conf_level' must be a single number between 0 and 1") - } - } - - choices <- lapply(formals(self$initialize), eval) - if (!missing(type)) { - private$.type <- match_arg( - arg = type, choices = choices$type - ) - } - if (!missing(method)) { - private$.method <- match_arg( - arg = method, choices = choices$method - ) - } - if (!missing(scoring)) { - private$.scoring <- match_arg( - arg = scoring, choices = choices$scoring - ) - } - if (!missing(alternative)) { - private$.alternative <- match_arg( - arg = alternative, choices = choices$alternative - ) - } - }, - .calculate = function() { private$.preprocess() if (private$.scoring != "none") { @@ -167,40 +114,33 @@ PermuTest <- R6Class( private$.calculate_extra() }, - # @Override .preprocess = function() { # private$.data <- ... }, - # @Override .calculate_score = function() { # private$.data <- ... }, - # @Override .define = function() { # private$.param_name <- ... # private$.statistic_func <- ... }, - # @Override .calculate_statistic = function() { # private$.statistic <- ... }, - # @Override .calculate_p = function() { # private$.p_value <- ... # when private$.type != "permu" }, - # @Override .calculate_extra = function() { # private$.estimate <- ... # private$.ci <- ... }, - # @Override .calculate_statistic_permu = function() { # private$.statistic_permu <- ... }, @@ -287,7 +227,7 @@ PermuTest <- R6Class( cat( paste0( format(private$.conf_level * 100, digits = digits), "%", - " ", "confidence interval:", " ", + " confidence interval: ", "(", format(private$.ci[1], digits = digits), ",", " ", format(private$.ci[2], digits = digits), ")" ) @@ -333,6 +273,25 @@ 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( @@ -340,10 +299,15 @@ PermuTest <- R6Class( type = function(value) { if (missing(value)) { private$.type + } else if (is.null(choices <- formals(self$initialize)$type)) { + stop_without_call( + "Can't specify 'type' of a ", + "<", class(self)[1], ">", " object" + ) } else { - private$.init(type = value) + private$.type <- match.arg(value, eval(choices)) if (!is.null(private$.raw_data)) { - private$.calculate() + private$.on_type_change() } } }, @@ -351,10 +315,15 @@ PermuTest <- R6Class( method = function(value) { if (missing(value)) { private$.method + } else if (is.null(choices <- formals(self$initialize)$method)) { + stop_without_call( + "Can't specify 'method' of a ", + "<", class(self)[1], ">", " object" + ) } else { - private$.init(method = value) + private$.method <- match.arg(value, eval(choices)) if (!is.null(private$.raw_data)) { - private$.calculate() + private$.on_method_change() } } }, @@ -362,60 +331,88 @@ PermuTest <- R6Class( scoring = function(value) { if (missing(value)) { private$.scoring + } else if (is.null(choices <- formals(self$initialize)$scoring)) { + stop_without_call( + "Can't specify 'scoring' of a ", + "<", class(self)[1], ">", " object" + ) } else { - private$.init(scoring = value) + private$.scoring <- match.arg(value, eval(choices)) if (!is.null(private$.raw_data)) { - private$.calculate() + private$.on_scoring_change() } } }, - #' @field null_value The true value of the parameter in the null hypothesis. - null_value = function(value) { + #' @field alternative The alternative hypothesis. + alternative = function(value) { if (missing(value)) { - private$.null_value + private$.alternative + } else if (is.null(choices <- formals(self$initialize)$alternative)) { + stop_without_call( + "Can't specify 'alternative' of a ", + "<", class(self)[1], ">", " object" + ) } else { - private$.init(null_value = value) + private$.alternative <- match.arg(value, eval(choices)) if (!is.null(private$.raw_data)) { - private$.calculate() + private$.on_alternative_change() } } }, - #' @field alternative The alternative hypothesis. - alternative = function(value) { + #' @field null_value The true value of the parameter in the null hypothesis. + null_value = function(value) { if (missing(value)) { - private$.alternative - } else { - private$.init(alternative = value) - private$.calculate_side() + private$.null_value + } else if (is.null(formals(self$initialize)$null_value)) { + stop_without_call( + "Can't specify 'null_value' of a ", + "<", class(self)[1], ">", " object" + ) + } else if (length(value) == 1 & !is.na(value)) { + private$.null_value <- value if (!is.null(private$.raw_data)) { - if (private$.type == "permu") { - private$.calculate_p_permu() - } else { - private$.calculate_p() - } + private$.on_null_value_change() } + } else { + stop_without_call("'null_value' must be a single number") } }, #' @field conf_level The confidence level of the interval. conf_level = function(value) { if (missing(value)) { private$.conf_level - } else { - private$.init(conf_level = value) + } else if (is.null(formals(self$initialize)$conf_level)) { + stop_without_call( + "Can't specify 'conf_level' of a ", + "<", class(self)[1], ">", " object" + ) + } else if ( + length(value) == 1 & is.finite(value) & value > 0 & value < 1 + ) { + private$.conf_level <- value if (!is.null(private$.raw_data)) { - private$.calculate_extra() + private$.on_conf_level_change() } + } else { + stop_without_call("'conf_level' must be a single number between 0 and 1") } }, #' @field n_permu The number of permutations used. n_permu = function(value) { if (missing(value)) { private$.n_permu - } else { - private$.init(n_permu = value) - if (!is.null(private$.raw_data) & private$.type == "permu") { - private$.calculate() + } else if (is.null(formals(self$initialize)$n_permu)) { + stop_without_call( + "Can't specify 'n_permu' of a ", + "<", class(self)[1], ">", " object" + ) + } else if (length(value) == 1 & is.finite(value) & value >= 0) { + private$.n_permu <- as.integer(value) + if (!is.null(private$.raw_data)) { + private$.on_n_permu_change() } + } else { + stop_without_call("'n_permu' must be a non-negative integer") } }, diff --git a/R/Quantile.R b/R/Quantile.R index c7d04693..7a834041 100644 --- a/R/Quantile.R +++ b/R/Quantile.R @@ -22,16 +22,17 @@ Quantile <- R6Class( #' #' @return A `Quantile` object. initialize = function( - type = c("asymp", "exact"), + type = c("asymp", "exact"), alternative = c("two_sided", "less", "greater"), null_value = 0, conf_level = 0.95, prob = 0.5, correct = TRUE ) { - private$.init( - type = type, alternative = alternative, - null_value = null_value, conf_level = conf_level, - prob = prob, correct = correct - ) + self$type <- type + self$alternative <- alternative + self$null_value <- null_value + self$conf_level <- conf_level + self$prob <- prob + self$correct <- correct } ), private = list( @@ -40,29 +41,6 @@ Quantile <- R6Class( .prob = NULL, .correct = NULL, - .init = function(prob, correct, ...) { - super$.init(...) - - if (!missing(prob)) { - if ( - length(prob) == 1 & is.finite(prob) & - prob >= 0 & prob <= 1 - ) { - private$.prob <- prob - } else { - stop("'prob' must be a single number between 0 and 1") - } - } - - if (!missing(correct)) { - if (length(correct) == 1 & is.logical(correct)) { - private$.correct <- correct - } else { - stop("'correct' must be a single logical value") - } - } - }, - .define = function() { private$.param_name <- paste(private$.prob, "quantile") }, @@ -107,43 +85,42 @@ Quantile <- R6Class( if (a >= 1) y[a] else -Inf, if (b <= n) y[b] else Inf ) + }, + + .on_null_value_change = function() { + private$.calculate_statistic() + private$.calculate_p() } ), active = list( - #' @field null_value The true quantile in the null hypothesis. - null_value = function(value) { - if (missing(value)) { - private$.null_value - } else { - private$.init(null_value = value) - if (!is.null(private$.raw_data)) { - private$.calculate_statistic() - private$.calculate_p() - } - } - }, #' @field prob The probability. prob = function(value) { if (missing(value)) { private$.prob - } else { - private$.init(prob = value) + } else if ( + length(value) == 1 & is.finite(value) & value >= 0 & value <= 1 + ) { + private$.prob <- value if (!is.null(private$.raw_data)) { private$.define() private$.calculate_p() private$.calculate_extra() } + } else { + stop_without_call("'prob' must be a single number between 0 and 1") } }, #' @template active_params correct = function(value) { if (missing(value)) { private$.correct - } else { - private$.init(correct = value) + } else if (length(value) == 1 & is.logical(value)) { + private$.correct <- value if (!is.null(private$.raw_data) & private$.type == "asymp") { private$.calculate_p() } + } else { + stop_without_call("'correct' must be a single logical value") } } ) diff --git a/R/RCBDANOVA.R b/R/RCBDANOVA.R index d1eced37..feb29706 100644 --- a/R/RCBDANOVA.R +++ b/R/RCBDANOVA.R @@ -12,7 +12,7 @@ RCBDANOVA <- R6Class( classname = "RCBDANOVA", - inherit = RCBD, + inherit = RCBDTest, cloneable = FALSE, public = list( #' @description Create a new `RCBDANOVA` object. @@ -24,27 +24,26 @@ RCBDANOVA <- 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 = "ANOVA for Randomized Complete Block Design", .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) { - b <- ncol(data) - - bar_i. <- rowMeans(data) - bar_.j <- colMeans(data) + bar_i. <- .rowMeans(data, m, n) + bar_.j <- .colMeans(data, m, n) bar_.. <- mean(bar_i.) - sst <- b * sum((bar_i. - bar_..)^2) + sst <- n * sum((bar_i. - bar_..)^2) sse <- sum((data - outer(bar_i., bar_.j, "+") + bar_..)^2) - (b - 1) * sst / sse + (n - 1) * sst / sse } ) }, diff --git a/R/RCBD.R b/R/RCBDTest.R similarity index 74% rename from R/RCBD.R rename to R/RCBDTest.R index ebbb6de6..312d2d87 100644 --- a/R/RCBD.R +++ b/R/RCBDTest.R @@ -1,6 +1,6 @@ -#' @title RCBD Class +#' @title RCBDTest Class #' -#' @description Abstract class for randomized complete block design. +#' @description Abstract class for tests for randomized complete block design. #' #' #' @export @@ -8,14 +8,16 @@ #' @importFrom R6 R6Class -RCBD <- R6Class( - classname = "RCBD", +RCBDTest <- R6Class( + classname = "RCBDTest", inherit = PermuTest, cloneable = FALSE, private = list( - .name = "Randomized Complete Block Design", - .preprocess = function() { + if (length(unique(lengths(private$.raw_data))) > 1) { + stop_without_call("All samples must be of equal length") + } + private$.data <- unname(do_call(cbind, private$.raw_data)) }, diff --git a/R/RatioMeanDeviance.R b/R/RatioMeanDeviance.R index 1a640c3d..aee30669 100644 --- a/R/RatioMeanDeviance.R +++ b/R/RatioMeanDeviance.R @@ -23,9 +23,8 @@ RatioMeanDeviance <- R6Class( alternative = c("two_sided", "less", "greater"), n_permu = 0L ) { - private$.init( - alternative = alternative, n_permu = n_permu - ) + self$alternative <- alternative + self$n_permu <- n_permu } ), private = list( diff --git a/R/ScoreSum.R b/R/ScoreSum.R index 6a04f9dd..410ae575 100644 --- a/R/ScoreSum.R +++ b/R/ScoreSum.R @@ -24,9 +24,9 @@ ScoreSum <- R6Class( alternative = c("two_sided", "less", "greater"), n_permu = 0L ) { - private$.init( - scoring = scoring, alternative = alternative, n_permu = n_permu - ) + self$scoring <- scoring + self$alternative <- alternative + self$n_permu <- n_permu } ), private = list( diff --git a/R/SiegelTukey.R b/R/SiegelTukey.R index 4152b32a..d44f7298 100644 --- a/R/SiegelTukey.R +++ b/R/SiegelTukey.R @@ -24,10 +24,10 @@ SiegelTukey <- R6Class( alternative = c("two_sided", "less", "greater"), n_permu = 0L, correct = TRUE ) { - super$.init( - type = type, alternative = alternative, - n_permu = n_permu, correct = correct - ) + self$type <- type + self$alternative <- alternative + self$n_permu <- n_permu + self$correct <- correct } ), private = list( @@ -42,8 +42,8 @@ SiegelTukey <- R6Class( c_xy <- c(private$.data$x, private$.data$y) N <- length(c_xy) - rank_l <- outer(c(1, 4), seq.int(from = 0, to = N - 1, by = 4), "+") - rank_r <- outer(c(0, 1), seq.int(from = 2, to = N, by = 4), "+") + rank_l <- outer(c(1, 4), seq.int(0, N - 1, by = 4), "+") + rank_r <- outer(c(0, 1), seq.int(2, N, by = 4), "+") index_floor <- seq_len(floor(N / 2)) index_ceiling <- seq_len(ceiling(N / 2)) diff --git a/R/Sign.R b/R/Sign.R index f265a46a..a9d1fe38 100644 --- a/R/Sign.R +++ b/R/Sign.R @@ -25,10 +25,10 @@ Sign <- R6Class( alternative = c("two_sided", "less", "greater"), n_permu = 0L, correct = TRUE ) { - private$.init( - type = type, alternative = alternative, - n_permu = n_permu, correct = correct - ) + self$type <- type + self$alternative <- alternative + self$n_permu <- n_permu + self$correct <- correct } ), private = list( @@ -36,18 +36,6 @@ Sign <- R6Class( .correct = NULL, - .init = function(correct, ...) { - super$.init(...) - - if (!missing(correct)) { - if (length(correct) == 1 & is.logical(correct)) { - private$.correct <- correct - } else { - stop("'correct' must be a single logical value") - } - } - }, - .define = function() { diff_positive <- (private$.data$x > private$.data$y) private$.statistic_func <- function(swapped) { @@ -80,11 +68,13 @@ Sign <- R6Class( correct = function(value) { if (missing(value)) { private$.correct - } else { - private$.init(correct = value) + } else if (length(value) == 1 & is.logical(value)) { + private$.correct <- value if (!is.null(private$.raw_data) & private$.type == "asymp") { private$.calculate_p() } + } else { + stop_without_call("'correct' must be a single logical value") } } ) diff --git a/R/TukeyHSD.R b/R/TukeyHSD.R index 462b890b..baf422ad 100644 --- a/R/TukeyHSD.R +++ b/R/TukeyHSD.R @@ -27,20 +27,17 @@ TukeyHSD <- R6Class( scoring = c("none", "rank", "vw", "expon"), conf_level = 0.95, n_permu = 0L ) { - private$.init( - type = type, scoring = scoring, - conf_level = conf_level, n_permu = n_permu - ) + self$type <- type + self$scoring <- scoring + self$conf_level <- conf_level + self$n_permu <- n_permu } ), private = list( .name = "Tukey's HSD", .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) @@ -76,8 +73,9 @@ TukeyHSD <- R6Class( }, .calculate_p_permu = function() { - private$.p_value <- rowMeans( - outer(private$.statistic, private$.statistic_permu, `<=`) + private$.p_value <- .rowMeans( + outer(private$.statistic, private$.statistic_permu, `<=`), + length(private$.statistic), length(private$.statistic_permu) ) }, diff --git a/R/TwoSampleAssociationTest.R b/R/TwoSampleAssociationTest.R index 25d9c6ba..da5462e1 100644 --- a/R/TwoSampleAssociationTest.R +++ b/R/TwoSampleAssociationTest.R @@ -1,6 +1,6 @@ #' @title TwoSampleAssociationTest Class #' -#' @description Abstract class for two sample permutation tests for association. +#' @description Abstract class for two sample tests for association. #' #' #' @export @@ -13,11 +13,13 @@ TwoSampleAssociationTest <- R6Class( inherit = TwoSampleTest, cloneable = FALSE, private = list( - .name = "Two Sample Permutation Test for Association", - .preprocess = function() { super$.preprocess() + if (length(private$.data$x) != length(private$.data$y)) { + stop_without_call("Both samples must be of equal length") + } + private$.data <- do_call(data.frame, private$.data) }, diff --git a/R/TwoSamplePairedTest.R b/R/TwoSamplePairedTest.R index 10fb838f..af48c871 100644 --- a/R/TwoSamplePairedTest.R +++ b/R/TwoSamplePairedTest.R @@ -1,6 +1,6 @@ #' @title TwoSamplePairedTest Class #' -#' @description Abstract class for paired two sample permutation tests. +#' @description Abstract class for paired two sample tests. #' #' #' @export @@ -13,11 +13,13 @@ TwoSamplePairedTest <- R6Class( inherit = TwoSampleTest, cloneable = FALSE, private = list( - .name = "Paired Two Sample Permutation Test", - .preprocess = function() { super$.preprocess() + if (length(private$.data$x) != length(private$.data$y)) { + stop_without_call("Both samples must be of equal length") + } + private$.data <- do_call(data.frame, private$.data) }, diff --git a/R/TwoSampleTest.R b/R/TwoSampleTest.R index 8cd5f95a..ebfa6525 100644 --- a/R/TwoSampleTest.R +++ b/R/TwoSampleTest.R @@ -1,6 +1,6 @@ #' @title TwoSampleTest Class #' -#' @description Abstract class for two sample permutation tests. +#' @description Abstract class for two sample tests. #' #' #' @export @@ -13,9 +13,11 @@ TwoSampleTest <- R6Class( inherit = PermuTest, cloneable = FALSE, private = list( - .name = "Two Sample Permutation Test", - .preprocess = function() { + if (length(private$.raw_data) != 2) { + stop_without_call("Must provide two samples") + } + private$.data <- `names<-`(private$.raw_data, c("x", "y")) }, diff --git a/R/Wilcoxon.R b/R/Wilcoxon.R index 80390aa9..e0971321 100644 --- a/R/Wilcoxon.R +++ b/R/Wilcoxon.R @@ -25,10 +25,11 @@ Wilcoxon <- R6Class( alternative = c("two_sided", "less", "greater"), conf_level = 0.95, n_permu = 0L, correct = TRUE ) { - private$.init( - type = type, alternative = alternative, - conf_level = conf_level, n_permu = n_permu, correct = correct - ) + self$type <- type + self$alternative <- alternative + self$conf_level <- conf_level + self$n_permu <- n_permu + self$correct <- correct } ), private = list( @@ -40,18 +41,6 @@ Wilcoxon <- R6Class( .correct = NULL, - .init = function(correct, ...) { - super$.init(...) - - if (!missing(correct)) { - if (length(correct) == 1 & is.logical(correct)) { - private$.correct <- correct - } else { - stop("'correct' must be a single logical value") - } - } - }, - .define = function() { private$.statistic_func <- function(x, y) sum(x) }, @@ -64,8 +53,8 @@ Wilcoxon <- R6Class( ties <- tabulate(c(private$.data$x, private$.data$y)) if (any(ties > 1)) { + warn_without_call("There exist ties, setting 'type' to 'asymp'") private$.type <- "asymp" - warning("There are ties in data, changing 'type' to 'asymp'") } if (private$.type == "exact") { @@ -118,11 +107,13 @@ Wilcoxon <- R6Class( correct = function(value) { if (missing(value)) { private$.correct - } else { - private$.init(correct = value) + } else if (length(value) == 1 & is.logical(value)) { + private$.correct <- value if (!is.null(private$.raw_data) & private$.type == "asymp") { private$.calculate_p() } + } else { + stop_without_call("'correct' must be a single logical value") } } ) diff --git a/R/pmt.R b/R/pmt.R index b59e7a86..1dec35ef 100644 --- a/R/pmt.R +++ b/R/pmt.R @@ -7,7 +7,7 @@ #' @rdname pmt #' -#' @param key a character string corresponding to the desired test. Check `pmts` to see available keys. +#' @param key a character string corresponding to the desired test. See `pmts` for available keys. #' @param ... extra parameters passed to the constructor. #' #' @export @@ -16,10 +16,16 @@ pmt <- function(key, ...) tests[[key]]$new(...) #' @rdname pmt #' -#' @param which a character string specifying which tests to show. If `"all"` (default) then available tests are shown. +#' @param which a character string specifying which tests to show. If `"all"` (default) then all available tests are shown. #' #' @export -pmts <- function(which = c("all", "onesample", "twosample", "ksample", "multicomp", "paired", "rcbd", "association", "table")) { +pmts <- function( + which = c( + "all", + "onesample", "twosample", "ksample", "multicomp", + "paired", "rcbd", "association", "table" + ) +) { which <- match.arg(which) keys <- names(tests) diff --git a/R/utils.R b/R/utils.R index 440b56c8..17c63dc0 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,3 +1,8 @@ +stop_without_call <- function(...) stop(..., call. = FALSE) +warn_without_call <- function(...) warning(..., call. = FALSE) + +deparse_1 <- function(x) paste(deparse(x, width.cutoff = 500), collapse = " ") + do_call <- function(func, default = NULL, fixed = NULL, ...) { env_args <- list2env(as.list(default)) env_args <- list2env(list(...), envir = env_args) @@ -9,34 +14,18 @@ do_call <- function(func, default = NULL, fixed = NULL, ...) { ) } -deparse_1 <- function(expr) { - paste(deparse(expr, width.cutoff = 500), collapse = " ") -} - -# for .init() - -match_arg <- function(arg, choices) { - if (is.null(choices)) { - warning( - paste0( - "Can't modify", " ", - "'", deparse_1(substitute(arg)), "'", - ", ignored" - ) - ) - } else { - match.arg(arg = arg, choices = choices, several.ok = FALSE) - } -} - # for test() get_data <- function(call, env) { data_exprs <- as.list(call)[-1] n_data <- length(data_exprs) - if ((n_data == 1) & is.list(data_1 <- eval(data_exprs[[1]], envir = env))) { + if ( + (n_data == 1) & + is.list(data_1 <- eval(data_exprs[[1]], envir = env)) + ) { data_exprs <- data_1 + n_data <- length(data_1) } data_names <- names(data_exprs) @@ -44,15 +33,22 @@ get_data <- function(call, env) { data_names <- rep.int("", n_data) } - unlist(.mapply( - dots = list(data_exprs, data_names), - FUN = function(data_expr, data_name) { - `names<-`( - list(eval(data_expr, envir = env)), - if (data_name != "") data_name else deparse_1(data_expr) - ) - }, MoreArgs = NULL - ), recursive = FALSE, use.names = TRUE) + `names<-`(lapply( + seq.int(1, n_data), function(i) { + if (data_names[[i]] == "") { + data_names[[i]] <<- deparse_1(data_exprs[[i]]) + } + + data_i <- eval(data_exprs[[i]], envir = env) + if (!is.numeric(data_i)) { + stop_without_call("The ", i, "-th sample is not numeric") + } + if (anyNA(data_i)) { + warn_without_call("The ", i, "-th sample contains NA, removed") + data_i[!is.na(data_i)] + } else data_i + } + ), data_names) } # for .calculate_score() diff --git a/man/ContingencyTableTest.Rd b/man/ContingencyTableTest.Rd index 8853190c..d865d94a 100644 --- a/man/ContingencyTableTest.Rd +++ b/man/ContingencyTableTest.Rd @@ -4,7 +4,7 @@ \alias{ContingencyTableTest} \title{ContingencyTableTest Class} \description{ -Abstract class for permutation tests on contingency tables. +Abstract class for tests on contingency tables. } \section{Super class}{ \code{\link[LearnNonparam:PermuTest]{LearnNonparam::PermuTest}} -> \code{ContingencyTableTest} diff --git a/man/Friedman.Rd b/man/Friedman.Rd index a35f56a6..47132645 100644 --- a/man/Friedman.Rd +++ b/man/Friedman.Rd @@ -8,7 +8,7 @@ Performs Friedman test on data for a randomized complete block design. } \section{Super classes}{ -\code{\link[LearnNonparam:PermuTest]{LearnNonparam::PermuTest}} -> \code{\link[LearnNonparam:RCBD]{LearnNonparam::RCBD}} -> \code{Friedman} +\code{\link[LearnNonparam:PermuTest]{LearnNonparam::PermuTest}} -> \code{\link[LearnNonparam:RCBDTest]{LearnNonparam::RCBDTest}} -> \code{Friedman} } \section{Methods}{ \subsection{Public methods}{ diff --git a/man/KruskalWallis.Rd b/man/KruskalWallis.Rd index e3504b66..59ab48c8 100644 --- a/man/KruskalWallis.Rd +++ b/man/KruskalWallis.Rd @@ -41,7 +41,7 @@ Create a new \code{KruskalWallis} object. \subsection{Arguments}{ \if{html}{\out{
}} \describe{ -\item{\code{type}}{a character string specifying the way to calculate p-values, must be one of \code{"permu"} (default) or \code{"asymp"}.} +\item{\code{type}}{a character string specifying the way to calculate the p-value.} \item{\code{scoring}}{a character string specifying which scoring system to be used.} diff --git a/man/Page.Rd b/man/Page.Rd index 53df6592..a06482a2 100644 --- a/man/Page.Rd +++ b/man/Page.Rd @@ -8,7 +8,7 @@ Performs Page test on data for a randomized complete block design. } \section{Super classes}{ -\code{\link[LearnNonparam:PermuTest]{LearnNonparam::PermuTest}} -> \code{\link[LearnNonparam:RCBD]{LearnNonparam::RCBD}} -> \code{Page} +\code{\link[LearnNonparam:PermuTest]{LearnNonparam::PermuTest}} -> \code{\link[LearnNonparam:RCBDTest]{LearnNonparam::RCBDTest}} -> \code{Page} } \section{Methods}{ \subsection{Public methods}{ diff --git a/man/PairedDifference.Rd b/man/PairedDifference.Rd index 62909d8d..2be707ac 100644 --- a/man/PairedDifference.Rd +++ b/man/PairedDifference.Rd @@ -55,7 +55,7 @@ Create a new \code{PairedDifference} object. \item{\code{method}}{a character string specifying the method of ranking data in computing adjusted signed ranks for tied data, must be one of \code{"with_zeros"} (default) or \code{"ignore"}. Note that the data will be modified when this parameter is set to \code{"ignore"}.} -\item{\code{scoring}}{a character string specifying which scoring system to be used on the absolute differences.} +\item{\code{scoring}}{a character string specifying which scoring system to be used.} \item{\code{alternative}}{a character string specifying the alternative hypothesis.} diff --git a/man/PermuTest.Rd b/man/PermuTest.Rd index d23d0f30..c876b8bc 100644 --- a/man/PermuTest.Rd +++ b/man/PermuTest.Rd @@ -15,10 +15,10 @@ Abstract class for permutation tests. \item{\code{scoring}}{The scoring system used.} -\item{\code{null_value}}{The true value of the parameter in the null hypothesis.} - \item{\code{alternative}}{The alternative hypothesis.} +\item{\code{null_value}}{The true value of the parameter in the null hypothesis.} + \item{\code{conf_level}}{The confidence level of the interval.} \item{\code{n_permu}}{The number of permutations used.} diff --git a/man/Quantile.Rd b/man/Quantile.Rd index fcad53ca..fdf86c5b 100644 --- a/man/Quantile.Rd +++ b/man/Quantile.Rd @@ -13,8 +13,6 @@ Performs one sample quantile test on data vectors. In addition, a confidence int \section{Active bindings}{ \if{html}{\out{
}} \describe{ -\item{\code{null_value}}{The true quantile in the null hypothesis.} - \item{\code{prob}}{The probability.} \item{\code{correct}}{Whether to apply continuity correction.} diff --git a/man/RCBD.Rd b/man/RCBD.Rd deleted file mode 100644 index 28e67c8d..00000000 --- a/man/RCBD.Rd +++ /dev/null @@ -1,11 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/RCBD.R -\name{RCBD} -\alias{RCBD} -\title{RCBD Class} -\description{ -Abstract class for randomized complete block design. -} -\section{Super class}{ -\code{\link[LearnNonparam:PermuTest]{LearnNonparam::PermuTest}} -> \code{RCBD} -} diff --git a/man/RCBDANOVA.Rd b/man/RCBDANOVA.Rd index efd1b732..8aa56e76 100644 --- a/man/RCBDANOVA.Rd +++ b/man/RCBDANOVA.Rd @@ -8,7 +8,7 @@ Performs F-statistic based permutation test on data for a randomized complete block design. } \section{Super classes}{ -\code{\link[LearnNonparam:PermuTest]{LearnNonparam::PermuTest}} -> \code{\link[LearnNonparam:RCBD]{LearnNonparam::RCBD}} -> \code{RCBDANOVA} +\code{\link[LearnNonparam:PermuTest]{LearnNonparam::PermuTest}} -> \code{\link[LearnNonparam:RCBDTest]{LearnNonparam::RCBDTest}} -> \code{RCBDANOVA} } \section{Methods}{ \subsection{Public methods}{ diff --git a/man/RCBDTest.Rd b/man/RCBDTest.Rd new file mode 100644 index 00000000..81ba2dd2 --- /dev/null +++ b/man/RCBDTest.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/RCBDTest.R +\name{RCBDTest} +\alias{RCBDTest} +\title{RCBDTest Class} +\description{ +Abstract class for tests for randomized complete block design. +} +\section{Super class}{ +\code{\link[LearnNonparam:PermuTest]{LearnNonparam::PermuTest}} -> \code{RCBDTest} +} diff --git a/man/TwoSampleAssociationTest.Rd b/man/TwoSampleAssociationTest.Rd index f694b8fa..f6855172 100644 --- a/man/TwoSampleAssociationTest.Rd +++ b/man/TwoSampleAssociationTest.Rd @@ -4,7 +4,7 @@ \alias{TwoSampleAssociationTest} \title{TwoSampleAssociationTest Class} \description{ -Abstract class for two sample permutation tests for association. +Abstract class for two sample tests for association. } \section{Super classes}{ \code{\link[LearnNonparam:PermuTest]{LearnNonparam::PermuTest}} -> \code{\link[LearnNonparam:TwoSampleTest]{LearnNonparam::TwoSampleTest}} -> \code{TwoSampleAssociationTest} diff --git a/man/TwoSamplePairedTest.Rd b/man/TwoSamplePairedTest.Rd index f369759a..15321084 100644 --- a/man/TwoSamplePairedTest.Rd +++ b/man/TwoSamplePairedTest.Rd @@ -4,7 +4,7 @@ \alias{TwoSamplePairedTest} \title{TwoSamplePairedTest Class} \description{ -Abstract class for paired two sample permutation tests. +Abstract class for paired two sample tests. } \section{Super classes}{ \code{\link[LearnNonparam:PermuTest]{LearnNonparam::PermuTest}} -> \code{\link[LearnNonparam:TwoSampleTest]{LearnNonparam::TwoSampleTest}} -> \code{TwoSamplePairedTest} diff --git a/man/TwoSampleTest.Rd b/man/TwoSampleTest.Rd index b3be7bb0..8fa2e236 100644 --- a/man/TwoSampleTest.Rd +++ b/man/TwoSampleTest.Rd @@ -4,7 +4,7 @@ \alias{TwoSampleTest} \title{TwoSampleTest Class} \description{ -Abstract class for two sample permutation tests. +Abstract class for two sample tests. } \section{Super class}{ \code{\link[LearnNonparam:PermuTest]{LearnNonparam::PermuTest}} -> \code{TwoSampleTest} diff --git a/man/pmt.Rd b/man/pmt.Rd index 602f7279..bb6f43e4 100644 --- a/man/pmt.Rd +++ b/man/pmt.Rd @@ -13,11 +13,11 @@ pmts( ) } \arguments{ -\item{key}{a character string corresponding to the desired test. Check \code{pmts} to see available keys.} +\item{key}{a character string corresponding to the desired test. See \code{pmts} for available keys.} \item{...}{extra parameters passed to the constructor.} -\item{which}{a character string specifying which tests to show. If \code{"all"} (default) then available tests are shown.} +\item{which}{a character string specifying which tests to show. If \code{"all"} (default) then all available tests are shown.} } \description{ construct a test object in a unified way. diff --git a/man/roxygen/templates/init_params.R b/man/roxygen/templates/init_params.R index f5dc9730..45859bd1 100644 --- a/man/roxygen/templates/init_params.R +++ b/man/roxygen/templates/init_params.R @@ -1,10 +1,10 @@ #' @param scoring a character string specifying which scoring system to be used. #' -#' @param n_permu an integer specifying how many permutations should be used to construct the permutation distribution. If set to zero (default) then all permutations are used. +#' @param n_permu an integer specifying how many permutations should be used to construct the permutation distribution. If set to zero (default) then all permutations are used. #' -#' @param type a character string specifying the way to calculate the p-value. +#' @param type a character string specifying the way to calculate the p-value. #' -#' @param alternative a character string specifying the alternative hypothesis. -#' @param null_value a number specifying the value of the parameter in the null hypothesis. -#' @param conf_level a number specifying confidence level of the interval. -#' @param correct a logical indicating whether to apply continuity correction in the normal approximation for the p-value. \ No newline at end of file +#' @param alternative a character string specifying the alternative hypothesis. +#' @param null_value a number specifying the value of the parameter in the null hypothesis. +#' @param conf_level a number specifying confidence level of the interval. +#' @param correct a logical indicating whether to apply continuity correction in the normal approximation for the p-value. \ No newline at end of file diff --git a/vignettes/examples.Rmd b/vignettes/examples.Rmd index a959aa97..a14ea8e4 100644 --- a/vignettes/examples.Rmd +++ b/vignettes/examples.Rmd @@ -402,7 +402,10 @@ t <- pmt( "paired.sign", alternative = "greater", type = "exact" ) -t$test(c(rep(+1, 12), rep(-1, 5)), 0) +t$test( + rep(c(+1, -1), c(12, 5)), + rep(0, 17) +) t$statistic t$p_value