Merge pull request #248 from easystats/dev

cran v4

R/convert_bayesian_to_frequentist.R

@@ -11,27 +11,32 @@
 #'
 #' # Simple regressions
 #' model <- stan_glm(Sepal.Length ~ Petal.Length * Species,
-#'                   data = iris, chains = 2, refresh = 0)
+#'   data = iris, chains = 2, refresh = 0
+#' )
 #' bayesian_as_frequentist(model)
 #'
-#' model <- stan_glm(vs ~ mpg, family = "binomial",
-#'                   data = mtcars, chains = 2, refresh = 0)
+#' model <- stan_glm(vs ~ mpg,
+#'   family = "binomial",
+#'   data = mtcars, chains = 2, refresh = 0
+#' )
 #' bayesian_as_frequentist(model)
 #'
 #' # Mixed models
-#' model <- stan_glmer(Sepal.Length ~ Petal.Length + (1|Species),
-#'                     data = iris, chains = 2, refresh = 0)
+#' model <- stan_glmer(Sepal.Length ~ Petal.Length + (1 | Species),
+#'   data = iris, chains = 2, refresh = 0
+#' )
 #' bayesian_as_frequentist(model)
 #'
-#' model <- stan_glmer(vs ~ mpg + (1|cyl), family = "binomial",
-#'                     data = mtcars, chains = 2, refresh = 0)
+#' model <- stan_glmer(vs ~ mpg + (1 | cyl),
+#'   family = "binomial",
+#'   data = mtcars, chains = 2, refresh = 0
+#' )
 #' bayesian_as_frequentist(model)
 #' }
 #'
 #' @importFrom stats lm glm
 #' @export
 convert_bayesian_as_frequentist <- function(model, data = NULL) {
-
   if (is.null(data)) {
     data <- insight::get_data(model)
   }
@@ -51,13 +56,13 @@ convert_bayesian_as_frequentist <- function(model, data = NULL) {
     }
     if (info$is_linear) {
       freq <- lme4::lmer(formula, data = data)
-    } else{
+    } else {
       freq <- lme4::glmer(formula, data = data, family = family)
     }
-  } else{
+  } else {
     if (info$is_linear) {
       freq <- stats::lm(formula, data = data)
-    } else{
+    } else {
       freq <- stats::glm(formula, data = data, family = family)
     }
   }

R/overlap.R

@@ -16,7 +16,6 @@
 #'
 #' overlap(x, y)
 #' plot(overlap(x, y))
