diff --git a/DESCRIPTION b/DESCRIPTION index 9b2f31c..180e9fc 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -23,7 +23,9 @@ Suggests: Config/testthat/edition: 3 Imports: dplyr, - lifecycle + lifecycle, + rlang (>= 1.1.0) URL: https://github.com/JeffreyRStevens/cocoon, https://jeffreyrstevens.github.io/cocoon/ BugReports: https://github.com/JeffreyRStevens/cocoon/issues -VignetteBuilder: knitr +VignetteBuilder: + knitr diff --git a/NAMESPACE b/NAMESPACE index b42d8fc..ba73d2d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,7 @@ # Generated by roxygen2: do not edit by hand S3method(format_stats,BFBayesFactor) +S3method(format_stats,aov) S3method(format_stats,default) S3method(format_stats,easycorrelation) S3method(format_stats,htest) @@ -21,3 +22,5 @@ export(format_sub) export(format_summary) export(format_ttest) importFrom(lifecycle,deprecated) +importFrom(rlang,ffi_standalone_check_number_1.0.7) +importFrom(rlang,ffi_standalone_is_bool_1.0.7) diff --git a/R/cocoon-package.R b/R/cocoon-package.R index 425b3c1..79fd574 100644 --- a/R/cocoon-package.R +++ b/R/cocoon-package.R @@ -3,5 +3,7 @@ ## usethis namespace: start #' @importFrom lifecycle deprecated +#' @importFrom rlang ffi_standalone_check_number_1.0.7 +#' @importFrom rlang ffi_standalone_is_bool_1.0.7 ## usethis namespace: end NULL diff --git a/R/format_numbers.R b/R/format_numbers.R index ca7accf..102e1a4 100644 --- a/R/format_numbers.R +++ b/R/format_numbers.R @@ -17,9 +17,8 @@ format_num <- function(x, digits = 1, pzero = TRUE) { # Check arguments - stopifnot("Input must be a numeric vector." = is.numeric(x)) - stopifnot("Argument `digits` must be a non-negative numeric vector." = is.numeric(digits)) - stopifnot("Argument `digits` must be a non-negative numeric vector." = digits >= 0) + check_numeric(x) + check_number_whole(digits, min = 0) # Format number dplyr::case_when( @@ -48,10 +47,9 @@ format_scientific <- function(x, digits = 1, type = "md") { # Check arguments - stopifnot("Input must be a numeric vector." = is.numeric(x)) - stopifnot("Argument `digits` must be a non-negative numeric vector." = is.numeric(digits)) - stopifnot("Argument `digits` must be a non-negative numeric vector." = digits >= 0) - stopifnot("Argument `type` must be 'md' or 'latex'." = type %in% c("md", "latex")) + check_numeric(x) + check_number_whole(digits, min = 1) + check_match(type, c("md", "latex")) # Format number num <- formatC(x, digits = digits, format = "e") @@ -91,9 +89,9 @@ format_chr <- function(x, italics = TRUE, type = "md") { # Check arguments - stopifnot("Input must be a character string." = is.character(x)) - stopifnot("Argument `italics` must be TRUE or FALSE." = is.logical(italics)) - stopifnot("Argument `type` must be 'md' or 'latex'." = type %in% c("md", "latex")) + check_string(x) + check_bool(italics) + check_match(type, c("md", "latex")) dplyr::case_when( italics & type == "md" ~ paste0("_", x, "_"), italics & type == "latex" ~ paste0("$", x, "$"), @@ -119,8 +117,8 @@ format_chr <- function(x, format_sub <- function(subscript = NULL, type = "md") { # Check arguments - stopifnot("Input must be a character string or NULL." = is.character(subscript) | is.null(subscript)) - stopifnot("Argument `type` must be 'md' or 'latex'." = type %in% c("md", "latex")) + check_string(subscript, allow_null = TRUE) + check_match(type, c("md", "latex")) dplyr::case_when( subscript == "" ~ "", !is.null(subscript) & type == "md" ~ paste0("~", subscript, "~"), diff --git a/R/format_stats.R b/R/format_stats.R index 9a7c6c0..4dc667e 100644 --- a/R/format_stats.R +++ b/R/format_stats.R @@ -7,6 +7,7 @@ #' 1. `htest` objects of correlations, t-tests, and Wilcoxon tests #' 1. correlations from the #' \{[correlation](https://cran.r-project.org/package=correlation)\} package. +#' 1. `aov` objects for ANOVAs #' 1. Bayes factors from the #' \{[BayesFactor](https://cran.r-project.org/package=BayesFactor)\} package. #' The function invokes specific methods that depend on the class of the @@ -69,293 +70,3 @@ format_stats.default <- function(x, ...) { ) } } - -#' Format hypothesis test statistics -#' -#' This method formats hypothesis test statistics from the class `htest`. -#' Currently, this includes correlations from [cor.test()] and t-tests and -#' Wilcoxon tests from [t.test()] and [wilcox.test()]. For correlations, the -#' function detects whether the object is from a Pearson, -#' Spearman, or Kendall correlation and reports the appropriate correlation -#' label (r, \eqn{\tau}, \eqn{\rho}). The default output is APA formatted, but -#' this function allows control over numbers of -#' digits, leading zeros, the presence of means and confidence intervals, -#' italics, degrees of freedom, and mean labels, and output format of -#' Markdown or LaTeX. -#' -#' @param x An `htest` object -#' @param digits Number of digits after the decimal for means, confidence -#' intervals, and test statistics -#' @param pdigits Number of digits after the decimal for p-values, ranging -#' between 1-5 (also controls cutoff for small p-values) -#' @param pzero Logical value (default = FALSE) for whether to include -#' leading zero for p-values -#' @param full Logical value (default = TRUE) for whether to include means -#' and confidence intervals or just test statistic and p-value -#' @param italics Logical value (default = TRUE) for whether _p_ label should be -#' italicized -#' @param dfs Formatting for degrees of freedom ("par" = parenthetical, -#' "sub" = subscript, "none" = do not print degrees of freedom) -#' @param mean Formatting for mean label ("abbr" = M, "word" = Mean) -#' @param type Type of formatting ("md" = markdown, "latex" = LaTeX) -#' @param ... Additional arguments passed to methods. -#' -#' @return -#' A character string of statistical information formatted in Markdown or LaTeX. -#' -#' @method format_stats htest -#' @family functions for printing statistical objects -#' @export -#' -#' @examples -#' # Prepare statistical objects -#' test_corr <- cor.test(mtcars$mpg, mtcars$cyl) -#' test_corr2 <- cor.test(mtcars$mpg, mtcars$cyl, method = "kendall") -#' test_ttest <- t.test(mtcars$vs, mtcars$am) -#' test_ttest2 <- wilcox.test(mtcars$vs, mtcars$am) -#' -#' # Format correlation -#' format_stats(test_corr) -#' -#' # Remove confidence intervals and italics -#' format_stats(test_corr, full = FALSE, italics = FALSE) -#' -#' # Change digits and add leading zero to p-value -#' format_stats(test_corr, digits = 3, pdigits = 4, pzero = TRUE) -#' -#' # Format Kendall's tau -#' format_stats(test_corr2) -#' -#' # Format t-test -#' format_stats(test_ttest) -#' -#' # Remove mean and confidence interval -#' format_stats(test_ttest, full = FALSE) -#' -#' # Remove degrees of freedom and spell out "Mean" -#' format_stats(test_ttest, dfs = "none", mean = "word") -#' -#' # Format for LaTeX -#' format_stats(test_ttest2, type = "latex") -format_stats.htest <- function(x, - digits = NULL, - pdigits = 3, - pzero = FALSE, - full = TRUE, - italics = TRUE, - dfs = "par", - mean = "abbr", - type = "md", - ...) { - # Validate arguments - if (!is.null(digits)) { - stopifnot("Argument `digits` must be a non-negative numeric vector." = is.numeric(digits)) - stopifnot("Argument `digits` must be a non-negative numeric vector." = digits >= 0) - } - stopifnot("Argument `pdigits` must be a numeric between 1 and 5." = is.numeric(pdigits)) - stopifnot("Argument `pdigits` must be a numeric between 1 and 5." = pdigits > 0) - stopifnot("Argument `pdigits` must be a numeric between 1 and 5." = pdigits < 6) - stopifnot("Argument `pzero` must be TRUE or FALSE." = is.logical(pzero)) - stopifnot("Argument `full` must be TRUE or FALSE." = is.logical(full)) - stopifnot("Argument `italics` must be TRUE or FALSE." = is.logical(italics)) - stopifnot("Argument `dfs` must be 'par', 'sub', or 'none'." = dfs %in% c("par", "sub", "none")) - stopifnot("Argument `mean` must be 'abbr' or 'word'." = mean %in% c("abbr", "word")) - stopifnot("Argument `type` must be 'md' or 'latex'." = type %in% c("md", "latex")) - - if (grepl("correlation", x$method)) { - if (is.null(digits)) { - digits <- 2 - } else { - digits <- digits - } - format_corr(x, - digits = digits, - pdigits = pdigits, - pzero = pzero, - full = full, - italics = italics, - type = type) - } else if (grepl("t-test", x$method) | grepl("Wilcoxon", x$method)) { - if (is.null(digits)) { - digits <- 1 - } else { - digits <- digits - } - format_ttest(x, - digits = digits, - pdigits = pdigits, - pzero = pzero, - full = full, - italics = italics, - dfs = dfs, - mean = mean, - type = type) - } else { - stop( - "Objects of method '" - , x$method - , "' are currently not supported." - , "\nVisit https://github.com/JeffreyRStevens/cocoon/issues to request support for this method." - , call. = FALSE - ) - } -} - -#' Format correlation statistics -#' -#' @description -#' This functions formats correlation statistics generated from the -#' \{[correlation](https://cran.r-project.org/package=correlation)\} package. -#' This detects whether the object is from a Pearson, Spearman, or Kendall -#' correlation and reports the appropriate correlation label -#' (r, \eqn{\tau}, \eqn{\rho}). The default output is APA formatted, but -#' numbers of digits, leading zeros, the presence of confidence intervals, -#' and italics are all customizable. - -#' @inheritParams format_stats.htest -#' -#' @return -#' A character string of statistical information formatted in Markdown or LaTeX. -#' -#' @method format_stats easycorrelation -#' @family functions for printing statistical objects - -#' @export -#' -#' @examples -#' # Prepare statistical objects -#' test_corr <- correlation::correlation(mtcars, select = "mpg", select2 = "disp") -#' test_corr2 <- correlation::correlation(mtcars, select = "mpg", select2 = "disp", method = "kendall") -#' -#' # Format correlation -#' format_stats(test_corr) -#' -#' # Remove confidence intervals and italics -#' format_stats(test_corr, full = FALSE, italics = FALSE) -#' -#' # Change digits and add leading zero to p-value -#' format_stats(test_corr, digits = 3, pdigits = 4, pzero = TRUE) -#' -#' # Format Kendall's tau for LaTeX -#' format_stats(test_corr2, type = "latex") -format_stats.easycorrelation <- function(x, - digits = 2, - pdigits = 3, - pzero = FALSE, - full = TRUE, - italics = TRUE, - type = "md", - ...) { - # Validate arguments - if (!is.null(digits)) { - stopifnot("Argument `digits` must be a non-negative numeric vector." = is.numeric(digits)) - stopifnot("Argument `digits` must be a non-negative numeric vector." = digits >= 0) - } - stopifnot("Argument `pdigits` must be a numeric between 1 and 5." = is.numeric(pdigits)) - stopifnot("Argument `pdigits` must be a numeric between 1 and 5." = pdigits > 0) - stopifnot("Argument `pdigits` must be a numeric between 1 and 5." = pdigits < 6) - stopifnot("Argument `pzero` must be TRUE or FALSE." = is.logical(pzero)) - stopifnot("Argument `full` must be TRUE or FALSE." = is.logical(full)) - stopifnot("Argument `italics` must be TRUE or FALSE." = is.logical(italics)) - stopifnot("Argument `type` must be 'md' or 'latex'." = type %in% c("md", "latex")) - - if ("r" %in% names(x)) { - method <- "Pearson correlation" - } else if ("rho" %in% names(x)) { - method <- "Spearman correlation" - x$r <- x$rho - } else if ("tau" %in% names(x)) { - method <- "Kendall correlation" - x$r <- x$tau - } else { - stop("Correlation method is not Pearson, Spearman, or Kendall.") - } - - y <- list(statistic = x$t, - parameter = x$df_error, - p.value = x$p, - estimate = x$r, - data.name = paste0(x$Parameter1, " and ", x$Parameter2), - method = method, - conf.int = c(x$CI_low, x$CI_high)) - class(y) <- "htest" - format_corr(y, - digits = digits, - pdigits = pdigits, - pzero = pzero, - full = full, - italics = italics, - type = type) -} - -#' Format Bayes factors -#' -#' This method formats Bayes factors from the -#' \{[BayesFactor](https://cran.r-project.org/package=BayesFactor)\} package. -#' By default, this function rounds Bayes factors greater than 1 to one decimal -#' place and Bayes factors less than 1 to two decimal places. Values greater -#' than 1000 or less than 1/1000 are formatted using scientific notation. -#' Cutoffs can be set that format the values as greater than or less than the -#' cutoffs (e.g., BF > 1000 or BF < 0.001). Numbers of digits, cutoffs, -#' italics, and label subscripts are all customizable. -#' -#' @param x BayesFactor object or vector of numeric Bayes factor values -#' @param digits1 Number of digits after the decimal for Bayes factors > 1 -#' @param digits2 Number of digits after the decimal for Bayes factors < 1 -#' @param cutoff Cutoff for using `_BF_~10~ > ` or -#' `_BF_~10~ < 1 / ` (value must be > 1) -#' @param label Character string for label before Bayes factor. Default is BF. -#' Set `label = ""` to return just the formatted Bayes factor value with no -#' label or operator (`=`, `<`, `>`) -#' @param italics Logical value (default = TRUE) for whether label should be -#' italicized (_BF_ or BF) -#' @param subscript Subscript to include with _BF_ label (`"10"`, `"01"`, or -#' `""` for no subscript) -#' @param type Type of formatting (`"md"` = markdown, `"latex"` = LaTeX) -#' @param ... Additional arguments passed to methods. -#' -#' -#' @return -#' A character string of statistical information formatted in Markdown or LaTeX. -#' -#' @method format_stats BFBayesFactor -#' @family functions for printing statistical objects -#' @export -#' -#' @examples -#' # Prepare statistical object -#' test_bf <- BayesFactor::ttestBF(mtcars$vs, mtcars$am) -#' -#' # Format Bayes factor -#' format_stats(test_bf) -#' -#' # Control cutoff for output -#' format_stats(test_bf, cutoff = 3) -#' -#' # Change digits, remove italics and subscript -#' format_stats(test_bf, digits2 = 1, italics = FALSE, subscript = "") -#' -#' # Return only Bayes factor value (no label) -#' format_stats(test_bf, label = "") -#' -#' # Format for LaTeX -#' format_stats(test_bf, type = "latex") -format_stats.BFBayesFactor <- function(x, - digits1 = 1, - digits2 = 2, - cutoff = NULL, - label = "BF", - italics = TRUE, - subscript = "10", - type = "md", - ...) { - - format_bf(x, - digits1 = digits1, - digits2 = digits2, - cutoff = cutoff, - label = label, - italics = italics, - subscript = subscript, - type = type) -} diff --git a/R/format_stats_BFBayesFactor.R b/R/format_stats_BFBayesFactor.R new file mode 100644 index 0000000..0a16212 --- /dev/null +++ b/R/format_stats_BFBayesFactor.R @@ -0,0 +1,72 @@ + +#' Format Bayes factors +#' +#' This method formats Bayes factors from the +#' \{[BayesFactor](https://cran.r-project.org/package=BayesFactor)\} package. +#' By default, this function rounds Bayes factors greater than 1 to one decimal +#' place and Bayes factors less than 1 to two decimal places. Values greater +#' than 1000 or less than 1/1000 are formatted using scientific notation. +#' Cutoffs can be set that format the values as greater than or less than the +#' cutoffs (e.g., BF > 1000 or BF < 0.001). Numbers of digits, cutoffs, +#' italics, and label subscripts are all customizable. +#' +#' @param x BayesFactor object or vector of numeric Bayes factor values +#' @param digits1 Number of digits after the decimal for Bayes factors > 1 +#' @param digits2 Number of digits after the decimal for Bayes factors < 1 +#' @param cutoff Cutoff for using `_BF_~10~ > ` or +#' `_BF_~10~ < 1 / ` (value must be > 1) +#' @param label Character string for label before Bayes factor. Default is BF. +#' Set `label = ""` to return just the formatted Bayes factor value with no +#' label or operator (`=`, `<`, `>`) +#' @param italics Logical value (default = TRUE) for whether label should be +#' italicized (_BF_ or BF) +#' @param subscript Subscript to include with _BF_ label (`"10"`, `"01"`, or +#' `""` for no subscript) +#' @param type Type of formatting (`"md"` = markdown, `"latex"` = LaTeX) +#' @param ... Additional arguments passed to methods. +#' +#' +#' @return +#' A character string of statistical information formatted in Markdown or LaTeX. +#' +#' @method format_stats BFBayesFactor +#' @family functions for printing statistical objects +#' @export +#' +#' @examples +#' # Prepare statistical object +#' test_bf <- BayesFactor::ttestBF(mtcars$vs, mtcars$am) +#' +#' # Format Bayes factor +#' format_stats(test_bf) +#' +#' # Control cutoff for output +#' format_stats(test_bf, cutoff = 3) +#' +#' # Change digits, remove italics and subscript +#' format_stats(test_bf, digits2 = 1, italics = FALSE, subscript = "") +#' +#' # Return only Bayes factor value (no label) +#' format_stats(test_bf, label = "") +#' +#' # Format for LaTeX +#' format_stats(test_bf, type = "latex") +format_stats.BFBayesFactor <- function(x, + digits1 = 1, + digits2 = 2, + cutoff = NULL, + label = "BF", + italics = TRUE, + subscript = "10", + type = "md", + ...) { + + format_bf(x, + digits1 = digits1, + digits2 = digits2, + cutoff = cutoff, + label = label, + italics = italics, + subscript = subscript, + type = type) +} diff --git a/R/format_stats_aov.R b/R/format_stats_aov.R new file mode 100644 index 0000000..3d3d5c6 --- /dev/null +++ b/R/format_stats_aov.R @@ -0,0 +1,105 @@ + +#' Format ANOVA statistics +#' +#' @description +#' This method formats analysis of variance (ANOVA) statistics from the class +#' `aov`. The default output is APA formatted, but this function allows control +#' over numbers of digits, leading zeros, italics, degrees of freedom, +#' and output format of Markdown or LaTeX. +#' +#' @param x An `aov` object +#' @param term Character string for row name of term to extract statistics for. +#' This must be the exact string returned in the `summary()` output from the +#' `aov` object +#' @param digits Number of digits after the decimal for means, confidence +#' intervals, and test statistics +#' @param pdigits Number of digits after the decimal for p-values, ranging +#' between 1-5 (also controls cutoff for small p-values) +#' @param pzero Logical value (default = FALSE) for whether to include +#' leading zero for p-values +#' @param italics Logical value (default = TRUE) for whether _p_ label should be +#' italicized +#' @param dfs Formatting for degrees of freedom ("par" = parenthetical, +#' "sub" = subscript, "none" = do not print degrees of freedom) +#' @param type Type of formatting ("md" = markdown, "latex" = LaTeX) +#' @param ... Additional arguments passed to methods. +#' +#' @return +#' A character string of statistical information formatted in Markdown or LaTeX. +#' +#' @method format_stats aov +#' @family functions for printing statistical objects +#' @export +#' +#' @examples +#' test_aov <- aov(mpg ~ cyl * hp, data = mtcars) +#' +#' # Format ANOVA +#' format_stats(test_aov, term = "cyl") +#' +#' # Remove italics and make degrees of freedom subscripts +#' format_stats(test_aov, term = "cyl", italics = FALSE, dfs = "sub") +#' +#' # Change digits and add leading zero to p-value +#' format_stats(test_aov, term = "hp", digits = 3, pdigits = 4, pzero = TRUE) +#' +#' # Format for LaTeX +#' format_stats(test_aov, term = "hp", type = "latex") +format_stats.aov <- function(x, + term, + digits = 1, + pdigits = 3, + pzero = FALSE, + italics = TRUE, + dfs = "par", + type = "md", + ...) { + # Validate arguments + check_character(term) + check_number_whole(digits, min = 0, allow_null = TRUE) + check_number_whole(pdigits, min = 1, max = 5) + check_bool(pzero) + check_bool(italics) + check_match(dfs, c("par", "sub", "none")) + check_string(type) + check_match(type, c("md", "latex")) + + terms <- attr(x$terms, "term.labels") + stopifnot("Argument `term` not found in model terms." = term %in% terms) + term_num <- which(terms == term) + + summ <- summary(x) + + f_stat <- summ[[1]][["F value"]][term_num] + df1 <- summ[[1]][["Df"]][term_num] + df2 <- x$df.residual + p_value <- summ[[1]][["Pr(>F)"]][term_num] + + stat_value <- format_num(f_stat, digits = digits, pzero = TRUE) + pvalue <- format_p(p_value, + digits = pdigits, pzero = pzero, + italics = italics, type = type + ) + + # Build label + statlab <- "F" + stat_label <- dplyr::case_when( + !italics ~ paste0(statlab), + identical(type, "md") ~ paste0("_", statlab, "_"), + identical(type, "latex") ~ paste0("$", statlab, "$") + ) + stat_label <- dplyr::case_when(identical(dfs, "par") ~ paste0(stat_label, "(", df1, ", ", df2, ")"), + identical(dfs, "sub") & identical(type, "md") ~ paste0(stat_label, "~", df1, ",", df2, "~"), + identical(dfs, "sub") & identical(type, "latex") ~ paste0(stat_label, "$_{", df1, ",", df2, "}$"), + .default = stat_label + )[1] + + # Create statistics string + build_string(mean_label = NULL, + mean_value = NULL, + cis = FALSE, + stat_label = stat_label, + stat_value = stat_value, + pvalue = pvalue, + full = FALSE) +} diff --git a/R/format_stats_easycorrelation.R b/R/format_stats_easycorrelation.R new file mode 100644 index 0000000..e8b2b03 --- /dev/null +++ b/R/format_stats_easycorrelation.R @@ -0,0 +1,83 @@ + +#' Format correlation statistics +#' +#' @description +#' This functions formats correlation statistics generated from the +#' \{[correlation](https://cran.r-project.org/package=correlation)\} package. +#' This detects whether the object is from a Pearson, Spearman, or Kendall +#' correlation and reports the appropriate correlation label +#' (r, \eqn{\tau}, \eqn{\rho}). The default output is APA formatted, but +#' numbers of digits, leading zeros, the presence of confidence intervals, +#' and italics are all customizable. + +#' @inheritParams format_stats.htest +#' +#' @return +#' A character string of statistical information formatted in Markdown or LaTeX. +#' +#' @method format_stats easycorrelation +#' @family functions for printing statistical objects + +#' @export +#' +#' @examples +#' # Prepare statistical objects +#' test_corr <- correlation::correlation(mtcars, select = "mpg", select2 = "disp") +#' test_corr2 <- correlation::correlation(mtcars, select = "mpg", select2 = "disp", method = "kendall") +#' +#' # Format correlation +#' format_stats(test_corr) +#' +#' # Remove confidence intervals and italics +#' format_stats(test_corr, full = FALSE, italics = FALSE) +#' +#' # Change digits and add leading zero to p-value +#' format_stats(test_corr, digits = 3, pdigits = 4, pzero = TRUE) +#' +#' # Format Kendall's tau for LaTeX +#' format_stats(test_corr2, type = "latex") +format_stats.easycorrelation <- function(x, + digits = 2, + pdigits = 3, + pzero = FALSE, + full = TRUE, + italics = TRUE, + type = "md", + ...) { + # Validate arguments + check_number_whole(digits, min = 0, allow_null = TRUE) + check_number_whole(pdigits, min = 1, max = 5) + check_bool(pzero) + check_bool(full) + check_bool(italics) + check_string(type) + check_match(type, c("md", "latex")) + + if ("r" %in% names(x)) { + method <- "Pearson correlation" + } else if ("rho" %in% names(x)) { + method <- "Spearman correlation" + x$r <- x$rho + } else if ("tau" %in% names(x)) { + method <- "Kendall correlation" + x$r <- x$tau + } else { + stop("Correlation method is not Pearson, Spearman, or Kendall.") + } + + y <- list(statistic = x$t, + parameter = x$df_error, + p.value = x$p, + estimate = x$r, + data.name = paste0(x$Parameter1, " and ", x$Parameter2), + method = method, + conf.int = c(x$CI_low, x$CI_high)) + class(y) <- "htest" + format_corr(y, + digits = digits, + pdigits = pdigits, + pzero = pzero, + full = full, + italics = italics, + type = type) +} diff --git a/R/format_stats_htest.R b/R/format_stats_htest.R new file mode 100644 index 0000000..c6f45be --- /dev/null +++ b/R/format_stats_htest.R @@ -0,0 +1,128 @@ + +#' Format hypothesis test statistics +#' +#' This method formats hypothesis test statistics from the class `htest`. +#' Currently, this includes correlations from [cor.test()] and t-tests and +#' Wilcoxon tests from [t.test()] and [wilcox.test()]. For correlations, the +#' function detects whether the object is from a Pearson, +#' Spearman, or Kendall correlation and reports the appropriate correlation +#' label (r, \eqn{\tau}, \eqn{\rho}). The default output is APA formatted, but +#' this function allows control over numbers of +#' digits, leading zeros, the presence of means and confidence intervals, +#' italics, degrees of freedom, and mean labels, and output format of +#' Markdown or LaTeX. +#' +#' @param x An `htest` object +#' @param digits Number of digits after the decimal for means, confidence +#' intervals, and test statistics +#' @param pdigits Number of digits after the decimal for p-values, ranging +#' between 1-5 (also controls cutoff for small p-values) +#' @param pzero Logical value (default = FALSE) for whether to include +#' leading zero for p-values +#' @param full Logical value (default = TRUE) for whether to include means +#' and confidence intervals or just test statistic and p-value +#' @param italics Logical value (default = TRUE) for whether _p_ label should be +#' italicized +#' @param dfs Formatting for degrees of freedom ("par" = parenthetical, +#' "sub" = subscript, "none" = do not print degrees of freedom) +#' @param mean Formatting for mean label ("abbr" = M, "word" = Mean) +#' @param type Type of formatting ("md" = markdown, "latex" = LaTeX) +#' @param ... Additional arguments passed to methods. +#' +#' @return +#' A character string of statistical information formatted in Markdown or LaTeX. +#' +#' @method format_stats htest +#' @family functions for printing statistical objects +#' @export +#' +#' @examples +#' # Prepare statistical objects +#' test_corr <- cor.test(mtcars$mpg, mtcars$cyl) +#' test_corr2 <- cor.test(mtcars$mpg, mtcars$cyl, method = "kendall") +#' test_ttest <- t.test(mtcars$vs, mtcars$am) +#' test_ttest2 <- wilcox.test(mtcars$vs, mtcars$am) +#' +#' # Format correlation +#' format_stats(test_corr) +#' +#' # Remove confidence intervals and italics +#' format_stats(test_corr, full = FALSE, italics = FALSE) +#' +#' # Change digits and add leading zero to p-value +#' format_stats(test_corr, digits = 3, pdigits = 4, pzero = TRUE) +#' +#' # Format Kendall's tau +#' format_stats(test_corr2) +#' +#' # Format t-test +#' format_stats(test_ttest) +#' +#' # Remove mean and confidence interval +#' format_stats(test_ttest, full = FALSE) +#' +#' # Remove degrees of freedom and spell out "Mean" +#' format_stats(test_ttest, dfs = "none", mean = "word") +#' +#' # Format for LaTeX +#' format_stats(test_ttest2, type = "latex") +format_stats.htest <- function(x, + digits = NULL, + pdigits = 3, + pzero = FALSE, + full = TRUE, + italics = TRUE, + dfs = "par", + mean = "abbr", + type = "md", + ...) { + # Validate arguments + check_number_whole(digits, min = 0, allow_null = TRUE) + check_number_whole(pdigits, min = 1, max = 5) + check_bool(pzero) + check_bool(full) + check_bool(italics) + check_match(dfs, c("par", "sub", "none")) + check_match(mean, c("abbr", "word")) + check_string(type) + check_match(type, c("md", "latex")) + + if (grepl("correlation", x$method)) { + if (is.null(digits)) { + digits <- 2 + } else { + digits <- digits + } + format_corr(x, + digits = digits, + pdigits = pdigits, + pzero = pzero, + full = full, + italics = italics, + type = type) + } else if (grepl("t-test", x$method) | grepl("Wilcoxon", x$method)) { + if (is.null(digits)) { + digits <- 1 + } else { + digits <- digits + } + format_ttest(x, + digits = digits, + pdigits = pdigits, + pzero = pzero, + full = full, + italics = italics, + dfs = dfs, + mean = mean, + type = type) + } else { + stop( + "Objects of method '" + , x$method + , "' are currently not supported." + , "\nVisit https://github.com/JeffreyRStevens/cocoon/issues to request support for this method." + , call. = FALSE + ) + } +} + diff --git a/R/format_statvalues.R b/R/format_statvalues.R index 577e8c5..4b7400c 100644 --- a/R/format_statvalues.R +++ b/R/format_statvalues.R @@ -33,15 +33,13 @@ format_corr <- function(x, # Validate arguments stopifnot("Input must be a correlation object." = inherits(x, what = "htest") && grepl("correlation", x$method)) - stopifnot("Argument `digits` must be a non-negative numeric vector." = is.numeric(digits)) - stopifnot("Argument `digits` must be a non-negative numeric vector." = digits >= 0) - stopifnot("Argument `pdigits` must be a numeric between 1 and 5." = is.numeric(pdigits)) - stopifnot("Argument `pdigits` must be a numeric between 1 and 5." = pdigits > 0) - stopifnot("Argument `pdigits` must be a numeric between 1 and 5." = pdigits < 6) - stopifnot("Argument `pzero` must be TRUE or FALSE." = is.logical(pzero)) - stopifnot("Argument `full` must be TRUE or FALSE." = is.logical(full)) - stopifnot("Argument `italics` must be TRUE or FALSE." = is.logical(italics)) - stopifnot("Argument `type` must be 'md' or 'latex'." = type %in% c("md", "latex")) + check_number_whole(digits, min = 0, allow_null = TRUE) + check_number_whole(pdigits, min = 1, max = 5) + check_bool(pzero) + check_bool(full) + check_bool(italics) + check_string(type) + check_match(type, c("md", "latex")) # Format numbers corr_method <- dplyr::case_when( @@ -246,14 +244,13 @@ format_bf <- function(x, } # Validate arguments - stopifnot("Argument `digits1` must be a non-negative numeric vector." = is.numeric(digits1)) - stopifnot("Argument `digits1` must be a non-negative numeric vector." = digits1 >= 0) - stopifnot("Argument `digits2` must be a non-negative numeric vector." = is.numeric(digits2)) - stopifnot("Argument `digits2` must be a non-negative numeric vector." = digits2 >= 0) - stopifnot("Argument `cutoff` must be a numeric vector greater than 1 or NULL." = (is.numeric(cutoff) & cutoff > 1) | is.null(cutoff)) - stopifnot("Argument `italics` must be TRUE or FALSE." = is.logical(italics)) - stopifnot("Argument `subscript` must be a character string (usually '10', '01', or '')." = is.character(subscript)) - stopifnot("Argument `type` must be 'md' or 'latex'." = type %in% c("md", "latex")) + check_number_whole(digits1, min = 0, allow_null = TRUE) + check_number_whole(digits2, min = 0, allow_null = TRUE) + check_number_decimal(cutoff, min = 1, allow_null = TRUE) + check_bool(italics) + check_string(subscript) + check_string(type) + check_match(type, c("md", "latex")) # Build label if (label != "") { @@ -350,13 +347,12 @@ format_p <- function(x, italics = TRUE, type = "md") { # Check arguments - stopifnot("Input must be a numeric vector." = is.numeric(x)) - stopifnot("Argument `digits` must be a numeric between 1 and 5." = is.numeric(digits)) - stopifnot("Argument `digits` must be a numeric between 1 and 5." = digits > 0) - stopifnot("Argument `digits` must be a numeric between 1 and 5." = digits < 6) - stopifnot("Argument `pzero` must be TRUE or FALSE." = is.logical(pzero)) - stopifnot("Argument `italics` must be TRUE or FALSE." = is.logical(italics)) - stopifnot("Argument `type` must be 'md' or 'latex'." = type %in% c("md", "latex")) + check_numeric(x) + check_number_whole(digits, min = 1, max = 5, allow_null = TRUE) + check_bool(pzero) + check_bool(italics) + check_string(type) + check_match(type, c("md", "latex")) # Build label if (label != "") { diff --git a/R/format_summary.R b/R/format_summary.R index a5fc713..1bd45f4 100644 --- a/R/format_summary.R +++ b/R/format_summary.R @@ -78,15 +78,15 @@ format_summary <- function(x = NULL, type = "md") { # Check arguments if (!is.null(x)) { - stopifnot("Argument `x` must be a numeric vector." = is.numeric(x)) - stopifnot('Specify `tendency` as "mean" or "median".' = tendency %in% c("mean", "median")) - stopifnot('Specify `error` as "ci", "sd", "se", or "iqr".' = error %in% c("ci", "sd", "se", "iqr")) + check_numeric(x) + check_match(tendency, c("mean", "median")) + check_match(error, c("ci", "sd", "se", "iqr")) xtendency <- dplyr::case_when( identical(tendency, "mean") ~ mean(x, na.rm = TRUE), identical(tendency, "median") ~ median(x, na.rm = TRUE) ) xn <- sum(!is.na(x)) - stopifnot("Less than two non-missing values in vector, so no confidence interval can be computed." = xn > 1) + stopifnot("Less than two values in vector, so no confidence interval can be computed." = xn > 1) xlimit <- 1 - (1 - cilevel) / 2 xsd <- stats::sd(x, na.rm = TRUE) xse <- xsd / sqrt(xn) @@ -106,7 +106,7 @@ format_summary <- function(x = NULL, ) xinterval <- xtendency - xlower } else if (!is.null(values)) { - stopifnot("Argument `values` must be a numeric vector." = is.numeric(values)) + check_numeric(values) stopifnot("Argument `values` must be a vector with two or three elements." = length(values) %in% c(2, 3)) if (length(values) == 2) { xtendency <- values[1] @@ -123,12 +123,11 @@ format_summary <- function(x = NULL, } else { stop("You must include either the `x` or `values` argument.") } - stopifnot('Specify `tendlabel` as "abbr", "word", or "none".' = tendlabel %in% c("abbr", "word", "none")) - stopifnot("The `units` argument must be a character vector or NULL" = is.character(units) | is.null(units)) - stopifnot('Specify `display` as "limits", "pm", "par", or "none".' = display %in% c("limits", "pm", "par", "none")) + check_match(tendlabel, c("abbr", "word", "none")) + check_character(units, allow_null = TRUE) + check_match(display, c("limits", "pm", "par", "none")) # Build mean - # subname <- ifelse(!is.null(subscript), subscript, "") unit <- dplyr::case_when( !is.null(units) ~ paste0(" ", units), .default = "" diff --git a/R/import-standalone-obj-type.R b/R/import-standalone-obj-type.R new file mode 100644 index 0000000..31b5db9 --- /dev/null +++ b/R/import-standalone-obj-type.R @@ -0,0 +1,366 @@ +# Standalone file: do not edit by hand +# Source: https://github.com/r-lib/rlang/blob/HEAD/R/standalone-obj-type.R +# Generated by: usethis::use_standalone("r-lib/rlang", "obj-type") +# ---------------------------------------------------------------------- +# +# --- +# repo: r-lib/rlang +# file: standalone-obj-type.R +# last-updated: 2024-02-14 +# license: https://unlicense.org +# imports: rlang (>= 1.1.0) +# --- +# +# ## Changelog +# +# 2024-02-14: +# - `obj_type_friendly()` now works for S7 objects. +# +# 2023-05-01: +# - `obj_type_friendly()` now only displays the first class of S3 objects. +# +# 2023-03-30: +# - `stop_input_type()` now handles `I()` input literally in `arg`. +# +# 2022-10-04: +# - `obj_type_friendly(value = TRUE)` now shows numeric scalars +# literally. +# - `stop_friendly_type()` now takes `show_value`, passed to +# `obj_type_friendly()` as the `value` argument. +# +# 2022-10-03: +# - Added `allow_na` and `allow_null` arguments. +# - `NULL` is now backticked. +# - Better friendly type for infinities and `NaN`. +# +# 2022-09-16: +# - Unprefixed usage of rlang functions with `rlang::` to +# avoid onLoad issues when called from rlang (#1482). +# +# 2022-08-11: +# - Prefixed usage of rlang functions with `rlang::`. +# +# 2022-06-22: +# - `friendly_type_of()` is now `obj_type_friendly()`. +# - Added `obj_type_oo()`. +# +# 2021-12-20: +# - Added support for scalar values and empty vectors. +# - Added `stop_input_type()` +# +# 2021-06-30: +# - Added support for missing arguments. +# +# 2021-04-19: +# - Added support for matrices and arrays (#141). +# - Added documentation. +# - Added changelog. +# +# nocov start + +library(rlang) + +#' Return English-friendly type +#' @param x Any R object. +#' @param value Whether to describe the value of `x`. Special values +#' like `NA` or `""` are always described. +#' @param length Whether to mention the length of vectors and lists. +#' @return A string describing the type. Starts with an indefinite +#' article, e.g. "an integer vector". +#' @noRd +obj_type_friendly <- function(x, value = TRUE) { + if (rlang::is_missing(x)) { + return("absent") + } + + if (is.object(x)) { + if (inherits(x, "quosure")) { + type <- "quosure" + } else { + type <- class(x)[[1L]] + } + return(sprintf("a <%s> object", type)) + } + + if (!rlang::is_vector(x)) { + return(.rlang_as_friendly_type(typeof(x))) + } + + n_dim <- length(dim(x)) + + if (!n_dim) { + if (!rlang::is_list(x) && length(x) == 1) { + if (rlang::is_na(x)) { + return(switch( + typeof(x), + logical = "`NA`", + integer = "an integer `NA`", + double = + if (is.nan(x)) { + "`NaN`" + } else { + "a numeric `NA`" + }, + complex = "a complex `NA`", + character = "a character `NA`", + .rlang_stop_unexpected_typeof(x) + )) + } + + show_infinites <- function(x) { + if (x > 0) { + "`Inf`" + } else { + "`-Inf`" + } + } + str_encode <- function(x, width = 30, ...) { + if (nchar(x) > width) { + x <- substr(x, 1, width - 3) + x <- paste0(x, "...") + } + encodeString(x, ...) + } + + if (value) { + if (is.numeric(x) && is.infinite(x)) { + return(show_infinites(x)) + } + + if (is.numeric(x) || is.complex(x)) { + number <- as.character(round(x, 2)) + what <- if (is.complex(x)) "the complex number" else "the number" + return(paste(what, number)) + } + + return(switch( + typeof(x), + logical = if (x) "`TRUE`" else "`FALSE`", + character = { + what <- if (nzchar(x)) "the string" else "the empty string" + paste(what, str_encode(x, quote = "\"")) + }, + raw = paste("the raw value", as.character(x)), + .rlang_stop_unexpected_typeof(x) + )) + } + + return(switch( + typeof(x), + logical = "a logical value", + integer = "an integer", + double = if (is.infinite(x)) show_infinites(x) else "a number", + complex = "a complex number", + character = if (nzchar(x)) "a string" else "\"\"", + raw = "a raw value", + .rlang_stop_unexpected_typeof(x) + )) + } + + if (length(x) == 0) { + return(switch( + typeof(x), + logical = "an empty logical vector", + integer = "an empty integer vector", + double = "an empty numeric vector", + complex = "an empty complex vector", + character = "an empty character vector", + raw = "an empty raw vector", + list = "an empty list", + .rlang_stop_unexpected_typeof(x) + )) + } + } + + vec_type_friendly(x) +} + +vec_type_friendly <- function(x, length = FALSE) { + if (!rlang::is_vector(x)) { + rlang::abort("`x` must be a vector.") + } + type <- typeof(x) + n_dim <- length(dim(x)) + + add_length <- function(type) { + if (length && !n_dim) { + paste0(type, sprintf(" of length %s", length(x))) + } else { + type + } + } + + if (type == "list") { + if (n_dim < 2) { + return(add_length("a list")) + } else if (is.data.frame(x)) { + return("a data frame") + } else if (n_dim == 2) { + return("a list matrix") + } else { + return("a list array") + } + } + + type <- switch( + type, + logical = "a logical %s", + integer = "an integer %s", + numeric = , + double = "a double %s", + complex = "a complex %s", + character = "a character %s", + raw = "a raw %s", + type = paste0("a ", type, " %s") + ) + + if (n_dim < 2) { + kind <- "vector" + } else if (n_dim == 2) { + kind <- "matrix" + } else { + kind <- "array" + } + out <- sprintf(type, kind) + + if (n_dim >= 2) { + out + } else { + add_length(out) + } +} + +.rlang_as_friendly_type <- function(type) { + switch( + type, + + list = "a list", + + NULL = "`NULL`", + environment = "an environment", + externalptr = "a pointer", + weakref = "a weak reference", + S4 = "an S4 object", + + name = , + symbol = "a symbol", + language = "a call", + pairlist = "a pairlist node", + expression = "an expression vector", + + char = "an internal string", + promise = "an internal promise", + ... = "an internal dots object", + any = "an internal `any` object", + bytecode = "an internal bytecode object", + + primitive = , + builtin = , + special = "a primitive function", + closure = "a function", + + type + ) +} + +.rlang_stop_unexpected_typeof <- function(x, call = rlang::caller_env()) { + rlang::abort( + sprintf("Unexpected type <%s>.", typeof(x)), + call = call + ) +} + +#' Return OO type +#' @param x Any R object. +#' @return One of `"bare"` (for non-OO objects), `"S3"`, `"S4"`, +#' `"R6"`, or `"S7"`. +#' @noRd +obj_type_oo <- function(x) { + if (!is.object(x)) { + return("bare") + } + + class <- inherits(x, c("R6", "S7_object"), which = TRUE) + + if (class[[1]]) { + "R6" + } else if (class[[2]]) { + "S7" + } else if (isS4(x)) { + "S4" + } else { + "S3" + } +} + +#' @param x The object type which does not conform to `what`. Its +#' `obj_type_friendly()` is taken and mentioned in the error message. +#' @param what The friendly expected type as a string. Can be a +#' character vector of expected types, in which case the error +#' message mentions all of them in an "or" enumeration. +#' @param show_value Passed to `value` argument of `obj_type_friendly()`. +#' @param ... Arguments passed to [abort()]. +#' @inheritParams args_error_context +#' @noRd +stop_input_type <- function(x, + what, + ..., + allow_na = FALSE, + allow_null = FALSE, + show_value = TRUE, + arg = rlang::caller_arg(x), + call = rlang::caller_env()) { + # From standalone-cli.R + cli <- rlang::env_get_list( + nms = c("format_arg", "format_code"), + last = topenv(), + default = function(x) sprintf("`%s`", x), + inherit = TRUE + ) + + if (allow_na) { + what <- c(what, cli$format_code("NA")) + } + if (allow_null) { + what <- c(what, cli$format_code("NULL")) + } + if (length(what)) { + what <- oxford_comma(what) + } + if (inherits(arg, "AsIs")) { + format_arg <- identity + } else { + format_arg <- cli$format_arg + } + + message <- sprintf( + "%s must be %s, not %s.", + format_arg(arg), + what, + obj_type_friendly(x, value = show_value) + ) + + rlang::abort(message, ..., call = call, arg = arg) +} + +oxford_comma <- function(chr, sep = ", ", final = "or") { + n <- length(chr) + + if (n < 2) { + return(chr) + } + + head <- chr[seq_len(n - 1)] + last <- chr[n] + + head <- paste(head, collapse = sep) + + # Write a or b. But a, b, or c. + if (n > 2) { + paste0(head, sep, final, " ", last) + } else { + paste0(head, " ", final, " ", last) + } +} + +# nocov end diff --git a/R/import-standalone-types-check.R b/R/import-standalone-types-check.R new file mode 100644 index 0000000..a019510 --- /dev/null +++ b/R/import-standalone-types-check.R @@ -0,0 +1,619 @@ +# Standalone file: do not edit by hand +# Source: https://github.com/r-lib/rlang/blob/HEAD/R/standalone-types-check.R +# Generated by: usethis::use_standalone("r-lib/rlang", "types-check") +# ---------------------------------------------------------------------- +# +# --- +# repo: r-lib/rlang +# file: standalone-types-check.R +# last-updated: 2023-03-13 +# license: https://unlicense.org +# dependencies: standalone-obj-type.R +# imports: rlang (>= 1.1.0) +# --- +# +# ## Changelog +# +# 2024-08-15: +# - `check_character()` gains an `allow_na` argument (@martaalcalde, #1724) +# +# 2023-03-13: +# - Improved error messages of number checkers (@teunbrand) +# - Added `allow_infinite` argument to `check_number_whole()` (@mgirlich). +# - Added `check_data_frame()` (@mgirlich). +# +# 2023-03-07: +# - Added dependency on rlang (>= 1.1.0). +# +# 2023-02-15: +# - Added `check_logical()`. +# +# - `check_bool()`, `check_number_whole()`, and +# `check_number_decimal()` are now implemented in C. +# +# - For efficiency, `check_number_whole()` and +# `check_number_decimal()` now take a `NULL` default for `min` and +# `max`. This makes it possible to bypass unnecessary type-checking +# and comparisons in the default case of no bounds checks. +# +# 2022-10-07: +# - `check_number_whole()` and `_decimal()` no longer treat +# non-numeric types such as factors or dates as numbers. Numeric +# types are detected with `is.numeric()`. +# +# 2022-10-04: +# - Added `check_name()` that forbids the empty string. +# `check_string()` allows the empty string by default. +# +# 2022-09-28: +# - Removed `what` arguments. +# - Added `allow_na` and `allow_null` arguments. +# - Added `allow_decimal` and `allow_infinite` arguments. +# - Improved errors with absent arguments. +# +# +# 2022-09-16: +# - Unprefixed usage of rlang functions with `rlang::` to +# avoid onLoad issues when called from rlang (#1482). +# +# 2022-08-11: +# - Added changelog. +# +# nocov start + +# Scalars ----------------------------------------------------------------- + +.standalone_types_check_dot_call <- .Call + +check_bool <- function(x, + ..., + allow_na = FALSE, + allow_null = FALSE, + arg = rlang::caller_arg(x), + call = rlang::caller_env()) { + if (!missing(x) && .standalone_types_check_dot_call(ffi_standalone_is_bool_1.0.7, x, allow_na, allow_null)) { + return(invisible(NULL)) + } + + stop_input_type( + x, + c("`TRUE`", "`FALSE`"), + ..., + allow_na = allow_na, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_string <- function(x, + ..., + allow_empty = TRUE, + allow_na = FALSE, + allow_null = FALSE, + arg = rlang::caller_arg(x), + call = rlang::caller_env()) { + if (!missing(x)) { + is_string <- .rlang_check_is_string( + x, + allow_empty = allow_empty, + allow_na = allow_na, + allow_null = allow_null + ) + if (is_string) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "a single string", + ..., + allow_na = allow_na, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +.rlang_check_is_string <- function(x, + allow_empty, + allow_na, + allow_null) { + if (rlang::is_string(x)) { + if (allow_empty || !rlang::is_string(x, "")) { + return(TRUE) + } + } + + if (allow_null && rlang::is_null(x)) { + return(TRUE) + } + + if (allow_na && (identical(x, NA) || identical(x, rlang::na_chr))) { + return(TRUE) + } + + FALSE +} + +check_name <- function(x, + ..., + allow_null = FALSE, + arg = rlang::caller_arg(x), + call = rlang::caller_env()) { + if (!missing(x)) { + is_string <- .rlang_check_is_string( + x, + allow_empty = FALSE, + allow_na = FALSE, + allow_null = allow_null + ) + if (is_string) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "a valid name", + ..., + allow_na = FALSE, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +IS_NUMBER_true <- 0 +IS_NUMBER_false <- 1 +IS_NUMBER_oob <- 2 + +check_number_decimal <- function(x, + ..., + min = NULL, + max = NULL, + allow_infinite = TRUE, + allow_na = FALSE, + allow_null = FALSE, + arg = rlang::caller_arg(x), + call = rlang::caller_env()) { + if (missing(x)) { + exit_code <- IS_NUMBER_false + } else if (0 == (exit_code <- .standalone_types_check_dot_call( + ffi_standalone_check_number_1.0.7, + x, + allow_decimal = TRUE, + min, + max, + allow_infinite, + allow_na, + allow_null + ))) { + return(invisible(NULL)) + } + + .stop_not_number( + x, + ..., + exit_code = exit_code, + allow_decimal = TRUE, + min = min, + max = max, + allow_na = allow_na, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_number_whole <- function(x, + ..., + min = NULL, + max = NULL, + allow_infinite = FALSE, + allow_na = FALSE, + allow_null = FALSE, + arg = rlang::caller_arg(x), + call = rlang::caller_env()) { + if (missing(x)) { + exit_code <- IS_NUMBER_false + } else if (0 == (exit_code <- .standalone_types_check_dot_call( + ffi_standalone_check_number_1.0.7, + x, + allow_decimal = FALSE, + min, + max, + allow_infinite, + allow_na, + allow_null + ))) { + return(invisible(NULL)) + } + + .stop_not_number( + x, + ..., + exit_code = exit_code, + allow_decimal = FALSE, + min = min, + max = max, + allow_na = allow_na, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +.stop_not_number <- function(x, + ..., + exit_code, + allow_decimal, + min, + max, + allow_na, + allow_null, + arg, + call) { + if (allow_decimal) { + what <- "a number" + } else { + what <- "a whole number" + } + + if (exit_code == IS_NUMBER_oob) { + min <- min %||% -Inf + max <- max %||% Inf + + if (min > -Inf && max < Inf) { + what <- sprintf("%s between %s and %s", what, min, max) + } else if (x < min) { + what <- sprintf("%s larger than or equal to %s", what, min) + } else if (x > max) { + what <- sprintf("%s smaller than or equal to %s", what, max) + } else { + rlang::abort("Unexpected state in OOB check", .internal = TRUE) + } + } + + stop_input_type( + x, + what, + ..., + allow_na = allow_na, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_symbol <- function(x, + ..., + allow_null = FALSE, + arg = rlang::caller_arg(x), + call = rlang::caller_env()) { + if (!missing(x)) { + if (rlang::is_symbol(x)) { + return(invisible(NULL)) + } + if (allow_null && rlang::is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "a symbol", + ..., + allow_na = FALSE, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_arg <- function(x, + ..., + allow_null = FALSE, + arg = rlang::caller_arg(x), + call = rlang::caller_env()) { + if (!missing(x)) { + if (rlang::is_symbol(x)) { + return(invisible(NULL)) + } + if (allow_null && rlang::is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "an argument name", + ..., + allow_na = FALSE, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_call <- function(x, + ..., + allow_null = FALSE, + arg = rlang::caller_arg(x), + call = rlang::caller_env()) { + if (!missing(x)) { + if (rlang::is_call(x)) { + return(invisible(NULL)) + } + if (allow_null && rlang::is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "a defused call", + ..., + allow_na = FALSE, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_environment <- function(x, + ..., + allow_null = FALSE, + arg = rlang::caller_arg(x), + call = rlang::caller_env()) { + if (!missing(x)) { + if (rlang::is_environment(x)) { + return(invisible(NULL)) + } + if (allow_null && rlang::is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "an environment", + ..., + allow_na = FALSE, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_function <- function(x, + ..., + allow_null = FALSE, + arg = rlang::caller_arg(x), + call = rlang::caller_env()) { + if (!missing(x)) { + if (rlang::is_function(x)) { + return(invisible(NULL)) + } + if (allow_null && rlang::is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "a function", + ..., + allow_na = FALSE, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_closure <- function(x, + ..., + allow_null = FALSE, + arg = rlang::caller_arg(x), + call = rlang::caller_env()) { + if (!missing(x)) { + if (rlang::is_closure(x)) { + return(invisible(NULL)) + } + if (allow_null && rlang::is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "an R function", + ..., + allow_na = FALSE, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_formula <- function(x, + ..., + allow_null = FALSE, + arg = rlang::caller_arg(x), + call = rlang::caller_env()) { + if (!missing(x)) { + if (rlang::is_formula(x)) { + return(invisible(NULL)) + } + if (allow_null && rlang::is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "a formula", + ..., + allow_na = FALSE, + allow_null = allow_null, + arg = arg, + call = call + ) +} + + +check_match <- function(x, + vec, + ..., + allow_empty = TRUE, + allow_na = FALSE, + allow_null = FALSE, + arg = rlang::caller_arg(x), + call = rlang::caller_env()) { + if (!missing(x)) { + if (x %in% vec) { + return(invisible(NULL)) + } + } + if (is.character(vec)) { + vec <- paste0("\"", vec, "\"") + } + + stop_input_type( + x, + vec, + ..., + allow_na = allow_na, + allow_null = allow_null, + arg = arg, + call = call + ) +} + + +# Vectors ----------------------------------------------------------------- + +# TODO: Figure out what to do with logical `NA` and `allow_na = TRUE` + +check_numeric <- function(x, + ..., + allow_na = TRUE, + allow_null = FALSE, + arg = rlang::caller_arg(x), + call = rlang::caller_env()) { + + if (!missing(x)) { + if (is.numeric(x)) { + if (!allow_na && any(is.na(x))) { + rlang::abort( + sprintf("`%s` can't contain NA values.", arg), + arg = arg, + call = call + ) + } + + return(invisible(NULL)) + } + + if (allow_null && rlang::is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "a numeric vector", + ..., + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_character <- function(x, + ..., + allow_na = TRUE, + allow_null = FALSE, + arg = rlang::caller_arg(x), + call = rlang::caller_env()) { + + if (!missing(x)) { + if (rlang::is_character(x)) { + if (!allow_na && any(is.na(x))) { + rlang::abort( + sprintf("`%s` can't contain NA values.", arg), + arg = arg, + call = call + ) + } + + return(invisible(NULL)) + } + + if (allow_null && rlang::is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "a character vector", + ..., + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_logical <- function(x, + ..., + allow_null = FALSE, + arg = rlang::caller_arg(x), + call = rlang::caller_env()) { + if (!missing(x)) { + if (rlang::is_logical(x)) { + return(invisible(NULL)) + } + if (allow_null && rlang::is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "a logical vector", + ..., + allow_na = FALSE, + allow_null = allow_null, + arg = arg, + call = call + ) +} + +check_data_frame <- function(x, + ..., + allow_null = FALSE, + arg = rlang::caller_arg(x), + call = rlang::caller_env()) { + if (!missing(x)) { + if (is.data.frame(x)) { + return(invisible(NULL)) + } + if (allow_null && rlang::is_null(x)) { + return(invisible(NULL)) + } + } + + stop_input_type( + x, + "a data frame", + ..., + allow_null = allow_null, + arg = arg, + call = call + ) +} + +# nocov end + diff --git a/README.Rmd b/README.Rmd index 6e62149..5ba9664 100644 --- a/README.Rmd +++ b/README.Rmd @@ -100,6 +100,7 @@ Fuel efficiency and engine displacement were highly correlated - Student t-tests, Wilcoxon rank sum, and signed rank tests (output from `t.test()` and `wilcox.test()`, including one-sample, two-sample independent, and paired tests) + - ANOVAs from `aov()` - Bayes factors (output from [`{BayesFactor}`](https://cran.r-project.org/package=BayesFactor) package) * `format_summary()`: Means and error (calculates from vector or uses vector of mean and error interval or mean, lower error limit, and upper error limit) diff --git a/README.md b/README.md index 34f81bf..fa061a0 100644 --- a/README.md +++ b/README.md @@ -106,6 +106,7 @@ Fuel efficiency and engine displacement were highly correlated (r = - Student t-tests, Wilcoxon rank sum, and signed rank tests (output from `t.test()` and `wilcox.test()`, including one-sample, two-sample independent, and paired tests) + - ANOVAs from `aov()` - Bayes factors (output from [`{BayesFactor}`](https://cran.r-project.org/package=BayesFactor) package) diff --git a/_pkgdown.yml b/_pkgdown.yml index f9fa83b..f5b0049 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -2,7 +2,7 @@ url: https://jeffreyrstevens.github.io/cocoon/ template: bootstrap: 5 bootswatch: minty - theme: nord + theme: zenburn bslib: bg: "#212529" fg: "#f8f9fa" @@ -17,9 +17,10 @@ reference: - title: Format statistical objects contents: - format_stats - - format_stats.htest - - format_stats.easycorrelation + - format_stats.aov - format_stats.BFBayesFactor + - format_stats.easycorrelation + - format_stats.htest - title: Format statistical values contents: - format_summary diff --git a/man/format_bf.Rd b/man/format_bf.Rd index 76bd647..461fde7 100644 --- a/man/format_bf.Rd +++ b/man/format_bf.Rd @@ -92,6 +92,7 @@ Other functions for printing statistical objects: \code{\link{format_corr}()}, \code{\link{format_stats}()}, \code{\link{format_stats.BFBayesFactor}()}, +\code{\link{format_stats.aov}()}, \code{\link{format_stats.easycorrelation}()}, \code{\link{format_stats.htest}()}, \code{\link{format_ttest}()} diff --git a/man/format_corr.Rd b/man/format_corr.Rd index fec7ade..9980c7c 100644 --- a/man/format_corr.Rd +++ b/man/format_corr.Rd @@ -48,6 +48,7 @@ Other functions for printing statistical objects: \code{\link{format_bf}()}, \code{\link{format_stats}()}, \code{\link{format_stats.BFBayesFactor}()}, +\code{\link{format_stats.aov}()}, \code{\link{format_stats.easycorrelation}()}, \code{\link{format_stats.htest}()}, \code{\link{format_ttest}()} diff --git a/man/format_stats.BFBayesFactor.Rd b/man/format_stats.BFBayesFactor.Rd index 1080e5c..df3d7bb 100644 --- a/man/format_stats.BFBayesFactor.Rd +++ b/man/format_stats.BFBayesFactor.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/format_stats.R +% Please edit documentation in R/format_stats_BFBayesFactor.R \name{format_stats.BFBayesFactor} \alias{format_stats.BFBayesFactor} \title{Format Bayes factors} @@ -77,6 +77,7 @@ Other functions for printing statistical objects: \code{\link{format_bf}()}, \code{\link{format_corr}()}, \code{\link{format_stats}()}, +\code{\link{format_stats.aov}()}, \code{\link{format_stats.easycorrelation}()}, \code{\link{format_stats.htest}()}, \code{\link{format_ttest}()} diff --git a/man/format_stats.Rd b/man/format_stats.Rd index f11d09b..090270d 100644 --- a/man/format_stats.Rd +++ b/man/format_stats.Rd @@ -25,6 +25,7 @@ documents. Currently, the generic function works with the following objects: \item \code{htest} objects of correlations, t-tests, and Wilcoxon tests \item correlations from the \{\href{https://cran.r-project.org/package=correlation}{correlation}\} package. +\item \code{aov} objects for ANOVAs \item Bayes factors from the \{\href{https://cran.r-project.org/package=BayesFactor}{BayesFactor}\} package. The function invokes specific methods that depend on the class of the @@ -49,6 +50,7 @@ Other functions for printing statistical objects: \code{\link{format_bf}()}, \code{\link{format_corr}()}, \code{\link{format_stats.BFBayesFactor}()}, +\code{\link{format_stats.aov}()}, \code{\link{format_stats.easycorrelation}()}, \code{\link{format_stats.htest}()}, \code{\link{format_ttest}()} diff --git a/man/format_stats.aov.Rd b/man/format_stats.aov.Rd new file mode 100644 index 0000000..5380e86 --- /dev/null +++ b/man/format_stats.aov.Rd @@ -0,0 +1,79 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/format_stats_aov.R +\name{format_stats.aov} +\alias{format_stats.aov} +\title{Format ANOVA statistics} +\usage{ +\method{format_stats}{aov}( + x, + term, + digits = 1, + pdigits = 3, + pzero = FALSE, + italics = TRUE, + dfs = "par", + type = "md", + ... +) +} +\arguments{ +\item{x}{An \code{aov} object} + +\item{term}{Character string for row name of term to extract statistics for. +This must be the exact string returned in the \code{summary()} output from the +\code{aov} object} + +\item{digits}{Number of digits after the decimal for means, confidence +intervals, and test statistics} + +\item{pdigits}{Number of digits after the decimal for p-values, ranging +between 1-5 (also controls cutoff for small p-values)} + +\item{pzero}{Logical value (default = FALSE) for whether to include +leading zero for p-values} + +\item{italics}{Logical value (default = TRUE) for whether \emph{p} label should be +italicized} + +\item{dfs}{Formatting for degrees of freedom ("par" = parenthetical, +"sub" = subscript, "none" = do not print degrees of freedom)} + +\item{type}{Type of formatting ("md" = markdown, "latex" = LaTeX)} + +\item{...}{Additional arguments passed to methods.} +} +\value{ +A character string of statistical information formatted in Markdown or LaTeX. +} +\description{ +This method formats analysis of variance (ANOVA) statistics from the class +\code{aov}. The default output is APA formatted, but this function allows control +over numbers of digits, leading zeros, italics, degrees of freedom, +and output format of Markdown or LaTeX. +} +\examples{ +test_aov <- aov(mpg ~ cyl * hp, data = mtcars) + +# Format ANOVA +format_stats(test_aov, term = "cyl") + +# Remove italics and make degrees of freedom subscripts +format_stats(test_aov, term = "cyl", italics = FALSE, dfs = "sub") + +# Change digits and add leading zero to p-value +format_stats(test_aov, term = "hp", digits = 3, pdigits = 4, pzero = TRUE) + +# Format for LaTeX +format_stats(test_aov, term = "hp", type = "latex") +} +\seealso{ +Other functions for printing statistical objects: +\code{\link{format_bf}()}, +\code{\link{format_corr}()}, +\code{\link{format_stats}()}, +\code{\link{format_stats.BFBayesFactor}()}, +\code{\link{format_stats.easycorrelation}()}, +\code{\link{format_stats.htest}()}, +\code{\link{format_ttest}()} +} +\concept{functions for printing statistical objects} diff --git a/man/format_stats.easycorrelation.Rd b/man/format_stats.easycorrelation.Rd index dbb6259..46d3700 100644 --- a/man/format_stats.easycorrelation.Rd +++ b/man/format_stats.easycorrelation.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/format_stats.R +% Please edit documentation in R/format_stats_easycorrelation.R \name{format_stats.easycorrelation} \alias{format_stats.easycorrelation} \title{Format correlation statistics} @@ -72,6 +72,7 @@ Other functions for printing statistical objects: \code{\link{format_corr}()}, \code{\link{format_stats}()}, \code{\link{format_stats.BFBayesFactor}()}, +\code{\link{format_stats.aov}()}, \code{\link{format_stats.htest}()}, \code{\link{format_ttest}()} } diff --git a/man/format_stats.htest.Rd b/man/format_stats.htest.Rd index 77ba07a..3fab08c 100644 --- a/man/format_stats.htest.Rd +++ b/man/format_stats.htest.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/format_stats.R +% Please edit documentation in R/format_stats_htest.R \name{format_stats.htest} \alias{format_stats.htest} \title{Format hypothesis test statistics} @@ -96,6 +96,7 @@ Other functions for printing statistical objects: \code{\link{format_corr}()}, \code{\link{format_stats}()}, \code{\link{format_stats.BFBayesFactor}()}, +\code{\link{format_stats.aov}()}, \code{\link{format_stats.easycorrelation}()}, \code{\link{format_ttest}()} } diff --git a/man/format_ttest.Rd b/man/format_ttest.Rd index ac1fc4e..20868ba 100644 --- a/man/format_ttest.Rd +++ b/man/format_ttest.Rd @@ -51,6 +51,7 @@ Other functions for printing statistical objects: \code{\link{format_corr}()}, \code{\link{format_stats}()}, \code{\link{format_stats.BFBayesFactor}()}, +\code{\link{format_stats.aov}()}, \code{\link{format_stats.easycorrelation}()}, \code{\link{format_stats.htest}()} } diff --git a/pkgdown/favicon/apple-touch-icon-120x120.png b/pkgdown/favicon/apple-touch-icon-120x120.png new file mode 100644 index 0000000..d9c7050 Binary files /dev/null and b/pkgdown/favicon/apple-touch-icon-120x120.png differ diff --git a/pkgdown/favicon/apple-touch-icon-152x152.png b/pkgdown/favicon/apple-touch-icon-152x152.png new file mode 100644 index 0000000..027933c Binary files /dev/null and b/pkgdown/favicon/apple-touch-icon-152x152.png differ diff --git a/pkgdown/favicon/apple-touch-icon-180x180.png b/pkgdown/favicon/apple-touch-icon-180x180.png new file mode 100644 index 0000000..2acdeb4 Binary files /dev/null and b/pkgdown/favicon/apple-touch-icon-180x180.png differ diff --git a/pkgdown/favicon/apple-touch-icon-60x60.png b/pkgdown/favicon/apple-touch-icon-60x60.png new file mode 100644 index 0000000..696e5f4 Binary files /dev/null and b/pkgdown/favicon/apple-touch-icon-60x60.png differ diff --git a/pkgdown/favicon/apple-touch-icon-76x76.png b/pkgdown/favicon/apple-touch-icon-76x76.png new file mode 100644 index 0000000..49782ca Binary files /dev/null and b/pkgdown/favicon/apple-touch-icon-76x76.png differ diff --git a/pkgdown/favicon/apple-touch-icon.png b/pkgdown/favicon/apple-touch-icon.png new file mode 100644 index 0000000..99cfdea Binary files /dev/null and b/pkgdown/favicon/apple-touch-icon.png differ diff --git a/pkgdown/favicon/favicon-16x16.png b/pkgdown/favicon/favicon-16x16.png new file mode 100644 index 0000000..60c81d4 Binary files /dev/null and b/pkgdown/favicon/favicon-16x16.png differ diff --git a/pkgdown/favicon/favicon-32x32.png b/pkgdown/favicon/favicon-32x32.png new file mode 100644 index 0000000..9ac83f4 Binary files /dev/null and b/pkgdown/favicon/favicon-32x32.png differ diff --git a/pkgdown/favicon/favicon.ico b/pkgdown/favicon/favicon.ico new file mode 100644 index 0000000..0b6385b Binary files /dev/null and b/pkgdown/favicon/favicon.ico differ diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R index 849f0fe..8662778 100644 --- a/tests/testthat/helper.R +++ b/tests/testthat/helper.R @@ -11,5 +11,7 @@ test_ttest3 <- suppressWarnings(wilcox.test(df$a, mu = 5)) test_ttest4 <- suppressWarnings(wilcox.test(df$a, df$b)) test_ttest5 <- suppressWarnings(wilcox.test(df$a, c(df$b, 120))) test_chisq <- chisq.test(as.table(rbind(c(762, 327, 468), c(484, 239, 477)))) +test_aov <- aov(c ~ a, data = df) test_bf <- BayesFactor::ttestBF(df$a, mu = 5) +library(rlang) diff --git a/tests/testthat/test-format_numbers.R b/tests/testthat/test-format_numbers.R index 7339f79..0e8e3c0 100644 --- a/tests/testthat/test-format_numbers.R +++ b/tests/testthat/test-format_numbers.R @@ -1,15 +1,15 @@ test_that("format_num() rounds properly", { suppressMessages(expect_error( format_num("xxx"), - "Input must be a numeric vector" + '`x` must be a numeric vector, not the string "xxx"' )) suppressMessages(expect_error( format_num(123.456, digits = "xxx"), - "Argument `digits` must be a non-negative numeric vector" + '`digits` must be a whole number, not the string "xxx"' )) suppressMessages(expect_error( format_num(123.456, digits = -1), - "Argument `digits` must be a non-negative numeric vector" + '`digits` must be a whole number larger than or equal to 0, not the number -1' )) expect_equal(format_num(123.456), "123.5") expect_equal(format_num(123.456, digits = 2), "123.46") @@ -19,19 +19,19 @@ test_that("format_num() rounds properly", { test_that("format_scientific() works properly", { suppressMessages(expect_error( format_scientific("xxx"), - "Input must be a numeric vector" + '`x` must be a numeric vector, not the string "xxx"' )) suppressMessages(expect_error( format_scientific(123.456, digits = "xxx"), - "Argument `digits` must be a non-negative numeric vector" + '`digits` must be a whole number, not the string "xxx"' )) suppressMessages(expect_error( format_scientific(123.456, digits = -1), - "Argument `digits` must be a non-negative numeric vector" + '`digits` must be a whole number larger than or equal to 1, not the number -1' )) suppressMessages(expect_error( - format_bf(123.4567, type = "xxx"), - "Argument `type` must be 'md' or 'latex'" + format_scientific(123.4567, type = "xxx"), + '`type` must be "md" or "latex", not the string "xxx"' )) expect_equal(format_scientific(1000), "1.0×10^3^") expect_equal(format_scientific(0.00123), "1.2×10^-3^") @@ -43,15 +43,15 @@ test_that("format_scientific() works properly", { test_that("format_chr() formats properly", { suppressMessages(expect_error( format_chr(3), - "Input must be a character string" + '`x` must be a single string, not the number 3' )) suppressMessages(expect_error( format_chr("xxx", italics = "xxx"), - "Argument `italics` must be TRUE or FALSE" + '`italics` must be `TRUE` or `FALSE`, not the string "xxx"' )) suppressMessages(expect_error( format_chr("xxx", type = "xxx"), - "Argument `type` must be 'md' or 'latex'" + '`type` must be "md" or "latex", not the string "xxx"' )) expect_equal(format_chr("Hello world!"), "_Hello world!_") expect_equal(format_chr("Hello world!", italics = FALSE), "Hello world!") @@ -62,11 +62,11 @@ test_that("format_chr() formats properly", { test_that("format_sub() formats properly", { suppressMessages(expect_error( format_sub(3), - "Input must be a character string" + '`subscript` must be a single string or `NULL`, not the number 3' )) suppressMessages(expect_error( format_sub("xxx", type = "xxx"), - "Argument `type` must be 'md' or 'latex'" + '`type` must be "md" or "latex", not the string "xxx"' )) expect_equal(format_sub("10"), "~10~") expect_equal(format_sub("10", type = "latex"), "$_{10}$") diff --git a/tests/testthat/test-format_stats.R b/tests/testthat/test-format_stats.R index 6a63e39..2e21818 100644 --- a/tests/testthat/test-format_stats.R +++ b/tests/testthat/test-format_stats.R @@ -1,226 +1,35 @@ test_that("unavailable format_stats() methods are aborted", { suppressMessages(expect_error( format_stats(123), - "Numerics are not supported by" + 'Numerics are not supported by' )) suppressMessages(expect_error( format_stats("xxx"), - "Character strings are not supported by" + 'Character strings are not supported by' )) suppressMessages(expect_error( format_stats(df), - "Data frames are not supported by" + 'Data frames are not supported by' )) suppressMessages(expect_error( format_stats(TRUE), - "Objects of class" + 'Objects of class' )) suppressMessages(expect_error( format_stats(test_chisq), - "Objects of method" + 'Objects of method' )) }) -test_that("htest correlations are validated properly", { - suppressMessages(expect_error( - format_stats(test_corr, digits = "xxx"), - "Argument `digits` must be a non-negative numeric vector" - )) - suppressMessages(expect_error( - format_stats(test_corr, digits = -1), - "Argument `digits` must be a non-negative numeric vector" - )) - suppressMessages(expect_error( - format_stats(test_corr, pdigits = "xxx"), - "Argument `pdigits` must be a numeric between 1 and 5" - )) - suppressMessages(expect_error( - format_stats(test_corr, pdigits = 0), - "Argument `pdigits` must be a numeric between 1 and 5" - )) - suppressMessages(expect_error( - format_stats(test_corr, pdigits = 7), - "Argument `pdigits` must be a numeric between 1 and 5" - )) - suppressMessages(expect_error( - format_stats(test_corr, pzero = "xxx"), - "Argument `pzero` must be TRUE or FALSE" - )) - suppressMessages(expect_error( - format_stats(test_corr, full = "xxx"), - "Argument `full` must be TRUE or FALSE" - )) - suppressMessages(expect_error( - format_stats(test_corr, italics = "xxx"), - "Argument `italics` must be TRUE or FALSE" - )) - suppressMessages(expect_error( - format_stats(test_corr, type = "xxx"), - "Argument `type` must be 'md' or 'latex'" - )) -}) -test_that("correlation correlations are validated properly", { - suppressMessages(expect_error( - format_stats(test_easycorr, digits = "xxx"), - "Argument `digits` must be a non-negative numeric vector" - )) - suppressMessages(expect_error( - format_stats(test_easycorr, digits = -1), - "Argument `digits` must be a non-negative numeric vector" - )) - suppressMessages(expect_error( - format_stats(test_easycorr, pdigits = "xxx"), - "Argument `pdigits` must be a numeric between 1 and 5" - )) - suppressMessages(expect_error( - format_stats(test_easycorr, pdigits = 0), - "Argument `pdigits` must be a numeric between 1 and 5" - )) - suppressMessages(expect_error( - format_stats(test_easycorr, pdigits = 7), - "Argument `pdigits` must be a numeric between 1 and 5" - )) - suppressMessages(expect_error( - format_stats(test_easycorr, pzero = "xxx"), - "Argument `pzero` must be TRUE or FALSE" - )) - suppressMessages(expect_error( - format_stats(test_easycorr, full = "xxx"), - "Argument `full` must be TRUE or FALSE" - )) - suppressMessages(expect_error( - format_stats(test_easycorr, italics = "xxx"), - "Argument `italics` must be TRUE or FALSE" - )) - suppressMessages(expect_error( - format_stats(test_easycorr, type = "xxx"), - "Argument `type` must be 'md' or 'latex'" - )) -}) - -test_that("formatting correlations works properly", { - expect_equal(format_stats(test_corr), "_r_ = 1.00, 95% CI [1.00, 1.00], _p_ < .001") - expect_equal(format_stats(test_corr, digits = 3), "_r_ = 1.000, 95% CI [1.000, 1.000], _p_ < .001") - expect_equal(format_stats(test_corr, pdigits = 2), "_r_ = 1.00, 95% CI [1.00, 1.00], _p_ < .01") - expect_equal(format_stats(test_corr, pzero = TRUE), "_r_ = 1.00, 95% CI [1.00, 1.00], _p_ < 0.001") - expect_equal(format_stats(test_corr2), "_r_ = -.12, 95% CI [-0.70, 0.55], _p_ = .748") - expect_equal(format_stats(test_corr2, pzero = TRUE), "_r_ = -0.12, 95% CI [-0.70, 0.55], _p_ = 0.748") - expect_equal(format_stats(test_corr, full = FALSE), "_r_ = 1.00, _p_ < .001") - expect_equal(format_stats(test_corr, italics = FALSE), "r = 1.00, 95% CI [1.00, 1.00], p < .001") - expect_equal(format_stats(test_corr, type = "latex"), "$r$ = 1.00, 95% CI [1.00, 1.00], $p$ < .001") - expect_equal(format_stats(cor.test(df$a, df$b, method = "kendall")), "_τ_ = 1.00, _p_ < .001") - expect_equal(format_stats(cor.test(df$a, df$b, method = "spearman")), "_ρ_ = 1.00, _p_ < .001") -}) - -test_that("htest t-tests are validated properly", { - suppressMessages(expect_error( - format_stats(test_ttest, digits = "xxx"), - "Argument `digits` must be a non-negative numeric vector" - )) - suppressMessages(expect_error( - format_stats(test_ttest, digits = -1), - "Argument `digits` must be a non-negative numeric vector" - )) - suppressMessages(expect_error( - format_stats(test_ttest, pdigits = "xxx"), - "Argument `pdigits` must be a numeric between 1 and 5" - )) - suppressMessages(expect_error( - format_stats(test_ttest, pdigits = 0), - "Argument `pdigits` must be a numeric between 1 and 5" - )) - suppressMessages(expect_error( - format_stats(test_ttest, pdigits = 7), - "Argument `pdigits` must be a numeric between 1 and 5" - )) - suppressMessages(expect_error( - format_stats(test_ttest, pzero = "xxx"), - "Argument `pzero` must be TRUE or FALSE" - )) - suppressMessages(expect_error( - format_stats(test_ttest, full = "xxx"), - "Argument `full` must be TRUE or FALSE" - )) - suppressMessages(expect_error( - format_stats(test_ttest, italics = "xxx"), - "Argument `italics` must be TRUE or FALSE" - )) - suppressMessages(expect_error( - format_stats(test_ttest, dfs = "xxx"), - "Argument `dfs` must be 'par', 'sub', or 'none'" - )) - suppressMessages(expect_error( - format_stats(test_ttest, mean = "xxx"), - "Argument `mean` must be 'abbr' or 'word'" - )) - suppressMessages(expect_error( - format_stats(test_ttest, type = "xxx"), - "Argument `type` must be 'md' or 'latex'" - )) -}) - -test_that("formatting t-tests works properly", { - expect_equal(format_stats(test_ttest1), "_M_ = 5.5, 95% CI [3.3, 7.7], _t_(9) = 0.5, _p_ = .614") - expect_equal(format_stats(test_ttest), "_M_ = -1.0, 95% CI [-3.8, 1.8], _t_(18) = -0.7, _p_ = .470") - expect_equal(format_stats(test_ttest2), "_M_ = -11.3, 95% CI [-34.4, 11.8], _t_(10.2) = -1.1, _p_ = .302") - expect_equal(format_stats(test_ttest, digits = 2), "_M_ = -1.00, 95% CI [-3.84, 1.84], _t_(18) = -0.74, _p_ = .470") - expect_equal(format_stats(test_ttest, pdigits = 2), "_M_ = -1.0, 95% CI [-3.8, 1.8], _t_(18) = -0.7, _p_ = .47") - expect_equal(format_stats(test_ttest, pzero = TRUE), "_M_ = -1.0, 95% CI [-3.8, 1.8], _t_(18) = -0.7, _p_ = 0.470") - expect_equal(format_stats(test_ttest, full = FALSE), "_t_(18) = -0.7, _p_ = .470") - expect_equal(format_stats(test_ttest, italics = FALSE), "M = -1.0, 95% CI [-3.8, 1.8], t(18) = -0.7, p = .470") - expect_equal(format_stats(test_ttest, dfs = "sub"), "_M_ = -1.0, 95% CI [-3.8, 1.8], _t_~18~ = -0.7, _p_ = .470") - expect_equal(format_stats(test_ttest, dfs = "none"), "_M_ = -1.0, 95% CI [-3.8, 1.8], _t_ = -0.7, _p_ = .470") - expect_equal(format_stats(test_ttest, type = "latex"), "$M$ = -1.0, 95% CI [-3.8, 1.8], $t$(18) = -0.7, $p$ = .470") - expect_equal(format_stats(test_ttest, type = "latex", dfs = "sub"), "$M$ = -1.0, 95% CI [-3.8, 1.8], $t$$_{18}$ = -0.7, $p$ = .470") - expect_equal(format_stats(test_ttest, mean = "word"), "_Mean_ = -1.0, 95% CI [-3.8, 1.8], _t_(18) = -0.7, _p_ = .470") - suppressMessages(expect_equal(format_stats(test_ttest3), "_V_ = 27.0, _p_ = .634")) - suppressMessages(expect_equal(format_stats(test_ttest4), "_W_ = 40.5, _p_ = .495")) - suppressMessages(expect_equal(format_stats(test_ttest5), "_W_ = 40.5, _p_ = .323")) -}) - -test_that("format_stats() works properly for htest and BayesFactor objects", { +test_that("format_stats() works properly for accepted objects", { expect_no_error(format_stats(test_ttest)) expect_no_error(format_stats(test_corr)) expect_no_error(format_stats(test_easycorr)) expect_no_error(format_stats(test_easycorr2)) expect_no_error(format_stats(test_easycorr3)) + expect_no_error(format_stats(test_aov, "a")) expect_no_error(format_stats(test_bf)) }) -test_that("format_stats.BFBayesFactor() validates arguments properly", { - suppressMessages(expect_error( - format_stats(test_bf, digits1 = "xxx"), - "Argument `digits1` must be a non-negative numeric vector" - )) - suppressMessages(expect_error( - format_stats(test_bf, digits1 = -1), - "Argument `digits1` must be a non-negative numeric vector" - )) - suppressMessages(expect_error( - format_stats(test_bf, digits2 = "xxx"), - "Argument `digits2` must be a non-negative numeric vector" - )) - suppressMessages(expect_error( - format_stats(test_bf, digits2 = -1), - "Argument `digits2` must be a non-negative numeric vector" - )) - suppressMessages(expect_error( - format_stats(test_bf, cutoff = 0.5), - "Argument `cutoff` must be a numeric vector greater than 1 or NULL" - )) - suppressMessages(expect_error( - format_stats(test_bf, cutoff = "xxx"), - "Argument `cutoff` must be a numeric vector greater than 1 or NULL" - )) - suppressMessages(expect_error( - format_stats(test_bf, italics = "xxx"), - "Argument `italics` must be TRUE or FALSE" - )) - suppressMessages(expect_error( - format_stats(test_bf, type = "xxx"), - "Argument `type` must be 'md' or 'latex'" - )) -}) - diff --git a/tests/testthat/test-format_stats_BFBayesFactor.R b/tests/testthat/test-format_stats_BFBayesFactor.R new file mode 100644 index 0000000..89e095b --- /dev/null +++ b/tests/testthat/test-format_stats_BFBayesFactor.R @@ -0,0 +1,36 @@ + +test_that("format_stats.BFBayesFactor() validates arguments properly", { + suppressMessages(expect_error( + format_stats(test_bf, digits1 = "xxx"), + '`digits1` must be a whole number or `NULL`, not the string "xxx"' + )) + suppressMessages(expect_error( + format_stats(test_bf, digits1 = -1), + '`digits1` must be a whole number larger than or equal to 0 or `NULL`, not the number -1' + )) + suppressMessages(expect_error( + format_stats(test_bf, digits2 = "xxx"), + '`digits2` must be a whole number or `NULL`, not the string "xxx"' + )) + suppressMessages(expect_error( + format_stats(test_bf, digits2 = -1), + '`digits2` must be a whole number larger than or equal to 0 or `NULL`, not the number -1' + )) + suppressMessages(expect_error( + format_stats(test_bf, cutoff = 0.5), + '`cutoff` must be a number larger than or equal to 1 or `NULL`, not the number 0.5' + )) + suppressMessages(expect_error( + format_stats(test_bf, cutoff = "xxx"), + '`cutoff` must be a number or `NULL`, not the string "xxx"' + )) + suppressMessages(expect_error( + format_stats(test_bf, italics = "xxx"), + '`italics` must be `TRUE` or `FALSE`, not the string "xxx"' + )) + suppressMessages(expect_error( + format_stats(test_bf, type = "xxx"), + '`type` must be "md" or "latex", not the string "xxx"' + )) +}) + diff --git a/tests/testthat/test-format_stats_aov.R b/tests/testthat/test-format_stats_aov.R new file mode 100644 index 0000000..0883c2d --- /dev/null +++ b/tests/testthat/test-format_stats_aov.R @@ -0,0 +1,60 @@ + +test_that("aov ANOVAs are validated properly", { + suppressMessages(expect_error( + format_stats(test_aov), + '`term` must be a character vector, not absent' + )) + suppressMessages(expect_error( + format_stats(test_aov, term = "c", digits = "xxx"), + '`digits` must be a whole number or `NULL`, not the string "xxx"' + )) + suppressMessages(expect_error( + format_stats(test_aov, term = "c", digits = -1), + '`digits` must be a whole number larger than or equal to 0 or `NULL`, not the number -1' + )) + suppressMessages(expect_error( + format_stats(test_aov, term = "c", digits = 1.5), + '`digits` must be a whole number or `NULL`, not the number 1.5' + )) + suppressMessages(expect_error( + format_stats(test_aov, term = "c", pdigits = "xxx"), + '`pdigits` must be a whole number, not the string "xxx"' + )) + suppressMessages(expect_error( + format_stats(test_aov, term = "c", pdigits = 0), + '`pdigits` must be a whole number between 1 and 5, not the number 0' + )) + suppressMessages(expect_error( + format_stats(test_aov, term = "c", pdigits = 7), + '`pdigits` must be a whole number between 1 and 5, not the number 7' + )) + suppressMessages(expect_error( + format_stats(test_aov, term = "c", pzero = "xxx"), + '`pzero` must be `TRUE` or `FALSE`, not the string "xxx"' + )) + suppressMessages(expect_error( + format_stats(test_aov, term = "c", italics = "xxx"), + '`italics` must be `TRUE` or `FALSE`, not the string "xxx"' + )) + suppressMessages(expect_error( + format_stats(test_aov, term = "c", dfs = "xxx"), + '`dfs` must be "par", "sub", or "none", not the string "xxx"' + )) + suppressMessages(expect_error( + format_stats(test_aov, term = "c", type = "xxx"), + '`type` must be "md" or "latex", not the string "xxx"' + )) +}) + + +test_that("formatting ANOVAs works properly", { + expect_equal(format_stats(test_aov, "a"), "_F_(1, 8) = 0.1, _p_ = .748") + expect_equal(format_stats(test_aov, "a", digits = 2), "_F_(1, 8) = 0.11, _p_ = .748") + expect_equal(format_stats(test_aov, "a", pdigits = 2), "_F_(1, 8) = 0.1, _p_ = .75") + expect_equal(format_stats(test_aov, "a", pzero = TRUE), "_F_(1, 8) = 0.1, _p_ = 0.748") + expect_equal(format_stats(test_aov, "a", italics = FALSE), "F(1, 8) = 0.1, p = .748") + expect_equal(format_stats(test_aov, "a", dfs = "sub"), "_F_~1,8~ = 0.1, _p_ = .748") + expect_equal(format_stats(test_aov, "a", dfs = "none"), "_F_ = 0.1, _p_ = .748") + expect_equal(format_stats(test_aov, "a", type = "latex"), "$F$(1, 8) = 0.1, $p$ = .748") + expect_equal(format_stats(test_aov, "a", type = "latex", dfs = "sub"), "$F$$_{1,8}$ = 0.1, $p$ = .748") +}) diff --git a/tests/testthat/test-format_stats_easycorrelation.R b/tests/testthat/test-format_stats_easycorrelation.R new file mode 100644 index 0000000..3ef28a1 --- /dev/null +++ b/tests/testthat/test-format_stats_easycorrelation.R @@ -0,0 +1,57 @@ + +test_that("easycorrelation correlations are validated properly", { + suppressMessages(expect_error( + format_stats(test_easycorr, digits = "xxx"), + '`digits` must be a whole number or `NULL`, not the string "xxx"' + )) + suppressMessages(expect_error( + format_stats(test_easycorr, digits = -1), + '`digits` must be a whole number larger than or equal to 0 or `NULL`, not the number -1' + )) + suppressMessages(expect_error( + format_stats(test_easycorr, digits = 1.5), + '`digits` must be a whole number or `NULL`, not the number 1.5' + )) + suppressMessages(expect_error( + format_stats(test_easycorr, pdigits = "xxx"), + '`pdigits` must be a whole number, not the string "xxx"' + )) + suppressMessages(expect_error( + format_stats(test_easycorr, pdigits = 0), + '`pdigits` must be a whole number between 1 and 5, not the number 0' + )) + suppressMessages(expect_error( + format_stats(test_easycorr, pdigits = 7), + '`pdigits` must be a whole number between 1 and 5, not the number 7' + )) + suppressMessages(expect_error( + format_stats(test_easycorr, pzero = "xxx"), + '`pzero` must be `TRUE` or `FALSE`, not the string "xxx"' + )) + suppressMessages(expect_error( + format_stats(test_easycorr, full = "xxx"), + '`full` must be `TRUE` or `FALSE`, not the string "xxx"' + )) + suppressMessages(expect_error( + format_stats(test_easycorr, italics = "xxx"), + '`italics` must be `TRUE` or `FALSE`, not the string "xxx"' + )) + suppressMessages(expect_error( + format_stats(test_easycorr, type = "xxx"), + '`type` must be "md" or "latex", not the string "xxx"' + )) +}) + + +test_that("formatting easycorrelations works properly", { + expect_equal(format_stats(test_easycorr), "_r_ = -.12, 95% CI [-0.70, 0.55], _p_ = .748") + expect_equal(format_stats(test_easycorr2), "_ρ_ = -.03, _p_ = .933") + expect_equal(format_stats(test_easycorr3), "_τ_ = .00, _p_ = 1.000") + expect_equal(format_stats(test_easycorr, digits = 3), "_r_ = -.117, 95% CI [-0.695, 0.553], _p_ = .748") + expect_equal(format_stats(test_easycorr, pdigits = 2), "_r_ = -.12, 95% CI [-0.70, 0.55], _p_ = .75") + expect_equal(format_stats(test_easycorr, pzero = TRUE), "_r_ = -0.12, 95% CI [-0.70, 0.55], _p_ = 0.748") + expect_equal(format_stats(test_easycorr, full = FALSE), "_r_ = -.12, _p_ = .748") + expect_equal(format_stats(test_easycorr, italics = FALSE), "r = -.12, 95% CI [-0.70, 0.55], p = .748") + expect_equal(format_stats(test_easycorr, type = "latex"), "$r$ = -.12, 95% CI [-0.70, 0.55], $p$ = .748") +}) + diff --git a/tests/testthat/test-format_stats_htest.R b/tests/testthat/test-format_stats_htest.R new file mode 100644 index 0000000..f7cab83 --- /dev/null +++ b/tests/testthat/test-format_stats_htest.R @@ -0,0 +1,130 @@ + +test_that("htest correlations are validated properly", { + suppressMessages(expect_error( + format_stats(test_corr, digits = "xxx"), + '`digits` must be a whole number or `NULL`, not the string "xxx"' + )) + suppressMessages(expect_error( + format_stats(test_corr, digits = -1), + '`digits` must be a whole number larger than or equal to 0 or `NULL`, not the number -1' + )) + suppressMessages(expect_error( + format_stats(test_corr, digits = 1.5), + '`digits` must be a whole number or `NULL`, not the number 1.5' + )) + suppressMessages(expect_error( + format_stats(test_corr, pdigits = "xxx"), + '`pdigits` must be a whole number, not the string "xxx"' + )) + suppressMessages(expect_error( + format_stats(test_corr, pdigits = 0), + '`pdigits` must be a whole number between 1 and 5, not the number 0' + )) + suppressMessages(expect_error( + format_stats(test_corr, pdigits = 7), + '`pdigits` must be a whole number between 1 and 5, not the number 7' + )) + suppressMessages(expect_error( + format_stats(test_corr, pzero = "xxx"), + '`pzero` must be `TRUE` or `FALSE`, not the string "xxx"' + )) + suppressMessages(expect_error( + format_stats(test_corr, full = "xxx"), + '`full` must be `TRUE` or `FALSE`, not the string "xxx"' + )) + suppressMessages(expect_error( + format_stats(test_corr, italics = "xxx"), + '`italics` must be `TRUE` or `FALSE`, not the string "xxx"' + )) + suppressMessages(expect_error( + format_stats(test_corr, type = "xxx"), + '`type` must be "md" or "latex", not the string "xxx"' + )) +}) + + +test_that("formatting correlations works properly", { + expect_equal(format_stats(test_corr), "_r_ = 1.00, 95% CI [1.00, 1.00], _p_ < .001") + expect_equal(format_stats(test_corr, digits = 3), "_r_ = 1.000, 95% CI [1.000, 1.000], _p_ < .001") + expect_equal(format_stats(test_corr, pdigits = 2), "_r_ = 1.00, 95% CI [1.00, 1.00], _p_ < .01") + expect_equal(format_stats(test_corr, pzero = TRUE), "_r_ = 1.00, 95% CI [1.00, 1.00], _p_ < 0.001") + expect_equal(format_stats(test_corr2), "_r_ = -.12, 95% CI [-0.70, 0.55], _p_ = .748") + expect_equal(format_stats(test_corr2, pzero = TRUE), "_r_ = -0.12, 95% CI [-0.70, 0.55], _p_ = 0.748") + expect_equal(format_stats(test_corr, full = FALSE), "_r_ = 1.00, _p_ < .001") + expect_equal(format_stats(test_corr, italics = FALSE), "r = 1.00, 95% CI [1.00, 1.00], p < .001") + expect_equal(format_stats(test_corr, type = "latex"), "$r$ = 1.00, 95% CI [1.00, 1.00], $p$ < .001") + expect_equal(format_stats(cor.test(df$a, df$b, method = "kendall")), "_τ_ = 1.00, _p_ < .001") + expect_equal(format_stats(cor.test(df$a, df$b, method = "spearman")), "_ρ_ = 1.00, _p_ < .001") +}) + + +test_that("htest t-tests are validated properly", { + suppressMessages(expect_error( + format_stats(test_ttest, digits = "xxx"), + '`digits` must be a whole number or `NULL`, not the string "xxx"' + )) + suppressMessages(expect_error( + format_stats(test_ttest, digits = -1), + '`digits` must be a whole number larger than or equal to 0 or `NULL`, not the number -1' + )) + suppressMessages(expect_error( + format_stats(test_ttest, digits = 1.5), + '`digits` must be a whole number or `NULL`, not the number 1.5' + )) + suppressMessages(expect_error( + format_stats(test_ttest, pdigits = "xxx"), + '`pdigits` must be a whole number, not the string "xxx"' + )) + suppressMessages(expect_error( + format_stats(test_ttest, pdigits = 0), + '`pdigits` must be a whole number between 1 and 5, not the number 0' + )) + suppressMessages(expect_error( + format_stats(test_ttest, pdigits = 7), + '`pdigits` must be a whole number between 1 and 5, not the number 7' + )) + suppressMessages(expect_error( + format_stats(test_ttest, pzero = "xxx"), + '`pzero` must be `TRUE` or `FALSE`, not the string "xxx"' + )) + suppressMessages(expect_error( + format_stats(test_ttest, full = "xxx"), + '`full` must be `TRUE` or `FALSE`, not the string "xxx"' + )) + suppressMessages(expect_error( + format_stats(test_ttest, italics = "xxx"), + '`italics` must be `TRUE` or `FALSE`, not the string "xxx"' + )) + suppressMessages(expect_error( + format_stats(test_ttest, dfs = "xxx"), + '`dfs` must be "par", "sub", or "none", not the string "xxx"' + )) + suppressMessages(expect_error( + format_stats(test_ttest, mean = "xxx"), + '`mean` must be "abbr" or "word", not the string "xxx"' + )) + suppressMessages(expect_error( + format_stats(test_ttest, type = "xxx"), + '`type` must be "md" or "latex", not the string "xxx"' + )) +}) + + +test_that("formatting t-tests works properly", { + expect_equal(format_stats(test_ttest1), "_M_ = 5.5, 95% CI [3.3, 7.7], _t_(9) = 0.5, _p_ = .614") + expect_equal(format_stats(test_ttest), "_M_ = -1.0, 95% CI [-3.8, 1.8], _t_(18) = -0.7, _p_ = .470") + expect_equal(format_stats(test_ttest2), "_M_ = -11.3, 95% CI [-34.4, 11.8], _t_(10.2) = -1.1, _p_ = .302") + expect_equal(format_stats(test_ttest, digits = 2), "_M_ = -1.00, 95% CI [-3.84, 1.84], _t_(18) = -0.74, _p_ = .470") + expect_equal(format_stats(test_ttest, pdigits = 2), "_M_ = -1.0, 95% CI [-3.8, 1.8], _t_(18) = -0.7, _p_ = .47") + expect_equal(format_stats(test_ttest, pzero = TRUE), "_M_ = -1.0, 95% CI [-3.8, 1.8], _t_(18) = -0.7, _p_ = 0.470") + expect_equal(format_stats(test_ttest, full = FALSE), "_t_(18) = -0.7, _p_ = .470") + expect_equal(format_stats(test_ttest, italics = FALSE), "M = -1.0, 95% CI [-3.8, 1.8], t(18) = -0.7, p = .470") + expect_equal(format_stats(test_ttest, dfs = "sub"), "_M_ = -1.0, 95% CI [-3.8, 1.8], _t_~18~ = -0.7, _p_ = .470") + expect_equal(format_stats(test_ttest, dfs = "none"), "_M_ = -1.0, 95% CI [-3.8, 1.8], _t_ = -0.7, _p_ = .470") + expect_equal(format_stats(test_ttest, type = "latex"), "$M$ = -1.0, 95% CI [-3.8, 1.8], $t$(18) = -0.7, $p$ = .470") + expect_equal(format_stats(test_ttest, type = "latex", dfs = "sub"), "$M$ = -1.0, 95% CI [-3.8, 1.8], $t$$_{18}$ = -0.7, $p$ = .470") + expect_equal(format_stats(test_ttest, mean = "word"), "_Mean_ = -1.0, 95% CI [-3.8, 1.8], _t_(18) = -0.7, _p_ = .470") + suppressMessages(expect_equal(format_stats(test_ttest3), "_V_ = 27.0, _p_ = .634")) + suppressMessages(expect_equal(format_stats(test_ttest4), "_W_ = 40.5, _p_ = .495")) + suppressMessages(expect_equal(format_stats(test_ttest5), "_W_ = 40.5, _p_ = .323")) +}) diff --git a/tests/testthat/test-format_statvalues.R b/tests/testthat/test-format_statvalues.R index 2e73963..bd11fc9 100644 --- a/tests/testthat/test-format_statvalues.R +++ b/tests/testthat/test-format_statvalues.R @@ -1,43 +1,43 @@ test_that("format_bf() validates arguments properly", { suppressMessages(expect_error( format_bf("0.0012"), - "Input is not numeric or of class BFBayesFactor" + 'Input is not numeric or of class BFBayesFactor' )) suppressMessages(expect_error( format_bf(test_corr), - "Input is not numeric or of class BFBayesFactor" + 'Input is not numeric or of class BFBayesFactor' )) suppressMessages(expect_error( format_bf(123.4567, digits1 = "xxx"), - "Argument `digits1` must be a non-negative numeric vector" + '`digits1` must be a whole number or `NULL`, not the string "xxx"' )) suppressMessages(expect_error( format_bf(123.4567, digits1 = -1), - "Argument `digits1` must be a non-negative numeric vector" + '`digits1` must be a whole number larger than or equal to 0 or `NULL`, not the number -1' )) suppressMessages(expect_error( format_bf(123.4567, digits2 = "xxx"), - "Argument `digits2` must be a non-negative numeric vector" + '`digits2` must be a whole number or `NULL`, not the string "xxx"' )) suppressMessages(expect_error( format_bf(123.4567, digits2 = -1), - "Argument `digits2` must be a non-negative numeric vector" + '`digits2` must be a whole number larger than or equal to 0 or `NULL`, not the number -1' )) suppressMessages(expect_error( format_bf(123.4567, cutoff = 0.5), - "Argument `cutoff` must be a numeric vector greater than 1 or NULL" + '`cutoff` must be a number larger than or equal to 1 or `NULL`, not the number 0.5' )) suppressMessages(expect_error( format_bf(123.4567, cutoff = "xxx"), - "Argument `cutoff` must be a numeric vector greater than 1 or NULL" + '`cutoff` must be a number or `NULL`, not the string "xxx"' )) suppressMessages(expect_error( format_bf(123.4567, italics = "xxx"), - "Argument `italics` must be TRUE or FALSE" + '`italics` must be `TRUE` or `FALSE`, not the string "xxx"' )) suppressMessages(expect_error( format_bf(123.4567, type = "xxx"), - "Argument `type` must be 'md' or 'latex'" + '`type` must be "md" or "latex", not the string "xxx"' )) }) @@ -70,32 +70,33 @@ test_that("format_bf() works properly", { test_that("format_p() works properly", { suppressMessages(expect_error( format_p("xxx"), - "Input must be a numeric vector" + '`x` must be a numeric vector, not the string "xxx"' )) suppressMessages(expect_error( format_p(0.0012, digits = "xxx"), - "Argument `digits` must be a numeric between 1 and 5" + '`digits` must be a whole number or `NULL`, not the string "xxx"' )) suppressMessages(expect_error( format_p(0.0012, digits = 0), - "Argument `digits` must be a numeric between 1 and 5" + '`digits` must be a whole number between 1 and 5 or `NULL`, not the number 0' )) suppressMessages(expect_error( format_p(0.0012, digits = 7), - "Argument `digits` must be a numeric between 1 and 5" + '`digits` must be a whole number between 1 and 5 or `NULL`, not the number 7' )) suppressMessages(expect_error( format_p(0.0012, pzero = "xxx"), - "Argument `pzero` must be TRUE or FALSE" + '`pzero` must be `TRUE` or `FALSE`, not the string "xxx"' )) suppressMessages(expect_error( format_p(0.0012, italics = "xxx"), - "Argument `italics` must be TRUE or FALSE" + '`italics` must be `TRUE` or `FALSE`, not the string "xxx"' )) suppressMessages(expect_error( format_p(0.0012, type = "xxx"), - "Argument `type` must be 'md' or 'latex'" + '`type` must be "md" or "latex", not the string "xxx"' )) + expect_equal(format_p(c(0.0012, 0.444)), c("_p_ = .001", "_p_ = .444")) expect_equal(format_p(0.0012), "_p_ = .001") expect_equal(format_p(0.0012, digits = 2), "_p_ < .01") expect_equal(format_p(0.0012, pzero = TRUE), "_p_ = 0.001") diff --git a/tests/testthat/test-format_summary.R b/tests/testthat/test-format_summary.R index 8edfee3..22ed471 100644 --- a/tests/testthat/test-format_summary.R +++ b/tests/testthat/test-format_summary.R @@ -1,39 +1,43 @@ test_that("format_summary() works properly", { suppressMessages(expect_error( format_summary(x = "xxx"), - "Argument `x` must be a numeric vector" + '`x` must be a numeric vector, not the string "xxx"' )) suppressMessages(expect_error( - format_summary(error = "xxx"), - "You must include either the `x` or `values` argument" + format_summary(tendency = "xxx"), + 'You must include either the `x` or `values` argument' + )) + suppressMessages(expect_error( + format_summary(x = 1:3, tendency = "xxx"), + '`tendency` must be "mean" or "median", not the string "xxx"' )) suppressMessages(expect_error( format_summary(x = 1:3, error = "xxx"), - 'Specify `error` as "ci", "sd", "se", or "iqr"' + '`error` must be "ci", "sd", "se", or "iqr", not the string "xxx"' )) suppressMessages(expect_error( format_summary(values = "xxx"), - "Argument `values` must be a numeric vector" + '`values` must be a numeric vector, not the string "xxx"' )) suppressMessages(expect_error( format_summary(values = 1:4), - "Argument `values` must be a vector with two or three elements" + 'Argument `values` must be a vector with two or three elements' )) suppressMessages(expect_error( format_summary(values = c(2, 4, 1)), - "Argument `values` must include the mean followed by the lower CI limit then the upper CI limit" + 'Argument `values` must include the mean followed by the lower CI limit then the upper CI limit' )) suppressMessages(expect_error( format_summary(x = 1:3, tendlabel = "xxx"), - 'Specify `tendlabel` as "abbr", "word", or "none"' + '`tendlabel` must be "abbr", "word", or "none", not the string "xxx"' )) suppressMessages(expect_error( format_summary(x = 1:3, units = 2), - "The `units` argument must be a character vector or NULL" + '`units` must be a character vector or `NULL`, not the number 2' )) suppressMessages(expect_error( format_summary(x = 1:3, display = "xxx"), - 'Specify `display` as "limits", "pm", "par", or "none"' + '`display` must be "limits", "pm", "par", or "none", not the string "xxx"' )) expect_equal(format_summary(x = 1:10), "_M_ = 5.5, 95% CI [3.3, 7.7]") expect_equal(format_summary(values = c(5.5, 1.2)), "_M_ = 5.5, 95% CI [4.3, 6.7]") diff --git a/vignettes/.gitignore b/vignettes/.gitignore index 097b241..9e2bd63 100644 --- a/vignettes/.gitignore +++ b/vignettes/.gitignore @@ -1,2 +1,4 @@ *.html *.R + +/.quarto/ diff --git a/vignettes/cocoon.Rmd b/vignettes/cocoon.Rmd index 631dd60..07bf885 100644 --- a/vignettes/cocoon.Rmd +++ b/vignettes/cocoon.Rmd @@ -12,6 +12,7 @@ knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) +library(rlang) ``` ```{r setup-real, echo = FALSE, message = FALSE} @@ -73,36 +74,59 @@ The `format_stats()` function can also input objects returned by the `t.test()` Let's start by creating a few different t-tests ```{r} -mpg_disp_ttest_gear_carb <- t.test(mtcars$gear, mtcars$carb) -mpg_disp_ttest_gear_carb_paired <- t.test(mtcars$gear, mtcars$carb, paired = TRUE) -mpg_disp_ttest_gear_carb_onesample <- t.test(mtcars$gear, mu = 4) -mpg_disp_wtest_gear_carb <- wilcox.test(mtcars$gear, mtcars$carb, exact = FALSE) -mpg_disp_wtest_gear_carb_paired <- wilcox.test(mtcars$gear, mtcars$carb, paired = TRUE, exact = FALSE) -mpg_disp_wtest_gear_carb_onesample <- wilcox.test(mtcars$gear, mu = 4, exact = FALSE) +ttest_gear_carb <- t.test(mtcars$gear, mtcars$carb) +ttest_gear_carb_paired <- t.test(mtcars$gear, mtcars$carb, paired = TRUE) +ttest_gear_carb_onesample <- t.test(mtcars$gear, mu = 4) +wtest_gear_carb <- wilcox.test(mtcars$gear, mtcars$carb, exact = FALSE) +wtest_gear_carb_paired <- wilcox.test(mtcars$gear, mtcars$carb, paired = TRUE, exact = FALSE) +wtest_gear_carb_onesample <- wilcox.test(mtcars$gear, mu = 4, exact = FALSE) ``` For Student's t-tests, we get the mean value or difference and the confidence intervals. Means and confidence intervals can be omitted by setting `full = FALSE`. | Code | Output | |-------|-----| -| `format_stats(mpg_disp_ttest_gear_carb)` | `r format_stats(mpg_disp_ttest_gear_carb)` | -| `format_stats(mpg_disp_ttest_gear_carb_paired)` | `r format_stats(mpg_disp_ttest_gear_carb_paired)` | -| `format_stats(mpg_disp_ttest_gear_carb_onesample)` | `r format_stats(mpg_disp_ttest_gear_carb_onesample)` | -| `format_stats(mpg_disp_ttest_gear_carb_onesample, full = FALSE)` | `r format_stats(mpg_disp_ttest_gear_carb_onesample, full = FALSE)` | -| `format_stats(mpg_disp_wtest_gear_carb)` | `r format_stats(mpg_disp_wtest_gear_carb)` | -| `format_stats(mpg_disp_wtest_gear_carb_paired)` | `r format_stats(mpg_disp_wtest_gear_carb_paired)` | -| `format_stats(mpg_disp_wtest_gear_carb_onesample)` | `r format_stats(mpg_disp_wtest_gear_carb_onesample)` | +| `format_stats(ttest_gear_carb)` | `r format_stats(ttest_gear_carb)` | +| `format_stats(ttest_gear_carb_paired)` | `r format_stats(ttest_gear_carb_paired)` | +| `format_stats(ttest_gear_carb_onesample)` | `r format_stats(ttest_gear_carb_onesample)` | +| `format_stats(ttest_gear_carb_onesample, full = FALSE)` | `r format_stats(ttest_gear_carb_onesample, full = FALSE)` | +| `format_stats(wtest_gear_carb)` | `r format_stats(wtest_gear_carb)` | +| `format_stats(wtest_gear_carb_paired)` | `r format_stats(wtest_gear_carb_paired)` | +| `format_stats(wtest_gear_carb_onesample)` | `r format_stats(wtest_gear_carb_onesample)` | Format the number of digits of coefficients with `digits` and digits of p-values with `pdigits`. Include the leading zeros for coefficients and p-values with `pzero = TRUE`. Remove italics with `italics = FALSE`. | Code | Output | |---------|------| -| `format_stats(mpg_disp_ttest_gear_carb)` | `r format_stats(mpg_disp_ttest_gear_carb)` | -| `format_stats(mpg_disp_ttest_gear_carb, digits = 2, pdigits = 2)` | `r format_stats(mpg_disp_ttest_gear_carb, digits = 2, pdigits = 2)` | -| `format_stats(mpg_disp_ttest_gear_carb, pzero = TRUE)` | `r format_stats(mpg_disp_ttest_gear_carb, pzero = TRUE)` | -| `format_stats(mpg_disp_ttest_gear_carb, italics = FALSE)` | `r format_stats(mpg_disp_ttest_gear_carb, italics = FALSE)` | -| `format_stats(mpg_disp_wtest_gear_carb)` | `r format_stats(mpg_disp_wtest_gear_carb)` | -| `format_stats(mpg_disp_wtest_gear_carb, italics = FALSE)` | `r format_stats(mpg_disp_wtest_gear_carb, italics = FALSE)` | +| `format_stats(ttest_gear_carb)` | `r format_stats(ttest_gear_carb)` | +| `format_stats(ttest_gear_carb, digits = 2, pdigits = 2)` | `r format_stats(ttest_gear_carb, digits = 2, pdigits = 2)` | +| `format_stats(ttest_gear_carb, pzero = TRUE)` | `r format_stats(ttest_gear_carb, pzero = TRUE)` | +| `format_stats(ttest_gear_carb, italics = FALSE)` | `r format_stats(ttest_gear_carb, italics = FALSE)` | +| `format_stats(wtest_gear_carb)` | `r format_stats(wtest_gear_carb)` | +| `format_stats(wtest_gear_carb, italics = FALSE)` | `r format_stats(wtest_gear_carb, italics = FALSE)` | + +### ANOVAs + +The `format_stats()` function can also input objects returned by the `aov()` function. It then reports and formats the F statistic, degrees of freedom, and p-value. + +Let's start by creating an ANOVA + +```{r} +aov_mpg_cyl_hp <- aov(mpg ~ cyl * hp, data = mtcars) +summary(aov_mpg_cyl_hp) +``` + +To use `format_stats()` on ANOVAs, you must pass the `aov` object and a character string describing which term to extract. Apply `summary()` to your `aov` object and copy the text of the term you want to extract. Then you can format the number of digits of coefficients with `digits` and digits of p-values with `pdigits`. Include the leading zeros for coefficients and p-values with `pzero = TRUE`. Remove italics with `italics = FALSE`. With `dfs`, format degrees of freedom as parenthetical (`par`) or subscripts (`sub`) or remove them (`none`). + +| Code | Output | +|-------------|------| +| `format_stats(aov_mpg_cyl_hp, term = "cyl")` | `r format_stats(aov_mpg_cyl_hp, term = "cyl")` | +| `format_stats(aov_mpg_cyl_hp, term = "cyl:hp")` | `r format_stats(aov_mpg_cyl_hp, term = "cyl:hp")` | +| `format_stats(aov_mpg_cyl_hp, term = "cyl", digits = 2, pdigits = 2)` | `r format_stats(aov_mpg_cyl_hp, term = "cyl", digits = 2, pdigits = 2)` | +| `format_stats(aov_mpg_cyl_hp, term = "cyl", pzero = TRUE)` | `r format_stats(aov_mpg_cyl_hp, term = "cyl", pzero = TRUE)` | +| `format_stats(aov_mpg_cyl_hp, term = "cyl", italics = FALSE)` | `r format_stats(aov_mpg_cyl_hp, term = "cyl", italics = FALSE)` | +| `format_stats(aov_mpg_cyl_hp, term = "cyl", dfs = "sub")` | `r format_stats(aov_mpg_cyl_hp, term = "cyl", dfs = "sub")` | + ### Bayes factors