Merge remote-tracking branch 'origin/r-cmd-check' into apa_print.VGAM

crsh · Jun 26, 2024 · e2fded2 · e2fded2
2 parents 5d43f5a + 80a260b
commit e2fded2
Show file tree

Hide file tree

Showing 34 changed files with 115 additions and 49 deletions.
diff --git a/R/add_custom_effect_sizes.R b/R/add_custom_effect_sizes.R
@@ -1,9 +1,10 @@
-
+#' @keywords internal
 
 add_custom_effect_sizes <- function(estimate, ...) {
   UseMethod("add_custom_effect_sizes", estimate)
 }
 
+#' @keywords internal
 
 add_custom_effect_sizes.character <- function(estimate, canonical_table, .x = NULL, ...) {
 
@@ -13,6 +14,7 @@ add_custom_effect_sizes.character <- function(estimate, canonical_table, .x = NU
   add_effect_sizes(x = canonical_table, es = estimate, ...)
 }
 
+#' @keywords internal
 
 add_custom_effect_sizes.data.frame <- function(estimate, canonical_table, intercept = FALSE, ...) {
 
@@ -32,6 +34,7 @@ add_custom_effect_sizes.data.frame <- function(estimate, canonical_table, interc
   y
 }
 
+#' @keywords internal
 
 add_custom_effect_sizes.function <- function(estimate, canonical_table, intercept = FALSE, .x = NULL, observed = NULL, ...) {
 

diff --git a/R/apa_barplot.R b/R/apa_barplot.R
@@ -67,6 +67,7 @@ apa_barplot.default <- function(
   , xlab = NULL
   , ylab = NULL
   , main = NULL
+  , set_par = TRUE
   , ...
 ){
   ellipsis <- defaults(
@@ -93,6 +94,7 @@ apa_barplot.default <- function(
       , xlab = xlab
       , ylab = ylab
       , main = main
+      , set_par = set_par
       , jit = .4  # add parameter 'space'
       , plot = c("bars", "error_bars")
     )

diff --git a/R/apa_beeplot.R b/R/apa_beeplot.R
@@ -68,6 +68,7 @@ apa_beeplot.default <- function(
   , xlab = NULL
   , ylab = NULL
   , main = NULL
+  , set_par = TRUE
   , ...
 ){
   ellipsis <- defaults(
@@ -94,6 +95,7 @@ apa_beeplot.default <- function(
       , xlab = xlab
       , ylab = ylab
       , main = main
+      , set_par = set_par
       , plot = c("points", "error_bars", "swarms")
     )
   )

diff --git a/R/apa_factorial_plot.R b/R/apa_factorial_plot.R
@@ -37,6 +37,7 @@
 #' @param ylab Character or expression. Label for *y* axis.
 #' @param main Character or expression. For up to two factors, simply specify the main title. If you stratify the data by more than two factors,
 #' either specify a single value that will be added to automatically generated main title, *or* specify an array of multiple titles, one for each plot area.
+#' @param set_par Logical. Determines whether `par(mfrow = .)` should be set for multi-panel plots.
 #' @return A named (nested) list of plot options including raw and derived data. *Note that the structure of the return value is about to change in a forthcoming release of papaja.*
 #' @inheritDotParams graphics::plot.window
 #' @details
@@ -114,6 +115,7 @@ apa_factorial_plot.default <- function(
   , xlab = NULL
   , ylab = NULL
   , main = NULL
+  , set_par = TRUE
   , ...
 ){
   # Data validation:
@@ -149,6 +151,8 @@ apa_factorial_plot.default <- function(
   if(!is.null(ylab)) if(!is.expression(ylab)) validate(ylab, check_class = "character")
   if(!is.null(main)) if(!is.expression(main)) if(!is.matrix(main)) validate(main, check_class = "character")
 
+  set_par <- isTRUE(set_par)
+
   # remove extraneous columns from dataset
   data <- data[, c(id, factors, dv)]
 
@@ -392,7 +396,7 @@ apa_factorial_plot.default <- function(
     output$args <- do.call("apa_factorial_plot_single", ellipsis)
   }
 
-  if(length(factors) > 2L) {
+  if(length(factors) > 2L && set_par) {
   oldpar <- par(no.readonly = TRUE)
   on.exit(par(oldpar))
   }
@@ -401,7 +405,7 @@ apa_factorial_plot.default <- function(
 
 
   if(length(factors) == 3) {
-    par(mfrow = c(1, nlevels(data[[factors[3]]])))
+    if(set_par) par(mfrow = c(1, nlevels(data[[factors[3]]])))
     tmp_main <- ellipsis$main
 
     # by default, only plot legend in topright plot:
@@ -457,7 +461,7 @@ apa_factorial_plot.default <- function(
 
   ## Four factors
   if(length(factors)==4){
-    par(mfrow=c(nlevels(data[[factors[3]]]),nlevels(data[[factors[4]]])))
+    if(set_par) par(mfrow=c(nlevels(data[[factors[3]]]),nlevels(data[[factors[4]]])))
     tmp_main <- ellipsis$main
 
     legend.plot <- array(FALSE, dim=c(nlevels(data[[factors[3]]]), nlevels(data[[factors[4]]])))

diff --git a/R/apa_lineplot.R b/R/apa_lineplot.R
@@ -71,6 +71,7 @@ apa_lineplot.default <- function(
   , xlab = NULL
   , ylab = NULL
   , main = NULL
+  , set_par = TRUE
   , ...
 ){
   ellipsis <- defaults(
@@ -97,6 +98,7 @@ apa_lineplot.default <- function(
       , xlab = xlab
       , ylab = ylab
       , main = main
+      , set_par = set_par
       , plot = c("points", "error_bars", "lines")
     )
   )

diff --git a/R/apa_print_BFBayesFactor.R b/R/apa_print_BFBayesFactor.R
@@ -420,11 +420,16 @@ bf_sort_terms <- function(x) {
 
 # }
 
+#' @keywords internal
 
 bf_add_estimates <- function(x, ...) UseMethod("bf_add_estimates", x@numerator[[1]])
 
+#' @keywords internal
+
 bf_add_estimates.default <- function(x, data_frame, ...) data_frame
 
+#' @keywords internal
+
 bf_add_estimates.BFoneSample   <- function(
   x
   , data_frame
@@ -462,6 +467,7 @@ bf_add_estimates.BFoneSample   <- function(
   )
 }
 
+#' @keywords internal
 
 bf_add_estimates.BFindepSample <- function(
   x
@@ -495,6 +501,8 @@ bf_add_estimates.BFindepSample <- function(
   )
 }
 
+#' @keywords internal
+
 bf_add_estimates.BFcorrelation <- function(
   x
   , data_frame
@@ -510,6 +518,8 @@ bf_add_estimates.BFcorrelation <- function(
   )
 }
 
+#' @keywords internal
+
 bf_add_estimates.BFproportion <- function(
   x
   , data_frame
@@ -528,6 +538,7 @@ bf_add_estimates.BFproportion <- function(
   )
 }
 
+#' @keywords internal
 
 bf_sample_summarize <- function(
   x
@@ -564,11 +575,16 @@ bf_sample_summarize <- function(
   data_frame
 }
 
+#' @keywords internal
 
 bf_add_names <- function(x, ...) UseMethod("bf_add_names", x@numerator[[1]])
 
+#' @keywords internal
+
 bf_add_names.default <- function(x, data_frame, ...) data_frame
 
+#' @keywords internal
+
 bf_add_names.BFlinearModel <- function(x, data_frame, ...) {
   cbind(
     model = names(x)$numerator

diff --git a/R/apa_print_htest.R b/R/apa_print_htest.R
@@ -26,7 +26,7 @@
 #'   large number of functions that produce these objects and their
 #'   idiosyncrasies, the returned strings should be compared to the original
 #'   object. If you experience inaccuracies you may report these
-#'   [here]{https://github.com/crsh/papaja/issues} (please include
+#'   [here](https://github.com/crsh/papaja/issues) (please include
 #'   a reproducible example in your report).
 #'
 #'   `stat_name` and `est_name` are placed in the output string and are thus

diff --git a/R/arrange_anova.R b/R/arrange_anova.R
@@ -35,6 +35,8 @@ arrange_anova <- function(x, ...) {
   UseMethod("arrange_anova")
 }
 
+#' @keywords internal
+
 arrange_anova.default <- function(x, ...) {
   stop(paste0("Objects of class '", class(x), "' are currently not supported (no method defined).
               Visit https://github.com/crsh/papaja/issues to request support for this class."))
@@ -43,6 +45,7 @@ arrange_anova.default <- function(x, ...) {
 
 #' @rdname arrange_anova
 #' @method arrange_anova anova
+#' @keywords internal
 
 arrange_anova.anova <- function(x, ...) {
 
@@ -83,6 +86,7 @@ arrange_anova.anova <- function(x, ...) {
 
 #' @rdname arrange_anova
 #' @method arrange_anova summary.aov
+#' @keywords internal
 
 arrange_anova.summary.aov <- function(x, ...) {
 
@@ -116,6 +120,8 @@ arrange_anova.summary.aov <- function(x, ...) {
   variance_table
 }
 
+#' @keywords internal
+
 arrange_anova.summary.aovlist <- function(x, ...) {
   x <- lapply(x, arrange_anova.summary.aov)
   variance_table <- do.call("rbind", x)
@@ -129,6 +135,7 @@ arrange_anova.summary.aovlist <- function(x, ...) {
 
 #' @rdname arrange_anova
 #' @method arrange_anova summary.Anova.mlm
+#' @keywords internal
 
 arrange_anova.summary.Anova.mlm <- function(x, correction = "GG", ...) {
   validate(correction, check_class = "character", check_length = 1)

diff --git a/R/tidy_es.R b/R/tidy_es.R
@@ -1,7 +1,11 @@
+#' @keywords internal
+
 tidy_es <- function(x) {
   UseMethod("tidy_es", x)
 }
 
+#' @keywords internal
+
 tidy_es.default <- function(x) {
   tryCatch(
     broom::tidy(x)
@@ -11,6 +15,8 @@ tidy_es.default <- function(x) {
   )
 }
 
+#' @keywords internal
+
 tidy_es.data.frame <- function(x) {
   es_cols <- colnames(x)
   if(
@@ -24,6 +30,8 @@ tidy_es.data.frame <- function(x) {
   x
 }
 
+#' @keywords internal
+
 tidy_es.effectsize_table <- function(x) {
 
   x <- as.data.frame(x, stringsAsFactors = FALSE)
@@ -35,10 +43,14 @@ tidy_es.effectsize_table <- function(x) {
   canonize(x)
 }
 
+#' @keywords internal
+
 tidy_es.parameters_model <- function(x) {
   tidy_es.effectsize_table(x)
 }
 
+#' @keywords internal
+
 tidy_es.parameters_distribution <- function(x) {
   tidy_es.effectsize_table(x)
 }
diff --git a/R/utils.R b/R/utils.R
@@ -84,9 +84,8 @@ validate <- function(
 #'    \describe{
 #'      \item{`estimate`}{A (named list of) character strings giving effect-size estimates.}
 #'      \item{`statistic`}{A (named list of) character strings giving test statistic, parameters, and *p* values.}
-#'      \item{`full_result`}{A (named list of) character strings comprised of `estimate` and `statistic`` for each factor.}
-#'      \item{`table`}{A data frame containing all results; can, for example, be passed to [apa_table()].
-#'      }
+#'      \item{`full_result`}{A (named list of) character strings comprised of `estimate` and `statistic` for each factor.}
+#'      \item{`table`}{A data frame containing all results; can, for example, be passed to [apa_table()].}
 #'    }
 #' @keywords internal
 

diff --git a/man/apa_barplot.Rd b/man/apa_barplot.Rd
diff --git a/man/apa_beeplot.Rd b/man/apa_beeplot.Rd
diff --git a/man/apa_factorial_plot.Rd b/man/apa_factorial_plot.Rd
diff --git a/man/apa_lineplot.Rd b/man/apa_lineplot.Rd
diff --git a/man/apa_num.Rd b/man/apa_num.Rd