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
 }