Merge pull request #59 from easystats/dev

dev

Author: DominiqueMakowski

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: correlation
 Type: Package
 Title: Methods for Correlation Analysis
-Version: 0.1.1
+Version: 0.2.0
 Authors@R: c(
 	person("Dominique", 
 		"Makowski", 

R/cor_test.R

@@ -8,7 +8,7 @@
 #' @param method A character string indicating which correlation coefficient is to be used for the test. One of "pearson" (default), "kendall", or "spearman", "biserial", "polychoric", "tetrachoric", "biweight", "distance", "percentage" (for percentage bend correlation) or "shepherd" (for Shepherd's Pi correlation). Setting "auto" will attempt at selecting the most relevant method (polychoric when ordinal factors involved, tetrachoric when dichotomous factors involved, point-biserial if one dichotomous and one continuous and pearson otherwise).
 #' @param bayesian,partial_bayesian If TRUE, will run the correlations under a Bayesian framework. Note that for partial correlations, you will also need to set \code{partial_bayesian} to \code{TRUE} to obtain "full" Bayesian partial correlations. Otherwise, you will obtain pseudo-Bayesian partial correlations (i.e., Bayesian correlation based on frequentist partialization).
 #' @param include_factors If \code{TRUE}, the factors are kept and eventually converted to numeric or used as random effects (depending of \code{multilevel}). If \code{FALSE}, factors are removed upfront.
-#' @param partial Can be TRUE or "semi" for partial and semi-partial correlations, respectively. This only works for Frequentist correlations.
+#' @param partial Can be TRUE or "semi" for partial and semi-partial correlations, respectively.
 #' @inheritParams effectsize::adjust
 #' @param bayesian_prior For the prior argument, several named values are recognized: "medium.narrow", "medium", "wide", and "ultrawide". These correspond to scale values of 1/sqrt(27), 1/3, 1/sqrt(3) and 1, respectively. See the \code{BayesFactor::correlationBF} function.
 #' @param bayesian_ci_method,bayesian_test See arguments in \code{\link[=parameters]{model_parameters}} for \code{BayesFactor} tests.
@@ -71,7 +71,7 @@ cor_test <- function(data, x, y, method = "pearson", ci = 0.95, bayesian = FALSE
 
   # Make sure factor is no factor
   if (!method %in% c("tetra", "tetrachoric", "poly", "polychoric")) {
-    data[c(x, y)] <- parameters::data_to_numeric(data[c(x, y)], dummy_factors=FALSE)
+    data[c(x, y)] <- parameters::data_to_numeric(data[c(x, y)], dummy_factors = FALSE)
   }
 
   # Partial

R/cor_to_pcor.R

@@ -106,8 +106,13 @@ pcor_to_cor.easycorrelation <- function(pcor, tol = .Machine$double.eps^(2 / 3))
     r <- .cor_to_pcor(.get_cor(as.table(cor), cov = NULL))
   }
 
-  p <- cor_to_p(r, n = attributes(cor)$n, method = "pearson")
-  ci_vals <- cor_to_ci(r, n = attributes(cor)$n, ci = attributes(cor)$ci)
+  # Extract info
+  p_adjust <- attributes(cor)$p_adjust
+  nobs <- as.matrix(attributes(as.table(cor))$n_Obs[-1])
+
+  # Get Statistics
+  p <- cor_to_p(r, n = nobs, method = "pearson")
+  ci_vals <- cor_to_ci(r, n = nobs, ci = attributes(cor)$ci)
 
   # Replace
   newdata <- data.frame()
@@ -118,20 +123,27 @@ pcor_to_cor.easycorrelation <- function(pcor, tol = .Machine$double.eps^(2 / 3))
       newdata,
       data.frame(
         r = r[row, col],
-        t = p$statistic[row, col],
-        df = attributes(cor)$n - 2,
-        p = p$p[row, col],
         CI_low = ci_vals$CI_low[row, col],
         CI_high = ci_vals$CI_high[row, col],
-        Method = "Pearson"
+        t = p$statistic[row, col],
+        df = nobs[row, col] - 2,
+        p = p$p[row, col],
+        Method = "Pearson",
+        n_Obs = nobs[row, col]
       )
     )
   }
+
+  # Format
   newdata <- cbind(cor[1:2], newdata)
   cor <- cor[, 1:ncol(newdata)]
   cor[, ] <- newdata
   names(cor) <- names(newdata)
-  attributes(cor)$p_adjust <- "none"
+
+  # P-values adjustments
+  cor$p <- stats::p.adjust(cor$p, method = p_adjust, n = nrow(cor))
+  attributes(cor)$p_adjust <- p_adjust
+
   cor
 }
 
@@ -146,19 +158,25 @@ pcor_to_cor.easycorrelation <- function(pcor, tol = .Machine$double.eps^(2 / 3))
     r <- .cor_to_pcor(.get_cor(cor, cov = NULL))
   }
 
-  p <- cor_to_p(r, n = attributes(cor)$n, method = "pearson")
-  ci_vals <- cor_to_ci(r, n = attributes(cor)$n, ci = attributes(cor)$ci)
+  # Extract info
+  p_adjust <- attributes(cor)$p_adjust
+  nobs <- as.matrix(attributes(cor)$n_Obs[-1])
+
+  p <- cor_to_p(r, n = nobs, method = "pearson")
+  ci_vals <- cor_to_ci(r, n = nobs, ci = attributes(cor)$ci)
   r <- cbind(data.frame(Parameter = row.names(r)), r)
   row.names(r) <- NULL
 
