Merge pull request #317 from easystats/use_new_args_funs

Rename arguments, replace functions

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: correlation
 Title: Methods for Correlation Analysis
-Version: 0.8.4.2
+Version: 0.8.4.3
 Authors@R: 
     c(person(given = "Dominique",
              family = "Makowski",
@@ -95,4 +95,4 @@ Config/Needs/website:
     rstudio/bslib,
     r-lib/pkgdown,
     easystats/easystatstemplate
-Remotes: easystats/insight
+Remotes: easystats/insight, easystats/datawizard, easystats/parameters, easystats/bayestestR

R/cor_sort.R

@@ -26,9 +26,9 @@ cor_sort <- function(x, distance = "correlation", hclust_method = "complete", ..
 
 #' @export
 cor_sort.easycorrelation <- function(x, distance = "correlation", hclust_method = "complete", ...) {
-  order <- .cor_sort_order(as.matrix(x), distance = distance, hclust_method = hclust_method, ...)
-  x$Parameter1 <- factor(x$Parameter1, levels = order)
-  x$Parameter2 <- factor(x$Parameter2, levels = order)
+  col_order <- .cor_sort_order(as.matrix(x), distance = distance, hclust_method = hclust_method, ...)
+  x$Parameter1 <- factor(x$Parameter1, levels = col_order)
+  x$Parameter2 <- factor(x$Parameter2, levels = col_order)
   reordered <- x[order(x$Parameter1, x$Parameter2), ]
 
   # Restore class and attributes
@@ -55,11 +55,11 @@ cor_sort.easycormatrix <- function(x, distance = "correlation", hclust_method =
   m <- x
   row.names(m) <- x$Parameter
   m <- as.matrix(m[names(m)[names(m) != "Parameter"]])
-  order <- .cor_sort_order(m, distance = distance, hclust_method = hclust_method, ...)
+  col_order <- .cor_sort_order(m, distance = distance, hclust_method = hclust_method, ...)
 
   # Reorder
-  x$Parameter <- factor(x$Parameter, levels = order)
-  reordered <- x[order(x$Parameter), c("Parameter", order)]
+  x$Parameter <- factor(x$Parameter, levels = col_order)
+  reordered <- x[order(x$Parameter), c("Parameter", col_order)]
 
   # Restore class and attributes
   attributes(reordered) <- utils::modifyList(
@@ -76,8 +76,8 @@ cor_sort.easycormatrix <- function(x, distance = "correlation", hclust_method =
 
 #' @export
 cor_sort.matrix <- function(x, distance = "correlation", hclust_method = "complete", ...) {
-  order <- .cor_sort_order(x, distance = distance, hclust_method = hclust_method, ...)
-  reordered <- x[order, order]
+  col_order <- .cor_sort_order(x, distance = distance, hclust_method = hclust_method, ...)
+  reordered <- x[col_order, col_order]
 
   # Restore class and attributes
   attributes(reordered) <- utils::modifyList(

R/cor_test.R

@@ -112,8 +112,12 @@
 #'
 #' # Partial
 #' cor_test(iris, "Sepal.Length", "Sepal.Width", partial = TRUE)
-#' cor_test(iris, "Sepal.Length", "Sepal.Width", multilevel = TRUE)
-#' cor_test(iris, "Sepal.Length", "Sepal.Width", partial_bayesian = TRUE)
+#' if (require("lme4", quietly = TRUE)) {
+#'   cor_test(iris, "Sepal.Length", "Sepal.Width", multilevel = TRUE)
+#' }
+#' if (require("rstanarm", quietly = TRUE)) {
+#'   cor_test(iris, "Sepal.Length", "Sepal.Width", partial_bayesian = TRUE)
+#' }
 #' }
 #' @export
 cor_test <- function(data,
@@ -234,40 +238,38 @@ cor_test <- function(data,
     }
 
     # Bayesian
+  } else if (method %in% c("tetra", "tetrachoric")) {
+    insight::format_error("Tetrachoric Bayesian correlations are not supported yet. Get in touch if you want to contribute.")
+  } else if (method %in% c("poly", "polychoric")) {
+    insight::format_error("Polychoric Bayesian correlations are not supported yet. Get in touch if you want to contribute.")
+  } else if (method %in% c("biserial", "pointbiserial", "point-biserial")) {
+    insight::format_error("Biserial Bayesian correlations are not supported yet. Get in touch if you want to contribute.")
+  } else if (method == "biweight") {
+    insight::format_error("Biweight Bayesian correlations are not supported yet. Get in touch if you want to contribute.")
+  } else if (method == "distance") {
+    insight::format_error("Bayesian distance correlations are not supported yet. Get in touch if you want to contribute.")
+  } else if (method %in% c("percentage", "percentage_bend", "percentagebend", "pb")) {
+    insight::format_error("Bayesian Percentage Bend correlations are not supported yet. Get in touch if you want to contribute.")
+  } else if (method %in% c("blomqvist", "median", "medial")) {
+    insight::format_error("Bayesian Blomqvist correlations are not supported yet. Check-out the BBcor package (https://github.com/donaldRwilliams/BBcor).")
+  } else if (method == "hoeffding") {
+    insight::format_error("Bayesian Hoeffding's correlations are not supported yet. Check-out the BBcor package (https://github.com/donaldRwilliams/BBcor).")
+  } else if (method == "gamma") {
+    insight::format_error("Bayesian gamma correlations are not supported yet. Get in touch if you want to contribute.")
+  } else if (method %in% c("shepherd", "sheperd", "shepherdspi", "pi")) {
+    out <- .cor_test_shepherd(data, x, y, ci = ci, bayesian = TRUE, ...)
   } else {
-    if (method %in% c("tetra", "tetrachoric")) {
-      insight::format_error("Tetrachoric Bayesian correlations are not supported yet. Get in touch if you want to contribute.")
-    } else if (method %in% c("poly", "polychoric")) {
-      insight::format_error("Polychoric Bayesian correlations are not supported yet. Get in touch if you want to contribute.")
-    } else if (method %in% c("biserial", "pointbiserial", "point-biserial")) {
-      insight::format_error("Biserial Bayesian correlations are not supported yet. Get in touch if you want to contribute.")
-    } else if (method == "biweight") {
-      insight::format_error("Biweight Bayesian correlations are not supported yet. Get in touch if you want to contribute.")
-    } else if (method == "distance") {
-      insight::format_error("Bayesian distance correlations are not supported yet. Get in touch if you want to contribute.")
-    } else if (method %in% c("percentage", "percentage_bend", "percentagebend", "pb")) {
-      insight::format_error("Bayesian Percentage Bend correlations are not supported yet. Get in touch if you want to contribute.")
-    } else if (method %in% c("blomqvist", "median", "medial")) {
-      insight::format_error("Bayesian Blomqvist correlations are not supported yet. Check-out the BBcor package (https://github.com/donaldRwilliams/BBcor).")
-    } else if (method == "hoeffding") {
-      insight::format_error("Bayesian Hoeffding's correlations are not supported yet. Check-out the BBcor package (https://github.com/donaldRwilliams/BBcor).")
-    } else if (method == "gamma") {
-      insight::format_error("Bayesian gamma correlations are not supported yet. Get in touch if you want to contribute.")
-    } else if (method %in% c("shepherd", "sheperd", "shepherdspi", "pi")) {
-      out <- .cor_test_shepherd(data, x, y, ci = ci, bayesian = TRUE, ...)
-    } else {
-      out <- .cor_test_bayes(
-        data,
-        x,
-        y,
-        ci = ci,
-        method = method,
-        bayesian_prior = bayesian_prior,
-        bayesian_ci_method = bayesian_ci_method,
-        bayesian_test = bayesian_test,
-        ...
-      )
-    }
+    out <- .cor_test_bayes(
+      data,
+      x,
+      y,
+      ci = ci,
+      method = method,
+      bayesian_prior = bayesian_prior,
+      bayesian_ci_method = bayesian_ci_method,
+      bayesian_test = bayesian_test,
+      ...
+    )
   }
 
   # Replace by NANs if invalid
@@ -284,8 +286,11 @@ cor_test <- function(data,
 
   # Reorder columns
   if ("CI_low" %in% names(out)) {
-    order <- c("Parameter1", "Parameter2", "r", "rho", "tau", "Dxy", "CI", "CI_low", "CI_high")
-    out <- out[c(order[order %in% names(out)], setdiff(colnames(out), order[order %in% names(out)]))]
+    col_order <- c("Parameter1", "Parameter2", "r", "rho", "tau", "Dxy", "CI", "CI_low", "CI_high")
+    out <- out[c(
+      col_order[col_order %in% names(out)],
+      setdiff(colnames(out), col_order[col_order %in% names(out)])
+    )]
   }
 
   # Output

R/cor_test_bayes.R

@@ -17,7 +17,7 @@
     var_x <- datawizard::ranktransform(var_x, sign = TRUE, method = "average")
     var_y <- datawizard::ranktransform(var_y, sign = TRUE, method = "average")
     method <- "Bayesian Spearman"
-  } else if (tolower(method) %in% "gaussian") {
+  } else if (tolower(method) == "gaussian") {
     var_x <- stats::qnorm(rank(var_x) / (length(var_x) + 1))
     var_y <- stats::qnorm(rank(var_y) / (length(var_y) + 1))
     method <- "Bayesian Gaussian rank"

R/cor_test_biserial.R

@@ -56,11 +56,11 @@
 
   m1 <- mean(var_x[var_y == 1])
   m0 <- mean(var_x[var_y == 0])
-  q <- mean(var_y)
-  p <- 1 - q
-  zp <- stats::dnorm(stats::qnorm(q))
+  quan <- mean(var_y)
+  p <- 1 - quan
+  zp <- stats::dnorm(stats::qnorm(quan))
 
-  r <- (((m1 - m0) * (p * q / zp)) / stats::sd(var_x))
+  r <- (((m1 - m0) * (p * quan / zp)) / stats::sd(var_x))
 
   p <- cor_to_p(r, n = length(var_x))
   ci_vals <- cor_to_ci(r, n = length(var_x), ci = ci)

R/cor_test_distance.R

@@ -3,21 +3,7 @@
   var_x <- .complete_variable_x(data, x, y)
   var_y <- .complete_variable_y(data, x, y)
 
-  if (!corrected) {
-    rez <- .cor_test_distance_raw(var_x, var_y, index = 1)
-    rez <- data.frame(
-      Parameter1 = x,
-      Parameter2 = y,
-      r = rez$r,
-      CI_low = NA,
-      CI_high = NA,
-      t = NA,
-      df_error = NA,
-      p = NA,
-      Method = "Distance",
-      stringsAsFactors = FALSE
-    )
-  } else {
+  if (corrected) {
     rez <- .cor_test_distance_corrected(var_x, var_y, ci = ci)
     rez <- data.frame(
       Parameter1 = x,
@@ -31,6 +17,20 @@
       Method = "Distance (Bias Corrected)",
       stringsAsFactors = FALSE
     )
+  } else {
+    rez <- .cor_test_distance_raw(var_x, var_y, index = 1)
+    rez <- data.frame(
+      Parameter1 = x,
+      Parameter2 = y,
+      r = rez$r,
+      CI_low = NA,
+      CI_high = NA,
+      t = NA,
+      df_error = NA,
+      p = NA,
+      Method = "Distance",
+      stringsAsFactors = FALSE
+    )
   }
 
   rez
@@ -60,14 +60,14 @@
   M <- n * (n - 3) / 2
   dof <- M - 1
 
-  t <- sqrt(M - 1) * r / sqrt(1 - r^2)
-  p <- 1 - stats::pt(t, df = dof)
+  tstat <- sqrt(M - 1) * r / sqrt(1 - r^2)
+  p <- 1 - stats::pt(tstat, df = dof)
 
   ci_vals <- cor_to_ci(r, n = n, ci = ci)
 
   list(
     r = r,
-    t = t,
+    t = tstat,
     df_error = dof,
     p = p,
     CI_low = ci_vals$CI_low,
@@ -91,16 +91,16 @@
   A <- .A_kl(x, index)
   B <- .A_kl(y, index)
 
-  cov <- sqrt(mean(A * B))
+  cov_ab <- sqrt(mean(A * B))
   dVarX <- sqrt(mean(A * A))
   dVarY <- sqrt(mean(B * B))
   V <- sqrt(dVarX * dVarY)
   if (V > 0) {
-    r <- cov / V
+    r <- cov_ab / V
   } else {
     r <- 0
   }
-  list(r = r, cov = cov)
+  list(r = r, cov = cov_ab)
 }
 
 

R/cor_test_freq.R

@@ -42,10 +42,10 @@
 
 
 .extract_corr_parameters <- function(model) {
-  names <- unlist(strsplit(model$data.name, " and ", fixed = TRUE))
+  data_names <- unlist(strsplit(model$data.name, " and ", fixed = TRUE))
   out <- data.frame(
-    "Parameter1" = names[1],
-    "Parameter2" = names[2],
+    Parameter1 = data_names[1],
+    Parameter2 = data_names[2],
     stringsAsFactors = FALSE
   )
 

R/cor_text.R

@@ -20,28 +20,28 @@ cor_text <- function(x, show_ci = TRUE, show_statistic = TRUE, show_sig = TRUE,
   # Estimate
   candidates <- c("rho", "r", "tau", "Difference", "r_rank_biserial")
   estimate <- candidates[candidates %in% names(x)][1]
-  text <- paste0(tolower(estimate), " = ", insight::format_value(x[[estimate]]))
+  out_text <- paste0(tolower(estimate), " = ", insight::format_value(x[[estimate]]))
 
   # CI
   if (show_ci && all(c("CI_high", "CI_low") %in% names(x))) {
     if (!is.null(attributes(x$conf.int)$conf.level)) {
       # htest
-      text <- paste0(
-        text,
+      out_text <- paste0(
+        out_text,
         ", ",
         insight::format_ci(x$CI_low, x$CI_high, ci = attributes(x$conf.int)$conf.level)
       )
     } else if ("CI" %in% names(x)) {
       # param
-      text <- paste0(
-        text,
+      out_text <- paste0(
+        out_text,
         ", ",
         insight::format_ci(x$CI_low, x$CI_high, ci = x$CI)
       )
     } else if ("ci" %in% names(attributes(x))) {
       # param
-      text <- paste0(
-        text,
+      out_text <- paste0(
+        out_text,
         ", ",
         insight::format_ci(x$CI_low, x$CI_high, ci = attributes(x)$ci)
       )
@@ -51,36 +51,36 @@ cor_text <- function(x, show_ci = TRUE, show_statistic = TRUE, show_sig = TRUE,
   # Statistic
   if (show_statistic) {
     if ("t" %in% names(x)) {
-      text <- paste0(
-        text,
+      out_text <- paste0(
+        out_text,
         ", t(",
         insight::format_value(x$df, protect_integers = TRUE),
         ") = ",
         insight::format_value(x$t)
       )
     } else if ("S" %in% names(x)) {
-      text <- paste0(text, ", S = ", insight::format_value(x$S))
+      out_text <- paste0(out_text, ", S = ", insight::format_value(x$S))
     } else if ("z" %in% names(x)) {
-      text <- paste0(text, ", z = ", insight::format_value(table$z))
+      out_text <- paste0(out_text, ", z = ", insight::format_value(table$z))
     } else if ("W" %in% names(x)) {
-      text <- paste0("W = ", insight::format_value(x$W))
+      out_text <- paste0("W = ", insight::format_value(x$W))
     } else if ("Chi2" %in% names(x)) {
-      text <- paste0(text, ", Chi2 = ", insight::format_value(x$Chi2))
+      out_text <- paste0(out_text, ", Chi2 = ", insight::format_value(x$Chi2))
     }
   }
 
   # Significance
   if (show_sig) {
     if ("p" %in% names(x)) {
-      text <- paste0(text, ", ", insight::format_p(x$p, digits = "apa", ...))
+      out_text <- paste0(out_text, ", ", insight::format_p(x$p, digits = "apa", ...))
     } else if ("BF" %in% names(x)) {
       exact <- match.call()[["exact"]]
       if (is.null(exact)) exact <- TRUE
-      text <- paste0(text, ", ", insight::format_bf(x$BF, exact = exact, ...))
+      out_text <- paste0(out_text, ", ", insight::format_bf(x$BF, exact = exact, ...))
     } else if ("pd" %in% names(x)) {
-      text <- paste0(text, ", ", insight::format_pd(x$pd, ...))
+      out_text <- paste0(out_text, ", ", insight::format_pd(x$pd, ...))
     }
   }
 
-  text
+  out_text
 }

R/cor_to_cov.R

@@ -43,8 +43,8 @@ cor_to_cov <- function(cor, sd = NULL, variance = NULL, tol = .Machine$double.ep
     is_symmetric <- FALSE
   }
   p <- dim(cor)[1]
-  q <- p * (p - 1) / 2
-  if (isTRUE(all.equal(cor[lower.tri(cor)], rep(0, q))) || isTRUE(all.equal(cor[upper.tri(cor)], rep(0, q)))) {
+  quan <- p * (p - 1) / 2
+  if (isTRUE(all.equal(cor[lower.tri(cor)], rep(0, quan))) || isTRUE(all.equal(cor[upper.tri(cor)], rep(0, quan)))) {
     is_triangular <- TRUE
   } else {
     is_triangular <- FALSE
@@ -53,7 +53,7 @@ cor_to_cov <- function(cor, sd = NULL, variance = NULL, tol = .Machine$double.ep
     insight::format_error("'cor' should be either a symmetric or a triangular matrix")
   }
 
-  cov <- diag(sd) %*% cor %*% diag(sd)
-  colnames(cov) <- rownames(cov) <- colnames(cor)
-  cov
+  cov_matrix <- diag(sd) %*% cor %*% diag(sd)
+  colnames(cov_matrix) <- rownames(cov_matrix) <- colnames(cor)
+  cov_matrix
 }