code cleanup of function arguments

danheck · Sep 11, 2023 · 20820ad · 20820ad
1 parent c51d9b9
commit 20820ad
Show file tree

Hide file tree

Showing 31 changed files with 510 additions and 146 deletions.
diff --git a/R/bma.R b/R/bma.R
@@ -24,8 +24,14 @@
 #' plot_forest(averaged, mar = c(4.5, 20, 4, .3))
 #' }
 #' @export
-bma <- function(meta, prior = 1, parameter = "d", summarize = "integrate", ci = .95,
-                rel.tol = .Machine$double.eps^0.5) {
+bma <- function(
+    meta,
+    prior = 1,
+    parameter = "d",
+    summarize = "integrate",
+    ci = .95,
+    rel.tol = .Machine$double.eps^0.5
+) {
 
   # stopifnot(parameter %in% c("d", "tau"))
   if (parameter == "tau") {

diff --git a/R/check_input.R b/R/check_input.R
@@ -1,4 +1,5 @@
 prior_pars <- function(prior) {
+
   par_labels <- switch(attr(prior, "family"),
     "norm" = c("mean", "sd"),
     "t" = c("location", "scale", "nu"),
@@ -11,7 +12,12 @@ prior_pars <- function(prior) {
   par_labels
 }
 
-check_prior <- function(prior, lower = -Inf, upper = Inf) {
+check_prior <- function(
+    prior,
+    lower = -Inf,
+    upper = Inf
+) {
+
   attr(prior, "family") <- match.arg(attr(prior, "family"), priors())
 
   stopifnot(inherits(prior, "prior"))
@@ -50,7 +56,13 @@ check_prior <- function(prior, lower = -Inf, upper = Inf) {
   prior
 }
 
-check_y_se <- function(y, SE, labels) {
+
+check_y_se <- function(
+    y,
+    SE,
+    labels
+) {
+
   stopifnot(is.numeric(y))
   stopifnot(is.numeric(SE))
   stopifnot(all(SE > 0))

diff --git a/R/check_posterior.R b/R/check_posterior.R
@@ -1,6 +1,12 @@
 
-check_posterior <- function(dpost, meta, parameter = "d",
-                            rel.tol = .Machine$double.eps^0.3, abs.tol = .001) {
+check_posterior <- function(
+    dpost,
+    meta,
+    parameter = "d",
+    rel.tol = .Machine$double.eps^0.3,
+    abs.tol = .001
+) {
+
   bnd <- bounds_prior(dpost)
   mini <- max(-3, bnd[1])
   maxi <- min(3, bnd[2])

diff --git a/R/data_list.R b/R/data_list.R
@@ -1,5 +1,13 @@
 ### Make data-list structure and check data
-data_list <- function(model, y, SE, labels, data, args) {
+data_list <- function(
+    model,
+    y,
+    SE,
+    labels,
+    data,
+    args
+) {
+
   model <- match.arg(model, c("random", "fixed", "random_ordered"))
 
   if (!missing(data) && is.list(data)) {

diff --git a/R/inclusion.R b/R/inclusion.R
@@ -28,7 +28,12 @@
 #' # BF: Correct (Model 1) vs. misspecified (2 & 3)
 #' inclusion(c(logm1, logm2, logm3), include = 1)
 #' @export
-inclusion <- function(logml, include = 1, prior = 1) {
+inclusion <- function(
+    logml,
+    include = 1,
+    prior = 1
+) {
+
   if (is.list(logml)) {
     logml <- unlist(lapply(logml, "[[", "logml"))
   }
@@ -79,7 +84,12 @@ make_BF <- function(logml) {
 }
 
 #' @export
-print.inclusion <- function(x, digits = 3, ...) {
+print.inclusion <- function(
+    x,
+    digits = 3,
+    ...
+) {
+
   nn <- names(x$prior)
   if (!is.null(attr(x$posterior, "names"))) {
     nn <- attr(x$posterior, "names")

diff --git a/R/integrate_wrapper.R b/R/integrate_wrapper.R
@@ -1,6 +1,10 @@
-integrate_wrapper <- function(data, d, tau,
-                              rel.tol = .Machine$double.eps^0.5,
-                              ratio.tol = .0001) {
+integrate_wrapper <- function(
+    data,
+    d,
+    tau,
+    rel.tol = .Machine$double.eps^0.5,
+    ratio.tol = .0001
+) {
 
   # shifting the posterior to have the mode (approximately) at zero
   weights <- 1 / data$SE^2

diff --git a/R/meta_bridge_sampling.R b/R/meta_bridge_sampling.R
@@ -1,8 +1,13 @@
 
 #' @importFrom bridgesampling bridge_sampler
-meta_bridge_sampling <- function(meta, logml = "integrate",
-                                 min_samples = 5000,
-                                 rel.error = .01, ...) {
+meta_bridge_sampling <- function(
+    meta,
+    logml = "integrate",
+    min_samples = 5000,
+    rel.error = .01,
+    ...
+) {
+
   if (logml == "integrate" && is.na(meta$logml)) {
     warning(
       "Marginal likelihood could not be computed with numerical integration (logml='integrate)'.\n",

diff --git a/R/meta_default.R b/R/meta_default.R
@@ -61,8 +61,16 @@
 #' @seealso \code{\link{meta_bma}}, \code{\link{plot_default}}, \code{\link{transform_es}}
 #' @template ref_gronau2017
 #' @export
-meta_default <- function(y, SE, labels, data,
-                         field = "psychology", effect = "d", ...) {
+meta_default <- function(
+    y,
+    SE,
+    labels,
+    data,
+    field = "psychology",
+    effect = "d",
+    ...
+) {
+
   def <- get_default(field, effect)
   dl <- data_list("random",
                   y = y, SE = SE, labels = labels, data = data,
@@ -78,7 +86,11 @@ meta_default <- function(y, SE, labels, data,
 }
 
 
-get_default <- function(field, effect) {
+get_default <- function(
+    field,
+    effect
+) {
+
   field <- match.arg(field, c("psychology", "medicine"))
   effect <- match.arg(effect, c("d", "z", "logOR", "ttest", "corr"))
 
@@ -147,7 +159,12 @@ get_default <- function(field, effect) {
 #' plot_default(field = "psychology", effect = "d")
 #' @seealso \code{\link{meta_default}} for details on standard priors.
 #' @export
-plot_default <- function(field = "psychology", effect = "d", ...) {
+plot_default <- function(
+    field = "psychology",
+    effect = "d",
+    ...
+) {
+
   mfrow <- par()$mfrow
   par(mfrow = c(1, 2))
   def <- get_default(field, effect)

diff --git a/R/meta_fixed.R b/R/meta_fixed.R
@@ -17,12 +17,23 @@
 #' plot_posterior(mf)
 #' plot_forest(mf)
 #' @export
-meta_fixed <- function(y, SE, labels, data,
-                       d = prior("cauchy", c(location = 0, scale = 0.707)),
-                       rscale_contin = 1 / 2, rscale_discrete = 0.707,
-                       centering = TRUE,
-                       logml = "integrate", summarize = "integrate", ci = .95,
-                       rel.tol = .Machine$double.eps^.3, silent_stan = TRUE, ...) {
+meta_fixed <- function(
+    y,
+    SE,
+    labels,
+    data,
+    d = prior("cauchy", c(location = 0, scale = 0.707)),
+    rscale_contin = 1 / 2,
+    rscale_discrete = 0.707,
+    centering = TRUE,
+    logml = "integrate",
+    summarize = "integrate",
+    ci = .95,
+    rel.tol = .Machine$double.eps^.3,
+    silent_stan = TRUE,
+    ...
+) {
+
   if ("tau" %in% names(list(...))) {
     warning("The fixed-effects model assumes tau=0. Hence, a prior distribution cannot be specified.")
   }

diff --git a/R/meta_ordered.R b/R/meta_ordered.R
@@ -48,13 +48,24 @@
 #' @seealso \link{meta_bma}, \link{meta_random}
 #' @template ref_haaf2019
 #' @export
-meta_ordered <- function(y, SE, labels, data,
-                         d = prior("norm", c(mean = 0, sd = .3), lower = 0),
-                         tau = prior("invgamma", c(shape = 1, scale = 0.15)),
-                         prior = c(1, 1, 1, 1),
-                         logml = "integrate", summarize = "stan", ci = .95,
-                         rel.tol = .Machine$double.eps^.3,
-                         logml_iter = 5000, iter = 5000, silent_stan = TRUE, ...) {
+meta_ordered <- function(
+    y,
+    SE,
+    labels,
+    data,
+    d = prior("norm", c(mean = 0, sd = .3), lower = 0),
+    tau = prior("invgamma", c(shape = 1, scale = 0.15)),
+    prior = c(1, 1, 1, 1),
+    logml = "integrate",
+    summarize = "stan",
+    ci = .95,
+    rel.tol = .Machine$double.eps^.3,
+    logml_iter = 5000,
+    iter = 5000,
+    silent_stan = TRUE,
+    ...
+) {
+
   check_deprecated(list(...)) # error: backwards compatibility
   if (attr(d, "lower") == -Inf && attr(d, "upper") == Inf) {
     stop(
@@ -182,7 +193,11 @@ meta_ordered <- function(y, SE, labels, data,
 
 
 # count how many prior/posterior samples are inside constraints
-count_dstudy <- function(stanfit, prior) {
+count_dstudy <- function(
+    stanfit,
+    prior
+) {
+
   samples <- extract(stanfit, "dstudy")[["dstudy"]]
   check_post <- apply(samples >= attr(prior, "lower") &
     samples <= attr(prior, "upper"), 1, all)

diff --git a/R/meta_random.R b/R/meta_random.R
@@ -19,13 +19,23 @@
 #' plot_posterior(mr)
 #' }
 #' @export
-meta_random <- function(y, SE, labels, data,
-                        d = prior("cauchy", c(location = 0, scale = 0.707)),
-                        tau = prior("invgamma", c(shape = 1, scale = 0.15)),
-                        rscale_contin = 0.5, rscale_discrete = 0.707, centering = TRUE,
-                        logml = "integrate", summarize = "stan", ci = .95,
-                        rel.tol = .Machine$double.eps^.3,
-                        logml_iter = 5000, silent_stan = TRUE, ...) {
+meta_random <- function(
+    y,
+    SE,
+    labels,
+    data,
+    d = prior("cauchy", c(location = 0, scale = 0.707)),
+    tau = prior("invgamma", c(shape = 1, scale = 0.15)),
+    rscale_contin = 0.5,
+    rscale_discrete = 0.707,
+    centering = TRUE,
+    logml = "integrate",
+    summarize = "stan", ci = .95,
+    rel.tol = .Machine$double.eps^.3,
+    logml_iter = 5000,
+    silent_stan = TRUE,
+    ...
+) {
 
   check_deprecated(list(...)) # error: backwards compatibility
   logml <- match.arg(logml, c("integrate", "stan"))

diff --git a/R/meta_sensitivity.R b/R/meta_sensitivity.R
@@ -50,12 +50,17 @@
 #'
 #' @seealso [plot.meta_sensitivity()]
 #' @export
-meta_sensitivity <- function(y, SE, labels, data,
-                             d_list,
-                             tau_list,
-                             analysis = "bma",
-                             combine_priors = "crossed",
-                             ...) {
+meta_sensitivity <- function(
+    y,
+    SE,
+    labels,
+    data,
+    d_list,
+    tau_list,
+    analysis = "bma",
+    combine_priors = "crossed",
+    ...
+) {
 
   analysis <- match.arg(analysis, c("fixed", "random", "bma"))
 
@@ -121,7 +126,10 @@ meta_sensitivity <- function(y, SE, labels, data,
 }
 
 
-print_priors <- function(prior_list, digits = 3) {
+print_priors <- function(
+    prior_list,
+    digits = 3
+) {
 
   if (inherits(prior_list[[1]], "meta_bma")) {
     prior_d   <- sapply(prior_list, function(x) describe_prior(x$meta$random$prior_d))
@@ -146,7 +154,11 @@ print_priors <- function(prior_list, digits = 3) {
 }
 
 #' @export
-print.meta_sensitivity <- function(x, digits = 3, ...) {
+print.meta_sensitivity <- function(
+    x,
+    digits = 3,
+    ...
+) {
 
 
   cat("### Sensitivity analysis for Bayesian meta-analysis ###\n\n")
@@ -197,14 +209,16 @@ print.meta_sensitivity <- function(x, digits = 3, ...) {
 #' @seealso [meta_sensitivity()]
 #' @method plot meta_sensitivity
 #' @export
-plot.meta_sensitivity <- function(x,
-                                  parameter = "d",
-                                  distribution = "posterior",
-                                  from,
-                                  to,
-                                  n = 101,
-                                  legend = TRUE,
-                                  ...) {
+plot.meta_sensitivity <- function(
+    x,
+    parameter = "d",
+    distribution = "posterior",
+    from,
+    to,
+    n = 101,
+    legend = TRUE,
+    ...
+) {
 
   parameter <- match.arg(parameter, c("d", "tau"))
   distribution <- match.arg(distribution, c("prior", "posterior"))