+  # P-values adjustments
+  p$p <- stats::p.adjust(p$p, method = p_adjust, n = nrow(cor) * (ncol(cor) - 1))
+  attributes(cor)$p_adjust <- p_adjust
+
   # Statistic and p-value
   attributes(cor)$pd <- attributes(cor)$BF <- NULL
   attributes(cor)$p[-1] <- p$p
   attributes(cor)$t[-1] <- p$statistic
   attributes(cor)$CI_low[-1] <- ci_vals$CI_low
   attributes(cor)$CI_high[-1] <- ci_vals$CI_high
-  attributes(cor)$p_adjust <- "none"
-
 
   attributes(r) <- attributes(cor)
   r

R/correlation.R

@@ -22,7 +22,7 @@
 #' \item \strong{Polychoric correlation}: Correlation between two theorised normally distributed continuous latent variables, from two observed ordinal variables.
 #' \item \strong{Tetrachoric correlation}: Special case of the polychoric correlation applicable when both observed variables are dichotomous.
 #'
-#' \item \strong{Partial correlation}: orrelation between two variables after adjusting for the (linear) the effect of one or more variable.
+#' \item \strong{Partial correlation}: Correlation between two variables after adjusting for the (linear) the effect of one or more variable. The correlation test is here run after having partialized the dataset, independently from it. In other words, it considers partialization as an independent step generating a different dataset, rather than belonging to the same model. This is why small discrepancies are to be expected for the t- and the p-values (but not the correlation coefficient) compared to other implementations such as \code{ppcor}.
 #'
 #' \item \strong{Multilevel correlation}: Multilevel correlations are a special case of partial correlations where the variable to be adjusted for is a factor and is included as a random effect in a mixed model.
 #'
@@ -36,18 +36,24 @@
 #' }
 #'
 #' @examples
-#' library(dplyr)
+#' library(correlation)
+#'
 #' cor <- correlation(iris)
 #'
 #' cor
 #' summary(cor)
 #' as.table(cor)
 #'
-#' iris %>%
-#'   group_by(Species) %>%
-#'   correlation()
+#' # Grouped dataframe
+#' if (require("dplyr")) {
+#'   library(dplyr)
+#'
+#'   iris %>%
+#'     group_by(Species) %>%
+#'     correlation()
 #'
-#' correlation(mtcars[-2], method = "auto")
+#'   correlation(mtcars[-2], method = "auto")
+#' }
 #' @importFrom stats p.adjust
 #' @export
 correlation <- function(data, data2 = NULL, method = "pearson", p_adjust = "holm", ci = 0.95, bayesian = FALSE, bayesian_prior = "medium", bayesian_ci_method = "hdi", bayesian_test = c("pd", "rope", "bf"), redundant = FALSE, include_factors = FALSE, partial = FALSE, partial_bayesian = FALSE, multilevel = FALSE, robust = FALSE, ...) {
@@ -95,7 +101,7 @@ correlation <- function(data, data2 = NULL, method = "pearson", p_adjust = "holm
 
   class(out) <- unique(c("easycorrelation", "see_easycorrelation", "parameters_model", class(out)))
 
-  if (convert_back_to_r) out <- pcor_to_cor(out) # Revert back to r if needed.
+  if (convert_back_to_r) out <- pcor_to_cor(pcor = out) # Revert back to r if needed.
   out
 }
 

R/mahalanobis.R

@@ -13,7 +13,8 @@
 #' @return Description of the Mahalanobis distance.
 #'
 #' @examples
-#' distance_mahalanobis(data = iris[, 1:4])
+#' distance_mahalanobis(iris[, 1:4])
+#' distance_mahalanobis(iris[, 1:4], robust = FALSE)
 #' @export
 distance_mahalanobis <- function(data, ci = 0.95, iterations = 1000, robust = TRUE, ...) {
   if (robust) {
@@ -30,6 +31,7 @@ distance_mahalanobis <- function(data, ci = 0.95, iterations = 1000, robust = TR
     # Get summary
     d <- bayestestR::describe_posterior(as.data.frame(Ms), centrality = "median", ci = ci, test = "pd")
     d <- d[c("Median", "CI_low", "CI_high")]
+    rownames(d) <- NULL
     names(d) <- c("Distance", "CI_low", "CI_high")
   } else {
     d <- stats::mahalanobis(data, center = colMeans(data), cov = stats::cov(data))

R/methods.easycorrelation.R

@@ -1,5 +1,5 @@
 #' @export
-summary.easycorrelation <- function(object, redundant = FALSE, ...) {
+summary.easycorrelation <- function(object, redundant = FALSE, stars = TRUE, ...) {
 
   # If data2 is present
   if (!is.null(attributes(object)$data2)) {
@@ -28,6 +28,7 @@ summary.easycorrelation <- function(object, redundant = FALSE, ...) {
 
   # Transfer attributes
   attributes(out) <- c(attributes(out), attributes(object)[!names(attributes(object)) %in% c("names", "row.names", "class", names(attributes(out)))])
+  attr(out, "stars") <- stars
   class(out) <- c("easycormatrix", "see_easycormatrix", class(out))
   out
 }

R/print.easycormatrix.R

@@ -2,8 +2,14 @@
 print.easycormatrix <- function(x, digits = 2, stars = TRUE, ...) {
   nums <- sapply(as.data.frame(x), is.numeric)
 
-  # Significance
+  # Find attributes
   p <- attributes(x)
+
+  if ("stars" %in% names(p)) {
+    stars <- p$stars
+  }
+
+  # Significance
   type <- names(p)[names(p) %in% c("BF", "pd", "p")][1]
   p <- p[[type]]