-#'
 #' @importFrom stats approxfun
 #' @export
 overlap <- function(x, y, method_density = "kernel", method_auc = "trapezoid", precision = 2^10, extend = TRUE, extend_scale = 0.1, ...) {
@@ -53,17 +52,17 @@ overlap <- function(x, y, method_density = "kernel", method_auc = "trapezoid", p
 
 
 #' @export
-print.overlap <- function(x, ...){
+print.overlap <- function(x, ...) {
   insight::print_color("# Overlap\n\n", "blue")
   cat(sprintf("%.2f", as.numeric(x)))
 }
 
 
 #' @importFrom graphics plot polygon
 #' @export
-plot.overlap <- function(x, ...){
+plot.overlap <- function(x, ...) {
   # Can be improved through see
   data <- attributes(x)$data
-  plot(data$x, data$exclusion, type="l")
+  plot(data$x, data$exclusion, type = "l")
   polygon(data$x, data$intersection, col = "red")
-}
+}

R/p_direction.R

@@ -43,11 +43,12 @@
 #' # rstanarm models
 #' # -----------------------------------------------
 #' library(rstanarm)
-#' model <- rstanarm::stan_glm(mpg ~ wt + cyl, data = mtcars,
-#'                             chains = 2, refresh = 0)
+#' model <- rstanarm::stan_glm(mpg ~ wt + cyl,
+#'   data = mtcars,
+#'   chains = 2, refresh = 0
+#' )
 #' p_direction(model)
 #' p_direction(model, method = "kernel")
-#'
 #' \dontrun{
 #' # emmeans
 #' # -----------------------------------------------

R/p_significance.R

@@ -23,10 +23,11 @@
 #' # rstanarm models
 #' # -----------------------------------------------
 #' library(rstanarm)
-#' model <- rstanarm::stan_glm(mpg ~ wt + cyl, data = mtcars,
-#'                             chains = 2, refresh = 0)
+#' model <- rstanarm::stan_glm(mpg ~ wt + cyl,
+#'   data = mtcars,
+#'   chains = 2, refresh = 0
+#' )
 #' p_significance(model)
-#'
 #' @export
 p_significance <- function(x, ...) {
   UseMethod("p_significance")
@@ -38,7 +39,6 @@ p_significance <- function(x, ...) {
 #' @rdname p_significance
 #' @export
 p_significance.numeric <- function(x, threshold = "default", ...) {
-
   threshold <- .select_threshold_ps(x = x, threshold = threshold)
 
   psig <- max(
@@ -60,7 +60,6 @@ p_significance.numeric <- function(x, threshold = "default", ...) {
 #' @rdname p_significance
 #' @export
 p_significance.data.frame <- function(x, threshold = "default", ...) {
-
   threshold <- .select_threshold_ps(x = x, threshold = threshold)
   x <- .select_nums(x)
 
@@ -122,7 +121,8 @@ p_significance.stanreg <- function(x, threshold = "default", effects = c("fixed"
 
   data <- p_significance(
     insight::get_parameters(x, effects = effects, parameters = parameters),
-    threshold = threshold)
+    threshold = threshold
+  )
 
   out <- .prepare_output(data, insight::clean_parameters(x))
 
@@ -155,16 +155,15 @@ as.double.p_significance <- as.numeric.p_significance
 
 
 #' @keywords internal
-.select_threshold_ps <- function(x = NULL, model = NULL, threshold = "default"){
+.select_threshold_ps <- function(x = NULL, model = NULL, threshold = "default") {
   if (all(threshold == "default")) {
-    if(!is.null(model)){
+    if (!is.null(model)) {
       threshold <- rope_range(model)[2]
-    } else{
+    } else {
       threshold <- 0.1
     }
   } else if (!all(is.numeric(threshold))) {
     stop("`threshold` should be 'default' or a numeric value (e.g., 0.1).")
   }
   threshold
 }
-

R/print.p_significance.R

@@ -5,16 +5,20 @@ print.p_significance <- function(x, digits = 2, ...) {
   } else if ("data.frame" %in% class(x)) {
     .print_ps(x, digits, ...)
   } else {
-    cat(sprintf("ps [%s] = %s%%",
-                insight::format_value(attributes(x)$threshold, digits = digits),
-                insight::format_value(x * 100, digits = digits)))
+    cat(sprintf(
+      "ps [%s] = %s%%",
+      insight::format_value(attributes(x)$threshold, digits = digits),
+      insight::format_value(x * 100, digits = digits)
+    ))
   }
 }
 
 #' @keywords internal
 .print_ps <- function(x, digits, ...) {
-  insight::print_color(sprintf("# Probability of Significance (ps [%s])\n\n",
-                               insight::format_value(attributes(x)$threshold, digits = digits)), "blue")
+  insight::print_color(sprintf(
+    "# Probability of Significance (ps [%s])\n\n",
+    insight::format_value(attributes(x)$threshold, digits = digits)
+  ), "blue")
   x$Parameter <- as.character(x$Parameter)
   x$ps <- sprintf("%s%%", insight::format_value(x$ps * 100, digits = digits))
   print_data_frame(x, digits = digits)

R/rope.R

@@ -432,5 +432,3 @@ rope.sim <- function(x, range = "default", ci = .89, ci_method = "HDI", paramete
     HDI_area = HDI_area
   )
 }
-
-

R/simulate_data.R

@@ -25,10 +25,13 @@
 #' summary(lm(V2 ~ V1, data = data))
 #'
 #' # Generate multiple variables
-#' cor_matrix <- matrix(c(1.0, 0.2, 0.4,
-#'                        0.2, 1.0, 0.3,
-#'                        0.4, 0.3, 1.0),
-#'                      nrow = 3)
+#' cor_matrix <- matrix(c(
+#'   1.0, 0.2, 0.4,
+#'   0.2, 1.0, 0.3,
+#'   0.4, 0.3, 1.0
+#' ),
+#' nrow = 3
+#' )
 #'
 #' data <- simulate_correlation(r = cor_matrix, names = c("y", "x1", "x2"))
 #' cor(data)
@@ -41,57 +44,57 @@
 #' diff(t.test(data$V1 ~ data$V0)$estimate)
 #' summary(lm(V1 ~ V0, data = data))
 #' summary(glm(V0 ~ V1, data = data, family = "binomial"))
-#'
 #' @export
-simulate_correlation <- function(n = 100, r = 0.5, mean = 0, sd = 1, names = NULL, ...){
-
+simulate_correlation <- function(n = 100, r = 0.5, mean = 0, sd = 1, names = NULL, ...) {
   if (!requireNamespace("MASS", quietly = TRUE)) {
     stop("Package 'MASS' required for this function to work. Please install it by running `install.packages('MASS')`.")
   }
 
   # Define matrix
-  if(is.matrix(r)){
-    if(isSymmetric(r)){
-      if(any(r > 1)){
+  if (is.matrix(r)) {
+    if (isSymmetric(r)) {
+      if (any(r > 1)) {
         stop("'r' should only contain values between -1 and 1.")
-      } else{
+      } else {
         sigma <- r
       }
-    } else{
+    } else {
       stop("'r' should be a symetric matrix (relative to the diagonal).")
     }
-  } else if(length(r) == 1){
-    if(abs(r) > 1){
+  } else if (length(r) == 1) {
+    if (abs(r) > 1) {
       stop("'r' should only contain values between -1 and 1.")
-    } else{
+    } else {
       sigma <- matrix(c(1, r, r, 1), nrow = 2)
     }
-  } else{
+  } else {
     stop("'r' should be a value (e.g., r = 0.5) or a square matrix.")
   }
 
 
   # Get data
-  data <- MASS::mvrnorm(n=n,
-                        mu=rep_len(0, ncol(sigma)),  # Means of variables
-                        Sigma=sigma,
-                        empirical=TRUE)
+  data <- MASS::mvrnorm(
+    n = n,
+    mu = rep_len(0, ncol(sigma)), # Means of variables
+    Sigma = sigma,
+    empirical = TRUE
+  )
 
   # Adjust scale
-  if(any(sd != 1)){
+  if (any(sd != 1)) {
     data <- t(t(data) * rep_len(sd, ncol(sigma)))
   }
 
   # Adjust mean
-  if(any(mean != 0)){
+  if (any(mean != 0)) {
     data <- t(t(data) + rep_len(mean, ncol(sigma)))
   }
 
   data <- as.data.frame(data)
 
   # Rename
-  if(!is.null(names)){
-    if(length(names) == ncol(data)){
+  if (!is.null(names)) {
+    if (length(names) == ncol(data)) {
       names(data) <- names
     }
   }
@@ -102,20 +105,19 @@ simulate_correlation <- function(n = 100, r = 0.5, mean = 0, sd = 1, names = NUL
 
 #' @rdname simulate_correlation
 #' @export
-simulate_ttest <- function(n = 100, d = 0.5, names = NULL, ...){
-  x <- distribution_normal(n, 0, 1)  # Continuous variables
-  z <- 0 + d * x  # Linear combination
-  pr <- 1/( 1 + exp(-z))  # Pass it through an inverse logit function
+simulate_ttest <- function(n = 100, d = 0.5, names = NULL, ...) {
+  x <- distribution_normal(n, 0, 1) # Continuous variables
+  z <- 0 + d * x # Linear combination
+  pr <- 1 / (1 + exp(-z)) # Pass it through an inverse logit function
   y <- distribution_binomial(n, 1, pr, random = 3) # Bernoulli response variable
 
   data <- data.frame(y = as.factor(y), x = x)
-  names(data) <- paste0("V", 0:(ncol(data)-1))
+  names(data) <- paste0("V", 0:(ncol(data) - 1))
 
-  if(!is.null(names)){
-    if(length(names) == ncol(data)){
+  if (!is.null(names)) {
+    if (length(names) == ncol(data)) {
       names(data) <- names
     }
   }
   data
 }
-

tests/testthat/test-bayesfactor_models.R

@@ -37,13 +37,15 @@ test_that("bayesfactor_models RSTANARM", {
   library(rstanarm)
   set.seed(444)
   stan_bf_0 <- stan_glm(Sepal.Length ~ 1,
-                        data = iris,
-                        refresh = 0,
-                        diagnostic_file = file.path(tempdir(), "df0.csv"))
+    data = iris,
+    refresh = 0,
+    diagnostic_file = file.path(tempdir(), "df0.csv")
+  )
   stan_bf_1 <- stan_glm(Sepal.Length ~ Species,
-                        data = iris,
-                        refresh = 0,
-                        diagnostic_file = file.path(tempdir(), "df1.csv"))
+    data = iris,
+    refresh = 0,
+    diagnostic_file = file.path(tempdir(), "df1.csv")
+  )
 
   testthat::expect_warning(bayestestR::bayesfactor_models(stan_bf_0, stan_bf_1))
   stan_models <- suppressWarnings(bayestestR::bayesfactor_models(stan_bf_0, stan_bf_1))

tests/testthat/test-distributions.R

@@ -1,7 +1,6 @@
 context("distributions")
 
 test_that("distributions", {
-
   testthat::expect_equal(mean(bayestestR::distribution_normal(10)), 0, tolerance = 0.01)
   testthat::expect_equal(length(bayestestR::distribution_normal(10, random = TRUE)), 10, tolerance = 0.01)
 
@@ -28,5 +27,4 @@ test_that("distributions", {
 
   testthat::expect_equal(mean(bayestestR::distribution_uniform(10)), 0.5, tolerance = 0.01)
   testthat::expect_equal(length(bayestestR::distribution_uniform(10, random = TRUE)), 10, tolerance = 0.01)
-
 })

tests/testthat/test-overlap.R

@@ -1,7 +1,6 @@
 context("overlap")
 
 test_that("overlap", {
-
   set.seed(333)
   x <- distribution_normal(1000, 2, 0.5)
   y <- distribution_normal(1000, 0, 1)

tests/testthat/test-p_significance.R

@@ -20,5 +20,4 @@ if (require("insight")) {
     0.988,
     tolerance = 1e-3
   )
-
 }

tests/testthat/test-simulate_data.R

@@ -10,14 +10,15 @@ test_that("simulate_correlation", {
   testthat::expect_equal(c(mean(data$V1), sd(data$V1)), c(0, 0.7), tol = 0.001)
   testthat::expect_equal(c(mean(data$V2), sd(data$V2)), c(1, 1.7), tol = 0.001)
 
-  cor_matrix <- matrix(c(1.0, 0.2, 0.4,
-                         0.2, 1.0, 0.3,
-                         0.4, 0.3, 1.0),
-                       nrow = 3)
+  cor_matrix <- matrix(c(
+    1.0, 0.2, 0.4,
+    0.2, 1.0, 0.3,
+    0.4, 0.3, 1.0
+  ),
+  nrow = 3
+  )
 
   data <- simulate_correlation(r = cor_matrix)
 
   testthat::expect_equal(matrix(cor(data), nrow = 3), cor_matrix, tol = 0.001)
 })
-
-