├── .github ├── .gitignore ├── FUNDING.yml ├── dependabot.yaml ├── workflows │ ├── revdepcheck.yaml │ ├── check-styling.yaml │ ├── check-link-rot.yaml │ ├── check-spelling.yaml │ ├── pkgdown-no-suggests.yaml │ ├── update-to-latest-easystats.yaml │ ├── check-random-test-order.yaml │ ├── check-test-warnings.yaml │ ├── check-vignette-warnings.yaml │ ├── lint.yaml │ ├── lint-changed-files.yaml │ ├── html-5-check.yaml │ ├── test-coverage.yaml │ ├── check-readme.yaml │ ├── test-coverage-examples.yaml │ ├── pkgdown.yaml │ ├── R-CMD-check.yaml │ ├── check-all-examples.yaml │ └── R-CMD-check-hard.yaml ├── SUPPORT.md ├── CONTRIBUTING.md └── CODE_OF_CONDUCT.md ├── revdep ├── failures.md ├── cran.md ├── README.md └── problems.md ├── cran-comments.md ├── LICENSE ├── WIP ├── diagram.pptx ├── utils_reorder_matrix.R ├── spcor_to_cor.R └── utils_bootstrapping.R ├── paper ├── figure1.png ├── figure2.png ├── figure3.png ├── make_figures.R └── paper.bib ├── man ├── figures │ ├── logo.png │ ├── README-12-1.png │ ├── README-7-1.png │ └── README-corr-1.png ├── isSquare.Rd ├── correlation-deprecated.Rd ├── is.cor.Rd ├── matrix_inverse.Rd ├── cor_text.Rd ├── z_fisher.Rd ├── reexports.Rd ├── cor_to_cov.Rd ├── cor_lower.Rd ├── cor_sort.Rd ├── cor_smooth.Rd ├── correlation-package.Rd ├── cormatrix_to_excel.Rd ├── cor_to_pcor.Rd ├── display.easycormatrix.Rd ├── cor_to_p.Rd └── visualisation_recipe.easycormatrix.Rd ├── tests ├── testthat.R └── testthat │ ├── test-cor_to_cov.R │ ├── test-cor_to_p.R │ ├── helper.R │ ├── test-renaming.R │ ├── test-grouped_data2.R │ ├── test-methods.R │ ├── test-display_print_dataframe.R │ ├── _snaps │ ├── windows │ │ └── correlation.md │ ├── cormatrix_to_excel.md │ ├── renaming.md │ ├── display_print_matrix.md │ ├── display_print_dataframe.md │ ├── selecting_variables.md │ ├── methods.md │ └── correlation.md │ ├── test-as_list.R │ ├── test-cormatrix_to_excel.R │ ├── test-selecting_variables.R │ ├── test-misc.R │ ├── test-display_print_matrix.R │ ├── test-cor_multilevel.R │ ├── test-cor_to_pcor.R │ ├── test-cor_sort.R │ └── test-cor_test_na_present.R ├── pkgdown └── favicon │ ├── favicon.ico │ ├── favicon-96x96.png │ ├── apple-touch-icon.png │ ├── web-app-manifest-192x192.png │ ├── web-app-manifest-512x512.png │ └── site.webmanifest ├── _pkgdown.yml ├── R ├── zzz_deprecated.R ├── methods_plot.R ├── utils_clean_data.R ├── cor_test_gaussian.R ├── reexports.R ├── cor_test_somers.R ├── utils_get_matrix.R ├── correlation-package.R ├── cor_test_hoeffding.R ├── cor_to_spcor.R ├── utils.R ├── cor_test_blomqvist.R ├── cor_test_gamma.R ├── z_fisher.R ├── cor_test_tetrachoric.R ├── cor_test_shepherd.R ├── visualisation_recipe.easycorrelation.R ├── cor_test_biweight.R ├── utils_get_combinations.R ├── utils_find_correlationtype.R ├── cor_test_percentage.R ├── matrix_inverse.R ├── cor_test_polychoric.R ├── cor_lower.R ├── utils_remove_redundant.R ├── cor_to_p.R ├── cor_to_cov.R ├── utils_create_diagonal.R ├── cor_test_biserial.R ├── cor_test_freq.R ├── cor_to_ci.R ├── display.R ├── cor_text.R ├── cor_test_distance.R ├── cor_test_bayes.R ├── cor_smooth.R ├── methods_print.R ├── visualisation_recipe.cor_test.R └── cor_sort.R ├── correlation.code-workspace ├── correlation.Rproj ├── .lintr ├── .Rbuildignore ├── LICENSE.md ├── inst ├── WORDLIST └── CITATION ├── .gitignore ├── NAMESPACE ├── DESCRIPTION ├── vignettes ├── multilevel.Rmd └── bibliography.bib └── NEWS.md /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /revdep/failures.md: -------------------------------------------------------------------------------- 1 | *Wow, no problems at all. :)* -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | This update fixes CRAN test failures. -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2023 2 | COPYRIGHT HOLDER: correlation authors 3 | -------------------------------------------------------------------------------- /WIP/diagram.pptx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/correlation/HEAD/WIP/diagram.pptx -------------------------------------------------------------------------------- /paper/figure1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/correlation/HEAD/paper/figure1.png -------------------------------------------------------------------------------- /paper/figure2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/correlation/HEAD/paper/figure2.png -------------------------------------------------------------------------------- /paper/figure3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/correlation/HEAD/paper/figure3.png -------------------------------------------------------------------------------- /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | # These are supported funding model platforms 2 | 3 | github: easystats 4 | -------------------------------------------------------------------------------- /man/figures/logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/correlation/HEAD/man/figures/logo.png -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(correlation) 3 | 4 | test_check("correlation") 5 | -------------------------------------------------------------------------------- /man/figures/README-12-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/correlation/HEAD/man/figures/README-12-1.png -------------------------------------------------------------------------------- /man/figures/README-7-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/correlation/HEAD/man/figures/README-7-1.png -------------------------------------------------------------------------------- /pkgdown/favicon/favicon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/correlation/HEAD/pkgdown/favicon/favicon.ico -------------------------------------------------------------------------------- /man/figures/README-corr-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/correlation/HEAD/man/figures/README-corr-1.png -------------------------------------------------------------------------------- /pkgdown/favicon/favicon-96x96.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/correlation/HEAD/pkgdown/favicon/favicon-96x96.png -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | url: https://easystats.github.io/correlation/ 2 | 3 | template: 4 | bootstrap: 5 5 | package: easystatstemplate 6 | -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/correlation/HEAD/pkgdown/favicon/apple-touch-icon.png -------------------------------------------------------------------------------- /pkgdown/favicon/web-app-manifest-192x192.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/correlation/HEAD/pkgdown/favicon/web-app-manifest-192x192.png -------------------------------------------------------------------------------- /pkgdown/favicon/web-app-manifest-512x512.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/easystats/correlation/HEAD/pkgdown/favicon/web-app-manifest-512x512.png -------------------------------------------------------------------------------- /.github/dependabot.yaml: -------------------------------------------------------------------------------- 1 | version: 2 2 | 3 | updates: 4 | # Keep dependencies for GitHub Actions up-to-date 5 | - package-ecosystem: "github-actions" 6 | directory: "/" 7 | schedule: 8 | interval: "weekly" 9 | -------------------------------------------------------------------------------- /.github/workflows/revdepcheck.yaml: -------------------------------------------------------------------------------- 1 | on: 2 | pull_request: 3 | branches: [main, master] 4 | 5 | name: revdepcheck 6 | 7 | jobs: 8 | revdepcheck: 9 | uses: easystats/workflows/.github/workflows/revdepcheck.yaml@main 10 | -------------------------------------------------------------------------------- /tests/testthat/test-cor_to_cov.R: -------------------------------------------------------------------------------- 1 | test_that("cor_to_cov", { 2 | cor <- cor(iris[1:4]) 3 | expect_error(cor_to_cov(cor)) 4 | 5 | expect_error(cor_to_cov(as.matrix(rnorm(5)))) 6 | 7 | expect_error(cor_to_cov(cor, sd = sapply(iris[1:3], sd))) 8 | }) 9 | -------------------------------------------------------------------------------- /tests/testthat/test-cor_to_p.R: -------------------------------------------------------------------------------- 1 | test_that("cor_to_p", { 2 | expect_message(df <- cor_to_p(-0.1175698, n = 150, method = "kendall")) 3 | expect_equal( 4 | df, 5 | list(p = 0.0327638207025712, statistic = -2.1349655930582), 6 | tolerance = 0.001 7 | ) 8 | }) 9 | -------------------------------------------------------------------------------- /R/zzz_deprecated.R: -------------------------------------------------------------------------------- 1 | #' Deprecated functions 2 | #' 3 | #' @param ... Args. 4 | #' 5 | #' @name correlation-deprecated 6 | #' 7 | #' @export 8 | distance_mahalanobis <- function(...) { 9 | .Defunct('performance::check_outliers(method = "mahalanobis_robust")') 10 | } 11 | -------------------------------------------------------------------------------- /.github/workflows/check-styling.yaml: -------------------------------------------------------------------------------- 1 | on: 2 | push: 3 | branches: [main, master] 4 | pull_request: 5 | branches: [main, master] 6 | 7 | name: check-styling 8 | 9 | jobs: 10 | check-styling: 11 | uses: easystats/workflows/.github/workflows/check-styling.yaml@main 12 | -------------------------------------------------------------------------------- /.github/workflows/check-link-rot.yaml: -------------------------------------------------------------------------------- 1 | on: 2 | push: 3 | branches: [main, master] 4 | pull_request: 5 | branches: [main, master] 6 | 7 | name: check-link-rot 8 | 9 | jobs: 10 | check-link-rot: 11 | uses: easystats/workflows/.github/workflows/check-link-rot.yaml@main 12 | -------------------------------------------------------------------------------- /.github/workflows/check-spelling.yaml: -------------------------------------------------------------------------------- 1 | on: 2 | push: 3 | branches: [main, master] 4 | pull_request: 5 | branches: [main, master] 6 | 7 | name: check-spelling 8 | 9 | jobs: 10 | check-spelling: 11 | uses: easystats/workflows/.github/workflows/check-spelling.yaml@main 12 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown-no-suggests.yaml: -------------------------------------------------------------------------------- 1 | on: 2 | push: 3 | branches: [main, master] 4 | pull_request: 5 | branches: [main, master] 6 | 7 | name: pkgdown-no-suggests 8 | 9 | jobs: 10 | pkgdown-no-suggests: 11 | uses: easystats/workflows/.github/workflows/pkgdown-no-suggests.yaml@main 12 | -------------------------------------------------------------------------------- /.github/workflows/update-to-latest-easystats.yaml: -------------------------------------------------------------------------------- 1 | on: 2 | schedule: 3 | # Check for dependency updates once a month 4 | - cron: "0 0 1 * *" 5 | 6 | name: update-to-latest-easystats 7 | 8 | jobs: 9 | update-to-latest-easystats: 10 | uses: easystats/workflows/.github/workflows/update-to-latest-easystats.yaml@main 11 | -------------------------------------------------------------------------------- /R/methods_plot.R: -------------------------------------------------------------------------------- 1 | #' @export 2 | plot.easycorrelation <- function(x, ...) { 3 | insight::check_if_installed("see", "to plot correlation graphs") 4 | 5 | plot(visualisation_recipe(x, ...), ...) 6 | } 7 | 8 | #' @export 9 | plot.easycormatrix <- plot.easycorrelation 10 | 11 | #' @export 12 | plot.easycor_test <- plot.easycorrelation 13 | -------------------------------------------------------------------------------- /.github/workflows/check-random-test-order.yaml: -------------------------------------------------------------------------------- 1 | # Run tests in random order 2 | on: 3 | push: 4 | branches: [main, master] 5 | pull_request: 6 | branches: [main, master] 7 | 8 | name: check-random-test-order 9 | 10 | jobs: 11 | check-random-test-order: 12 | uses: easystats/workflows/.github/workflows/check-random-test-order.yaml@main 13 | -------------------------------------------------------------------------------- /R/utils_clean_data.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | .clean_data <- function(data, include_factors = TRUE, multilevel = FALSE) { 3 | if (!multilevel) { 4 | if (include_factors) { 5 | data <- datawizard::to_numeric(data, dummy_factors = TRUE) 6 | } else { 7 | data <- data[sapply(data, is.numeric)] 8 | } 9 | } 10 | data 11 | } 12 | -------------------------------------------------------------------------------- /tests/testthat/helper.R: -------------------------------------------------------------------------------- 1 | skip_if_not_or_load_if_installed <- function(package, minimum_version = NULL) { 2 | testthat::skip_if_not_installed(package, minimum_version = minimum_version) 3 | suppressMessages(suppressWarnings(suppressPackageStartupMessages( 4 | require(package, warn.conflicts = FALSE, character.only = TRUE, quietly = TRUE) 5 | ))) 6 | } 7 | -------------------------------------------------------------------------------- /.github/workflows/check-test-warnings.yaml: -------------------------------------------------------------------------------- 1 | # Running tests with options(warn = 2) to fail on test warnings 2 | on: 3 | push: 4 | branches: [main, master] 5 | pull_request: 6 | branches: [main, master] 7 | 8 | name: check-test-warnings 9 | 10 | jobs: 11 | check-test-warnings: 12 | uses: easystats/workflows/.github/workflows/check-test-warnings.yaml@main 13 | -------------------------------------------------------------------------------- /correlation.code-workspace: -------------------------------------------------------------------------------- 1 | { 2 | "folders": [ 3 | { 4 | "path": "." 5 | } 6 | ], 7 | "launch": { 8 | "version": "0.2.0", 9 | "configurations": [ 10 | { 11 | "type": "R-Debugger", 12 | "name": "Launch R-Workspace", 13 | "request": "launch", 14 | "debugMode": "workspace", 15 | "workingDirectory": "" 16 | } 17 | ] 18 | } 19 | } -------------------------------------------------------------------------------- /.github/workflows/check-vignette-warnings.yaml: -------------------------------------------------------------------------------- 1 | # Running tests with options(warn = 2) to fail on test warnings 2 | on: 3 | push: 4 | branches: [main, master] 5 | pull_request: 6 | branches: [main, master] 7 | 8 | name: check-vignette-warnings 9 | 10 | jobs: 11 | check-vignette-warnings: 12 | uses: easystats/workflows/.github/workflows/check-vignette-warnings.yaml@main 13 | -------------------------------------------------------------------------------- /man/isSquare.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{isSquare} 4 | \alias{isSquare} 5 | \title{Check if Square Matrix} 6 | \usage{ 7 | isSquare(m) 8 | } 9 | \arguments{ 10 | \item{m}{A matrix.} 11 | } 12 | \value{ 13 | \code{TRUE} of the matrix is square or \code{FALSE} otherwise. 14 | } 15 | \description{ 16 | Check if Square Matrix 17 | } 18 | -------------------------------------------------------------------------------- /man/correlation-deprecated.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/zzz_deprecated.R 3 | \name{correlation-deprecated} 4 | \alias{correlation-deprecated} 5 | \alias{distance_mahalanobis} 6 | \title{Deprecated functions} 7 | \usage{ 8 | distance_mahalanobis(...) 9 | } 10 | \arguments{ 11 | \item{...}{Args.} 12 | } 13 | \description{ 14 | Deprecated functions 15 | } 16 | -------------------------------------------------------------------------------- /.github/workflows/lint.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | 9 | name: lint 10 | 11 | jobs: 12 | lint: 13 | uses: easystats/workflows/.github/workflows/lint.yaml@main 14 | -------------------------------------------------------------------------------- /.github/workflows/lint-changed-files.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | pull_request: 5 | branches: [main, master] 6 | 7 | name: lint-changed-files 8 | 9 | jobs: 10 | lint-changed-files: 11 | uses: easystats/workflows/.github/workflows/lint-changed-files.yaml@main 12 | -------------------------------------------------------------------------------- /.github/workflows/html-5-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | 9 | name: html-5-check 10 | 11 | jobs: 12 | html-5-check: 13 | uses: easystats/workflows/.github/workflows/html-5-check.yaml@main 14 | -------------------------------------------------------------------------------- /.github/workflows/test-coverage.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | 9 | name: test-coverage 10 | 11 | jobs: 12 | test-coverage: 13 | uses: easystats/workflows/.github/workflows/test-coverage.yaml@main 14 | -------------------------------------------------------------------------------- /man/is.cor.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{is.cor} 4 | \alias{is.cor} 5 | \title{Check if matrix ressembles a correlation matrix} 6 | \usage{ 7 | is.cor(x) 8 | } 9 | \arguments{ 10 | \item{x}{A matrix.} 11 | } 12 | \value{ 13 | \code{TRUE} of the matrix is a correlation matrix or \code{FALSE} otherwise. 14 | } 15 | \description{ 16 | Check if matrix ressembles a correlation matrix 17 | } 18 | -------------------------------------------------------------------------------- /.github/workflows/check-readme.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | 4 | on: 5 | push: 6 | branches: [main, master] 7 | pull_request: 8 | branches: [main, master] 9 | 10 | name: check-readme 11 | 12 | jobs: 13 | check-readme: 14 | uses: easystats/workflows/.github/workflows/check-readme.yaml@main 15 | -------------------------------------------------------------------------------- /R/cor_test_gaussian.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | .cor_test_gaussian <- function(data, x, y, ci = 0.95, ...) { 3 | var_x <- .complete_variable_x(data, x, y) 4 | var_y <- .complete_variable_y(data, x, y) 5 | 6 | var_x <- stats::qnorm(rank(var_x) / (length(var_x) + 1)) 7 | var_y <- stats::qnorm(rank(var_y) / (length(var_y) + 1)) 8 | 9 | out <- .cor_test_base(x, y, var_x, var_y, ci = ci, method = "pearson", ...) 10 | out$Method <- "Gaussian rank" 11 | out 12 | } 13 | -------------------------------------------------------------------------------- /.github/workflows/test-coverage-examples.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | 9 | name: test-coverage-examples 10 | 11 | jobs: 12 | test-coverage-examples: 13 | uses: easystats/workflows/.github/workflows/test-coverage-examples.yaml@main 14 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | release: 9 | types: [published] 10 | workflow_dispatch: 11 | 12 | name: pkgdown 13 | 14 | jobs: 15 | pkgdown: 16 | uses: easystats/workflows/.github/workflows/pkgdown.yaml@main 17 | -------------------------------------------------------------------------------- /pkgdown/favicon/site.webmanifest: -------------------------------------------------------------------------------- 1 | { 2 | "name": "", 3 | "short_name": "", 4 | "icons": [ 5 | { 6 | "src": "/web-app-manifest-192x192.png", 7 | "sizes": "192x192", 8 | "type": "image/png", 9 | "purpose": "maskable" 10 | }, 11 | { 12 | "src": "/web-app-manifest-512x512.png", 13 | "sizes": "512x512", 14 | "type": "image/png", 15 | "purpose": "maskable" 16 | } 17 | ], 18 | "theme_color": "#ffffff", 19 | "background_color": "#ffffff", 20 | "display": "standalone" 21 | } -------------------------------------------------------------------------------- /R/reexports.R: -------------------------------------------------------------------------------- 1 | #' @export 2 | #' @importFrom bayestestR simulate_simpson 3 | bayestestR::simulate_simpson 4 | 5 | #' @export 6 | #' @importFrom datawizard visualisation_recipe 7 | datawizard::visualisation_recipe 8 | 9 | #' @export 10 | #' @importFrom insight standardize_names 11 | insight::standardize_names 12 | 13 | #' @importFrom insight print_md 14 | #' @export 15 | insight::print_md 16 | 17 | #' @importFrom insight print_html 18 | #' @export 19 | insight::print_html 20 | 21 | #' @importFrom insight display 22 | #' @export 23 | insight::display 24 | -------------------------------------------------------------------------------- /tests/testthat/test-renaming.R: -------------------------------------------------------------------------------- 1 | test_that("renaming columns", { 2 | # should warn the user 3 | expect_warning({ 4 | out <- correlation(anscombe, 5 | select = c("x1", "x2"), 6 | rename = "var1" 7 | ) 8 | }) 9 | expect_snapshot(print(out)) 10 | 11 | expect_snapshot(correlation(anscombe, 12 | select = c("x1", "x2"), 13 | rename = c("var1", "var2") 14 | )) 15 | 16 | expect_snapshot(correlation(anscombe, 17 | select = c("x1", "x2"), 18 | select2 = c("y1", "y2"), 19 | rename = c("var1", "var2") 20 | )) 21 | }) 22 | -------------------------------------------------------------------------------- /correlation.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | ProjectId: 5ab51f05-a107-46c8-b998-a2432a78b2ad 3 | 4 | RestoreWorkspace: No 5 | SaveWorkspace: No 6 | AlwaysSaveHistory: No 7 | 8 | EnableCodeIndexing: Yes 9 | UseSpacesForTab: Yes 10 | NumSpacesForTab: 2 11 | Encoding: UTF-8 12 | 13 | RnwWeave: Sweave 14 | LaTeX: pdfLaTeX 15 | 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --with-keep.source 21 | PackageRoxygenize: rd,collate,namespace 22 | 23 | QuitChildProcessesOnExit: Yes 24 | DisableExecuteRprofile: Yes 25 | -------------------------------------------------------------------------------- /revdep/cran.md: -------------------------------------------------------------------------------- 1 | ## revdepcheck results 2 | 3 | We checked 8 reverse dependencies, comparing R CMD check results across CRAN and dev versions of this package. 4 | 5 | * We saw 3 new problems 6 | * We failed to check 0 packages 7 | 8 | Issues with CRAN packages are summarised below. 9 | 10 | ### New problems 11 | (This reports the first line of each new failure) 12 | 13 | * effectsize 14 | checking tests ... 15 | 16 | * see 17 | checking examples ... ERROR 18 | checking dependencies in R code ... WARNING 19 | 20 | * statsExpressions 21 | checking tests ... 22 | 23 | -------------------------------------------------------------------------------- /tests/testthat/test-grouped_data2.R: -------------------------------------------------------------------------------- 1 | test_that("correlation with grouped data", { 2 | skip_if_not_or_load_if_installed("poorman") 3 | df <- subset(mtcars, select = c("am", "mpg", "wt")) %>% group_by(am) 4 | 5 | expect_error( 6 | correlation( 7 | subset(df, select = c("am", "mpg")), 8 | subset(df, select = c("wt")) 9 | ) 10 | ) 11 | 12 | corr_df <- correlation( 13 | subset(df, select = c("am", "mpg")), 14 | subset(df, select = c("am", "wt")) 15 | ) 16 | 17 | expect_equal(corr_df$r, c(-0.7676554, -0.9089148), tolerance = 0.001) 18 | }) 19 | -------------------------------------------------------------------------------- /tests/testthat/test-methods.R: -------------------------------------------------------------------------------- 1 | test_that("as.matrix.correlation", { 2 | rez <- correlation(mtcars) 3 | m <- as.matrix(rez) 4 | expect_equal(dim(m), c(11, 11)) 5 | }) 6 | 7 | test_that("summary.correlation - target column", { 8 | skip_if_not_or_load_if_installed("ggplot2") 9 | expect_snapshot(summary(correlation(ggplot2::msleep), target = "t")) 10 | expect_snapshot(summary(correlation(ggplot2::msleep), target = "df_error")) 11 | expect_snapshot(summary(correlation(ggplot2::msleep), target = "p")) 12 | expect_error(summary(correlation(ggplot2::msleep), target = "not_a_column_name")) 13 | }) 14 | -------------------------------------------------------------------------------- /R/cor_test_somers.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | .cor_test_somers <- function(data, x, y, ci = 0.95, ...) { 3 | insight::check_if_installed("Hmisc", "for 'somers' correlations") 4 | 5 | var_x <- .complete_variable_x(data, x, y) 6 | var_y <- .complete_variable_y(data, x, y) 7 | 8 | rez <- Hmisc::somers2(var_y, var_x) 9 | r <- rez["Dxy"] 10 | 11 | data.frame( 12 | Parameter1 = x, 13 | Parameter2 = y, 14 | Dxy = r, 15 | t = NA, 16 | df_error = length(var_x) - 2, 17 | p = NA, 18 | CI_low = NA, 19 | CI_high = NA, 20 | Method = "Somers", 21 | stringsAsFactors = FALSE 22 | ) 23 | } 24 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | # 4 | # NOTE: This workflow is overkill for most R packages and 5 | # check-standard.yaml is likely a better choice. 6 | # usethis::use_github_action("check-standard") will install it. 7 | on: 8 | push: 9 | branches: [main, master] 10 | pull_request: 11 | branches: [main, master] 12 | 13 | name: R-CMD-check 14 | 15 | jobs: 16 | R-CMD-check: 17 | uses: easystats/workflows/.github/workflows/R-CMD-check.yaml@main 18 | -------------------------------------------------------------------------------- /R/utils_get_matrix.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | .get_matrix <- function(data, square = FALSE) { 3 | if ((all(data$Parameter1 %in% data$Parameter2) && all(data$Parameter2 %in% data$Parameter1)) || square) { 4 | vars <- as.character(unique(c(data$Parameter1, data$Parameter2))) 5 | dim <- length(vars) 6 | m <- matrix(nrow = dim, ncol = dim, dimnames = list(vars, vars)) 7 | } else { 8 | m <- matrix( 9 | nrow = length(unique(data$Parameter1)), 10 | ncol = length(unique(data$Parameter2)), 11 | dimnames = list(unique(data$Parameter1), unique(data$Parameter2)) 12 | ) 13 | } 14 | m[] <- 1 15 | m 16 | } 17 | -------------------------------------------------------------------------------- /R/correlation-package.R: -------------------------------------------------------------------------------- 1 | #' \code{correlation} 2 | #' 3 | #' @title correlation: Methods for correlation analysis 4 | #' 5 | #' @description 6 | #' 7 | #' Lightweight package for computing different kinds of correlations, 8 | #' such as partial correlations, Bayesian correlations, multilevel correlations, 9 | #' polychoric correlations, biweight correlations, distance correlations and more. 10 | #' Part of the 'easystats' ecosystem. 11 | #' 12 | #' References: Makowski et al. (2020) \doi{10.21105/joss.02306}. 13 | #' 14 | #' @docType package 15 | #' @aliases correlation-package 16 | #' @name correlation-package 17 | #' @keywords internal 18 | "_PACKAGE" 19 | -------------------------------------------------------------------------------- /R/cor_test_hoeffding.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | .cor_test_hoeffding <- function(data, x, y, ci = 0.95, ...) { 3 | insight::check_if_installed("Hmisc", "for 'hoeffding' correlations") 4 | 5 | var_x <- .complete_variable_x(data, x, y) 6 | var_y <- .complete_variable_y(data, x, y) 7 | 8 | rez <- Hmisc::hoeffd(var_x, var_y) 9 | 10 | r <- rez$D[2, 1] 11 | p <- rez$P[2, 1] 12 | 13 | data.frame( 14 | Parameter1 = x, 15 | Parameter2 = y, 16 | r = r, 17 | t = NA, 18 | df_error = length(var_x) - 2, 19 | p = p, 20 | CI_low = NA, 21 | CI_high = NA, 22 | Method = "Hoeffding", 23 | stringsAsFactors = FALSE 24 | ) 25 | } 26 | -------------------------------------------------------------------------------- /R/cor_to_spcor.R: -------------------------------------------------------------------------------- 1 | #' @rdname cor_to_pcor 2 | #' @export 3 | cor_to_spcor <- function(cor = NULL, cov = NULL, tol = .Machine$double.eps^(2 / 3)) { 4 | cor <- .get_cor(cor, cov) 5 | 6 | # Semi-partial 7 | if (is.null(cov)) { 8 | insight::format_error("Covariance matrix (or vector of SD of variables) needs to be passed for semi-partial correlations.") 9 | } else { 10 | if (!is.matrix(cov)) { 11 | cov <- cor_to_cov(cor, sd = cov) 12 | } 13 | inverted <- .invert_matrix(cov, tol = tol) 14 | out <- -stats::cov2cor(inverted) / sqrt(diag(cov)) / sqrt(abs(diag(inverted) - t(t(inverted^2) / diag(inverted)))) 15 | } 16 | 17 | diag(out) <- 1 18 | out 19 | } 20 | -------------------------------------------------------------------------------- /man/matrix_inverse.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/matrix_inverse.R 3 | \name{matrix_inverse} 4 | \alias{matrix_inverse} 5 | \title{Matrix Inversion} 6 | \usage{ 7 | matrix_inverse(m, tol = .Machine$double.eps^(2/3)) 8 | } 9 | \arguments{ 10 | \item{m}{Matrix for which the inverse is required.} 11 | 12 | \item{tol}{Relative tolerance to detect zero singular values.} 13 | } 14 | \value{ 15 | An inversed matrix. 16 | } 17 | \description{ 18 | Performs a Moore-Penrose generalized inverse (also called the Pseudoinverse). 19 | } 20 | \examples{ 21 | m <- cor(iris[1:4]) 22 | matrix_inverse(m) 23 | } 24 | \seealso{ 25 | pinv from the pracma package 26 | } 27 | -------------------------------------------------------------------------------- /.github/workflows/check-all-examples.yaml: -------------------------------------------------------------------------------- 1 | # Make sure all examples run successfully, even the ones that are not supposed 2 | # to be run or tested on CRAN machines by default. 3 | # 4 | # The examples that fail should use 5 | # - `if (FALSE) { ... }` (if example is included only for illustrative purposes) 6 | # - `try({ ... })` (if the intent is to show the error) 7 | # 8 | # This workflow helps find such failing examples that need to be modified. 9 | on: 10 | push: 11 | branches: [main, master] 12 | pull_request: 13 | branches: [main, master] 14 | 15 | name: check-all-examples 16 | 17 | jobs: 18 | check-all-examples: 19 | uses: easystats/workflows/.github/workflows/check-all-examples.yaml@main 20 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | #' Check if matrix ressembles a correlation matrix 2 | #' 3 | #' @param x A matrix. 4 | #' @return `TRUE` of the matrix is a correlation matrix or `FALSE` otherwise. 5 | #' @export 6 | is.cor <- function(x) { 7 | square <- isSquare(x) 8 | symetric <- isSymmetric(x) 9 | ismatrix <- is.matrix(x) 10 | diag_one <- all(diag(x) == 1) 11 | maxi <- max(x) == 1 12 | all(c(square, symetric, ismatrix, diag_one, maxi)) 13 | } 14 | 15 | 16 | #' Check if Square Matrix 17 | #' 18 | #' @param m A matrix. 19 | #' 20 | #' @return `TRUE` of the matrix is square or `FALSE` otherwise. 21 | #' @export 22 | isSquare <- function(m) { 23 | if (dim(m)[1] != dim(m)[2]) { 24 | FALSE 25 | } else { 26 | TRUE 27 | } 28 | } 29 | -------------------------------------------------------------------------------- /tests/testthat/test-display_print_dataframe.R: -------------------------------------------------------------------------------- 1 | test_that("display and print method works - markdown", { 2 | skip_on_cran() 3 | skip_if_not_or_load_if_installed("knitr") 4 | expect_snapshot(display(correlation(iris))) 5 | expect_snapshot(print_md(correlation(iris))) 6 | }) 7 | 8 | # display and print method works - HTML ----------------------------- 9 | 10 | test_that("display and print method works - HTML", { 11 | skip_on_cran() 12 | skip_if(getRversion() < "4.0.0") 13 | skip_if_not_or_load_if_installed("gt") 14 | 15 | expect_s3_class(display(correlation(subset(mtcars, select = c("wt", "mpg"))), format = "html"), "gt_tbl") 16 | expect_s3_class(print_html(correlation(subset(mtcars, select = c("wt", "mpg")))), "gt_tbl") 17 | }) 18 | -------------------------------------------------------------------------------- /.lintr: -------------------------------------------------------------------------------- 1 | linters: linters_with_defaults( 2 | absolute_path_linter = NULL, 3 | commented_code_linter = NULL, 4 | cyclocomp_linter = cyclocomp_linter(25), 5 | extraction_operator_linter = NULL, 6 | implicit_integer_linter = NULL, 7 | line_length_linter(120), 8 | namespace_linter = NULL, 9 | nonportable_path_linter = NULL, 10 | object_name_linter = NULL, 11 | object_length_linter(50), 12 | object_usage_linter = NULL, 13 | todo_comment_linter = NULL, 14 | undesirable_function_linter(c("mapply" = NA, "sapply" = NA, "setwd" = NA)), 15 | undesirable_operator_linter = NULL, 16 | unnecessary_concatenation_linter(allow_single_expression = FALSE), 17 | defaults = linters_with_tags(tags = NULL) 18 | ) 19 | -------------------------------------------------------------------------------- /WIP/utils_reorder_matrix.R: -------------------------------------------------------------------------------- 1 | #' @importFrom stats as.dist hclust 2 | #' @keywords internal 3 | .reorder_matrix <- function(x, reorder_distance = NULL, method = "complete") { 4 | if (is.null(reorder_distance)) { 5 | reorder_distance <- x 6 | reorder_distance$Parameter <- NULL 7 | reorder_distance$Group <- NULL 8 | } else { 9 | reorder_distance$Parameter <- NULL 10 | reorder_distance$Group <- NULL 11 | } 12 | 13 | if (!isSquare(reorder_distance)) { 14 | stop("Matrix must be squared to be re-arranged.") 15 | } 16 | 17 | reorder_distance <- stats::as.dist((1 - reorder_distance) / 2, diag = TRUE, upper = TRUE) 18 | hc <- stats::hclust(reorder_distance, method = method) 19 | x <- x[hc$order, hc$order] 20 | x 21 | } 22 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/windows/correlation.md: -------------------------------------------------------------------------------- 1 | # correlation output with zap_small 2 | 3 | Code 4 | summary(r) 5 | Output 6 | # Correlation Matrix (pearson-method) 7 | 8 | Parameter | z | y 9 | ----------------------- 10 | x | 0.02 | 0.01 11 | y | 0.00 | 12 | 13 | p-value adjustment method: Holm (1979) 14 | 15 | --- 16 | 17 | Code 18 | summary(r, zap_small = FALSE) 19 | Output 20 | # Correlation Matrix (pearson-method) 21 | 22 | Parameter | z | y 23 | -------------------------------- 24 | x | 0.02 | 6.02e-03 25 | y | -3.07e-03 | 26 | 27 | p-value adjustment method: Holm (1979) 28 | 29 | -------------------------------------------------------------------------------- /R/cor_test_blomqvist.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | .cor_test_blomqvist <- function(data, x, y, ci = 0.95, ...) { 3 | insight::check_if_installed("wdm", "for 'blomqvist' correlations") 4 | 5 | var_x <- .complete_variable_x(data, x, y) 6 | var_y <- .complete_variable_y(data, x, y) 7 | 8 | r <- wdm::wdm(var_x, var_y, method = "blomqvist") 9 | 10 | # t-value approximation 11 | p <- cor_to_p(r, n = length(var_x)) 12 | ci_vals <- cor_to_ci(r, n = length(var_x), ci = ci) 13 | 14 | data.frame( 15 | Parameter1 = x, 16 | Parameter2 = y, 17 | r = r, 18 | t = p$statistic, 19 | df_error = length(var_x) - 2, 20 | p = p$p, 21 | CI_low = ci_vals$CI_low, 22 | CI_high = ci_vals$CI_high, 23 | Method = "Blomqvist", 24 | stringsAsFactors = FALSE 25 | ) 26 | } 27 | -------------------------------------------------------------------------------- /WIP/spcor_to_cor.R: -------------------------------------------------------------------------------- 1 | #' @rdname cor_to_pcor 2 | #' @export 3 | spcor_to_cor <- function(spcor = NULL, cov = NULL, semi = FALSE, tol = .Machine$double.eps^(2 / 3)) { 4 | # Get cor 5 | spcor <- .get_cor(spcor, cov) 6 | 7 | # negate off-diagonal entries, then invert 8 | m <- -spcor 9 | diag(m) <- -diag(m) 10 | 11 | stop("Cannot convert semi-partial correlations to correlations yet. We need help for that.") 12 | # if(is.null(cov)){ 13 | # stop("Covariance matrix (or vector of SD of variables) needs to be passed for semi-partial correlations.") 14 | # } else{ 15 | # if(!is.matrix(cov)){ 16 | # cov <- cor_to_cov(spcor, sd = cov) 17 | # } 18 | # inverted <- inverted * sqrt(diag(cov)) * sqrt(abs(diag(inverted) - t(t(inverted^2) / diag(inverted)))) 19 | # } 20 | 21 | # out 22 | } 23 | -------------------------------------------------------------------------------- /tests/testthat/test-as_list.R: -------------------------------------------------------------------------------- 1 | test_that("as.list", { 2 | skip_if_not_or_load_if_installed("datawizard") 3 | skip_if_not_or_load_if_installed("ggplot2") 4 | 5 | # no groups 6 | set.seed(123) 7 | out <- as.list(correlation(mtcars)) 8 | expect_snapshot(print(out, table_width = Inf)) 9 | 10 | # with groups 11 | set.seed(123) 12 | data(msleep, package = "ggplot2") 13 | out <- as.list( 14 | correlation(datawizard::data_group(msleep, "vore"), method = "spearman") 15 | ) 16 | expect_snapshot(print(out, table_width = Inf)) 17 | 18 | out <- as.list( 19 | correlation( 20 | datawizard::data_group(mtcars, "am"), 21 | select = c("cyl", "wt"), 22 | select2 = "hp", 23 | method = "percentage" 24 | ) 25 | ) 26 | expect_snapshot(print(out, table_width = Inf)) 27 | }) 28 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check-hard.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | # 4 | # NOTE: This workflow only directly installs "hard" dependencies, i.e. Depends, 5 | # Imports, and LinkingTo dependencies. Notably, Suggests dependencies are never 6 | # installed, with the exception of testthat, knitr, and rmarkdown. The cache is 7 | # never used to avoid accidentally restoring a cache containing a suggested 8 | # dependency. 9 | on: 10 | push: 11 | branches: [main, master] 12 | pull_request: 13 | branches: [main, master] 14 | 15 | name: R-CMD-check-hard 16 | 17 | jobs: 18 | R-CMD-check-hard: 19 | uses: easystats/workflows/.github/workflows/R-CMD-check-hard.yaml@main 20 | -------------------------------------------------------------------------------- /tests/testthat/test-cormatrix_to_excel.R: -------------------------------------------------------------------------------- 1 | test_that("cormatrix_to_excel select", { 2 | skip_if_not_or_load_if_installed("openxlsx2") 3 | expect_snapshot(suppressWarnings(cormatrix_to_excel(mtcars, 4 | filename = "cormatrix1", 5 | overwrite = TRUE, 6 | p_adjust = "none", 7 | print.mat = TRUE, 8 | select = c("mpg", "cyl", "disp", "hp", "carb"), 9 | verbose = FALSE 10 | ))) 11 | unlink("cormatrix1.xlsx") 12 | }) 13 | 14 | test_that("cormatrix_to_excel p_adjust", { 15 | skip_if_not_or_load_if_installed("openxlsx2") 16 | expect_snapshot(suppressWarnings(cormatrix_to_excel(airquality, 17 | filename = "cormatrix1", 18 | overwrite = FALSE, 19 | p_adjust = "holm", 20 | print.mat = FALSE, 21 | method = "spearman", 22 | verbose = FALSE 23 | ))) 24 | unlink("cormatrix1.xlsx") 25 | }) 26 | -------------------------------------------------------------------------------- /man/cor_text.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cor_text.R 3 | \name{cor_text} 4 | \alias{cor_text} 5 | \title{Correlation text} 6 | \usage{ 7 | cor_text(x, show_ci = TRUE, show_statistic = TRUE, show_sig = TRUE, ...) 8 | } 9 | \arguments{ 10 | \item{x}{A dataframe with correlation statistics.} 11 | 12 | \item{show_ci, show_statistic, show_sig}{Toggle on/off different parts of the text.} 13 | 14 | \item{...}{Other arguments to be passed to or from other functions.} 15 | } 16 | \description{ 17 | This function returns a formatted character of correlation statistics. 18 | } 19 | \examples{ 20 | rez <- cor_test(mtcars, "mpg", "wt") 21 | 22 | cor_text(rez) 23 | cor_text(rez, show_statistic = FALSE, show_ci = FALSE, stars = TRUE) 24 | 25 | rez <- correlation(mtcars) 26 | 27 | cor_text(rez) 28 | } 29 | -------------------------------------------------------------------------------- /R/cor_test_gamma.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | .cor_test_gamma <- function(data, x, y, ci = 0.95, ...) { 3 | var_x <- .complete_variable_x(data, x, y) 4 | var_y <- .complete_variable_y(data, x, y) 5 | 6 | # Get r value 7 | Rx <- outer(var_x, var_x, function(u, v) sign(u - v)) 8 | Ry <- outer(var_y, var_y, function(u, v) sign(u - v)) 9 | S1 <- Rx * Ry 10 | r <- sum(S1) / sum(abs(S1)) 11 | 12 | # t-value approximation 13 | p <- cor_to_p(r, n = length(var_x)) 14 | ci_vals <- cor_to_ci(r, n = length(var_x), ci = ci) 15 | 16 | 17 | data.frame( 18 | Parameter1 = x, 19 | Parameter2 = y, 20 | r = r, 21 | t = p$statistic, 22 | df_error = length(var_x) - 2, 23 | p = p$p, 24 | CI_low = ci_vals$CI_low, 25 | CI_high = ci_vals$CI_high, 26 | Method = "Gamma", 27 | stringsAsFactors = FALSE 28 | ) 29 | } 30 | -------------------------------------------------------------------------------- /man/z_fisher.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/z_fisher.R 3 | \name{z_fisher} 4 | \alias{z_fisher} 5 | \title{Fisher z-transformation} 6 | \usage{ 7 | z_fisher(r = NULL, z = NULL) 8 | } 9 | \arguments{ 10 | \item{r, z}{The r or the z' value to be converted.} 11 | } 12 | \value{ 13 | The transformed value. 14 | } 15 | \description{ 16 | The Fisher z-transformation converts the standard Pearson's \emph{r} to a normally 17 | distributed variable z'. It is used to compute confidence intervals to 18 | correlations. The z' variable is different from the \emph{z}-statistic. 19 | } 20 | \examples{ 21 | z_fisher(r = 0.7) 22 | z_fisher(z = 0.867) 23 | 24 | } 25 | \references{ 26 | Zar, J.H., (2014). Spearman Rank Correlation: Overview. Wiley StatsRef: 27 | Statistics Reference Online. doi:10.1002/9781118445112.stat05964 28 | } 29 | -------------------------------------------------------------------------------- /R/z_fisher.R: -------------------------------------------------------------------------------- 1 | #' Fisher z-transformation 2 | #' 3 | #' The Fisher z-transformation converts the standard Pearson's *r* to a normally 4 | #' distributed variable z'. It is used to compute confidence intervals to 5 | #' correlations. The z' variable is different from the *z*-statistic. 6 | #' 7 | #' @param r,z The r or the z' value to be converted. 8 | #' 9 | #' @return The transformed value. 10 | #' 11 | #' @examples 12 | #' z_fisher(r = 0.7) 13 | #' z_fisher(z = 0.867) 14 | #' 15 | #' @references 16 | #' Zar, J.H., (2014). Spearman Rank Correlation: Overview. Wiley StatsRef: 17 | #' Statistics Reference Online. doi:10.1002/9781118445112.stat05964 18 | #' 19 | #' @export 20 | z_fisher <- function(r = NULL, z = NULL) { 21 | # TODO: add variants for Spearman and Kendall (Zar, 2014) 22 | if (is.null(z)) { 23 | return(atanh(r)) 24 | } else { 25 | return(tanh(z)) 26 | } 27 | } 28 | -------------------------------------------------------------------------------- /man/reexports.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/reexports.R 3 | \docType{import} 4 | \name{reexports} 5 | \alias{reexports} 6 | \alias{simulate_simpson} 7 | \alias{visualisation_recipe} 8 | \alias{standardize_names} 9 | \alias{print_md} 10 | \alias{print_html} 11 | \alias{display} 12 | \title{Objects exported from other packages} 13 | \keyword{internal} 14 | \description{ 15 | These objects are imported from other packages. Follow the links 16 | below to see their documentation. 17 | 18 | \describe{ 19 | \item{bayestestR}{\code{\link[bayestestR]{simulate_simpson}}} 20 | 21 | \item{datawizard}{\code{\link[datawizard]{visualisation_recipe}}} 22 | 23 | \item{insight}{\code{\link[insight]{display}}, \code{\link[insight:display]{print_html}}, \code{\link[insight:display]{print_md}}, \code{\link[insight]{standardize_names}}} 24 | }} 25 | 26 | -------------------------------------------------------------------------------- /tests/testthat/test-selecting_variables.R: -------------------------------------------------------------------------------- 1 | # select specific variables for correlation ----------------------------- 2 | 3 | test_that("selecting specific variables works", { 4 | skip_if_not_or_load_if_installed("poorman") 5 | set.seed(123) 6 | df1 <- mtcars %>% 7 | correlation( 8 | select = c("cyl", "wt"), 9 | select2 = "hp" 10 | ) 11 | 12 | set.seed(123) 13 | df2 <- mtcars %>% 14 | group_by(am) %>% 15 | correlation( 16 | select = c("cyl", "wt"), 17 | select2 = "hp" 18 | ) 19 | 20 | set.seed(123) 21 | df3 <- mtcars %>% 22 | correlation(select = "wt", select2 = "hp") 23 | 24 | set.seed(123) 25 | df4 <- mtcars %>% 26 | correlation(select = c("wt", "hp")) 27 | 28 | expect_snapshot(list(df1, df2, df3, df4)) 29 | 30 | expect_equal(df3$r, df4$r, tolerance = 0.001) 31 | expect_equal(df3$t, df4$t, tolerance = 0.001) 32 | }) 33 | -------------------------------------------------------------------------------- /man/cor_to_cov.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cor_to_cov.R 3 | \name{cor_to_cov} 4 | \alias{cor_to_cov} 5 | \title{Convert a correlation to covariance} 6 | \usage{ 7 | cor_to_cov(cor, sd = NULL, variance = NULL, tol = .Machine$double.eps^(2/3)) 8 | } 9 | \arguments{ 10 | \item{cor}{A correlation matrix, or a partial or a semipartial 11 | correlation matrix.} 12 | 13 | \item{sd, variance}{A vector that contains the standard deviations, or the 14 | variance, of the variables in the correlation matrix.} 15 | 16 | \item{tol}{Relative tolerance to detect zero singular values.} 17 | } 18 | \value{ 19 | A covariance matrix. 20 | } 21 | \description{ 22 | Convert a correlation to covariance 23 | } 24 | \examples{ 25 | cor <- cor(iris[1:4]) 26 | cov(iris[1:4]) 27 | 28 | cor_to_cov(cor, sd = sapply(iris[1:4], sd)) 29 | cor_to_cov(cor, variance = sapply(iris[1:4], var)) 30 | } 31 | -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^\cache$ 2 | ^codemeta\.json$ 3 | ^Meta$ 4 | ^doc$ 5 | ^.*\.Rproj$ 6 | ^\.Rproj\.user$ 7 | ^README\.Rmd$ 8 | ^Rplots.pdf$ 9 | ^README-.*\.png$ 10 | ^CONDUCT\.md$ 11 | ^SECURITY\.md$ 12 | ^CODE_OF_CONDUCT\.md$ 13 | ^SUPPORT\.md$ 14 | ^\.github$ 15 | ^NEWS$ 16 | ^docs$ 17 | ^revdep$ 18 | publication/* 19 | ^codecov\.yml$ 20 | ^\.coveralls\.yml$ 21 | ^\.travis\.yml$ 22 | ^_pkgdown\.yml$ 23 | ^appveyor\.yml$ 24 | ^.gitlab-ci\.yml$ 25 | ^data-raw$ 26 | ^pkgdown$ 27 | ^\.httr-oauth$ 28 | ^CRAN-RELEASE$ 29 | tests\^spelling 30 | ^\.circleci$ 31 | ^tests/manual$ 32 | ^revdep$ 33 | ^\.covrignore$ 34 | ^\.github/ISSUE_TEMPLATE$ 35 | ^paper.*$ 36 | references.bib 37 | ^API$ 38 | ^\.gitsum$ 39 | ^gitsum$ 40 | ^tests/testmanual$ 41 | ^\.pre-commit-config\.yaml$ 42 | ^brew\-log$ 43 | ^paper/. 44 | ^WIP/. 45 | ^.github$ 46 | ^\.github$ 47 | 48 | \.code-workspace$ 49 | \.lintr$ 50 | 51 | ^cran-comments\.md$ 52 | ^revdep$ 53 | ^CRAN-SUBMISSION$ 54 | ^LICENSE\.md$ 55 | -------------------------------------------------------------------------------- /tests/testthat/test-misc.R: -------------------------------------------------------------------------------- 1 | test_that("cor_to_cov", { 2 | cor <- cor(iris[1:4]) 3 | cov <- cov(iris[1:4]) 4 | cov2 <- cor_to_cov(cor, variance = sapply(iris[1:4], var)) 5 | expect_equal(max(cov - cov2), 0, tolerance = 0.0001) 6 | }) 7 | 8 | test_that("matrix_inverse works", { 9 | m <- matrix_inverse(cor(iris[1:4])) 10 | m2 <- solve(cor(iris[1:4])) 11 | expect_equal(max(m - m2), 0, tolerance = 0.0001) 12 | }) 13 | 14 | test_that("is.cor works", { 15 | expect_true(is.cor(cor(mtcars))) 16 | expect_false(is.cor(as.matrix(anscombe))) 17 | }) 18 | 19 | test_that("z_fisher works", { 20 | expect_equal(z_fisher(r = 0.7), 0.8673005, tolerance = 0.001) 21 | expect_equal(z_fisher(z = 0.867), 0.6998467, tolerance = 0.001) 22 | }) 23 | 24 | test_that("simulate_simpson works", { 25 | skip_if_not_or_load_if_installed("MASS") 26 | set.seed(123) 27 | df <- bayestestR::simulate_simpson(n = 100, groups = 5, r = 0.5) 28 | expect_equal(dim(df), c(500L, 3L)) 29 | }) 30 | -------------------------------------------------------------------------------- /man/cor_lower.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cor_lower.R 3 | \name{cor_lower} 4 | \alias{cor_lower} 5 | \title{Return the upper or lower triangular part} 6 | \usage{ 7 | cor_lower(x, diag = FALSE, ...) 8 | } 9 | \arguments{ 10 | \item{x}{A correlation object.} 11 | 12 | \item{diag}{Should the diagonal be included?} 13 | 14 | \item{...}{Other arguments to be passed to or from other functions.} 15 | } 16 | \description{ 17 | Return the upper or lower triangular part of the correlation matrix. 18 | } 19 | \examples{ 20 | x <- correlation(mtcars, redundant = TRUE) # Generate full matrix 21 | x <- cor_lower(x) 22 | 23 | if (require("ggplot2")) { 24 | ggplot(x, aes(x = Parameter2, y = Parameter1, fill = r)) + 25 | geom_tile() 26 | } 27 | 28 | # Sorted 29 | x <- correlation(mtcars, redundant = TRUE) # Generate full matrix 30 | x <- cor_sort(x) 31 | x <- cor_lower(x) 32 | 33 | if (require("ggplot2")) { 34 | ggplot(x, aes(x = Parameter2, y = Parameter1, fill = r)) + 35 | geom_tile() 36 | } 37 | } 38 | -------------------------------------------------------------------------------- /R/cor_test_tetrachoric.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | .cor_test_tetrachoric <- function(data, x, y, ci = 0.95, ...) { 3 | insight::check_if_installed("psych", "for 'tetrachronic' correlations") 4 | 5 | var_x <- .complete_variable_x(data, x, y) 6 | var_y <- .complete_variable_y(data, x, y) 7 | 8 | # valid matrix check 9 | if (length(unique(var_x)) > 2 && length(unique(var_y)) > 2) { 10 | insight::format_error("Tetrachoric correlations can only be ran on dichotomous data.") 11 | } 12 | 13 | # Reconstruct dataframe 14 | dat <- data.frame(var_x, var_y) 15 | names(dat) <- c(x, y) 16 | 17 | junk <- utils::capture.output(r <- psych::tetrachoric(dat)$rho[2, 1]) # nolint 18 | 19 | p <- cor_to_p(r, n = nrow(data)) 20 | ci_vals <- cor_to_ci(r, n = nrow(data), ci = ci) 21 | 22 | data.frame( 23 | Parameter1 = x, 24 | Parameter2 = y, 25 | rho = r, 26 | t = p$statistic, 27 | df_error = length(var_x) - 2, 28 | p = p$p, 29 | CI_low = ci_vals$CI_low, 30 | CI_high = ci_vals$CI_high, 31 | Method = "Tetrachoric", 32 | stringsAsFactors = FALSE 33 | ) 34 | } 35 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # MIT License 2 | 3 | Copyright (c) 2023 correlation authors 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /tests/testthat/test-display_print_matrix.R: -------------------------------------------------------------------------------- 1 | # display and print method works - markdown ----------------------------- 2 | 3 | test_that("display and print method works - markdown", { 4 | skip_on_cran() 5 | skip_if_not_or_load_if_installed("knitr") 6 | expect_snapshot(display(summary(correlation(iris)))) 7 | expect_snapshot(print_md(summary(correlation(iris)))) 8 | }) 9 | 10 | # display and print method works - html ----------------------------- 11 | test_that("display and print method works - html", { 12 | skip_on_cran() 13 | skip_if_not_or_load_if_installed("gt") 14 | expect_s3_class(print_html(summary(correlation(iris))), "gt_tbl") 15 | }) 16 | 17 | test_that("as.matrix works", { 18 | skip_if_not_or_load_if_installed("gt") 19 | skip_if_not_installed("datawizard") 20 | skip_if(getRversion() < "4.1.0") 21 | set.seed(123) 22 | mat1 <- datawizard::data_select(mtcars, c("am", "wt", "hp")) |> 23 | correlation() |> 24 | as.matrix() 25 | set.seed(123) 26 | mat2 <- datawizard::data_select(mtcars, c("am", "wt", "hp")) |> 27 | datawizard::data_group(am) |> 28 | correlation() |> 29 | as.matrix() 30 | expect_snapshot(list(mat1, mat2)) 31 | }) 32 | -------------------------------------------------------------------------------- /R/cor_test_shepherd.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | .cor_test_shepherd <- function(data, x, y, ci = 0.95, bayesian = FALSE, ...) { 3 | var_x <- .complete_variable_x(data, x, y) 4 | var_y <- .complete_variable_y(data, x, y) 5 | 6 | d <- .robust_bootstrap_mahalanobis(cbind(var_x, var_y)) 7 | not_outliers <- d < 6 8 | 9 | if (bayesian) { 10 | data <- data[not_outliers, ] 11 | data[c(x, y)] <- datawizard::ranktransform(data[c(x, y)], sign = TRUE, method = "average") 12 | out <- .cor_test_bayes(data, x, y, ci = ci) 13 | } else { 14 | out <- .cor_test_freq(data[not_outliers, ], x, y, ci = ci, method = "spearman") 15 | } 16 | out$Method <- "Shepherd's Pi" 17 | out 18 | } 19 | 20 | 21 | # Utils ------------------------------------------------------------------- 22 | 23 | #' @keywords internal 24 | .robust_bootstrap_mahalanobis <- function(data, iterations = 1000) { 25 | Ms <- replicate(n = iterations, { 26 | # Draw random numbers from 1:n with replacement 27 | idx <- sample(nrow(data), replace = TRUE) 28 | # Resample data 29 | dat <- data[idx, ] 30 | # Calculating the Mahalanobis distance for each actual observation using resampled data 31 | stats::mahalanobis(data, center = colMeans(dat), cov = stats::cov(dat)) 32 | }) 33 | 34 | apply(Ms, 1, stats::median) 35 | } 36 | -------------------------------------------------------------------------------- /R/visualisation_recipe.easycorrelation.R: -------------------------------------------------------------------------------- 1 | #' @rdname visualisation_recipe.easycormatrix 2 | #' 3 | #' @examplesIf require("see") && require("tidygraph") && require("ggraph") 4 | #' \donttest{ 5 | #' rez <- correlation(iris) 6 | #' 7 | #' layers <- visualisation_recipe(rez) 8 | #' layers 9 | #' plot(layers) 10 | #' } 11 | #' @export 12 | visualisation_recipe.easycorrelation <- function(x, ...) { 13 | insight::check_if_installed("tidygraph") 14 | 15 | x$width <- abs(x$r) 16 | data <- tidygraph::as_tbl_graph(x) 17 | 18 | # Initialize layers list 19 | layers <- list() 20 | 21 | layers[["l1"]] <- list( 22 | geom = "ggraph::geom_edge_arc", 23 | strength = 0.1, 24 | aes = list(edge_colour = "r", edge_width = "width") 25 | ) 26 | layers[["l2"]] <- list(geom = "ggraph::geom_node_point", size = 22) 27 | layers[["l3"]] <- list( 28 | geom = "ggraph::geom_node_text", 29 | aes = list(label = "name"), colour = "white" 30 | ) 31 | layers[["l4"]] <- list(geom = "ggraph::theme_graph", base_family = "sans") 32 | layers[["l5"]] <- list(geom = "guides", edge_width = "none") 33 | 34 | # Out 35 | class(layers) <- c("visualisation_recipe", "see_visualisation_recipe", class(layers)) 36 | attr(layers, "data") <- data 37 | attr(layers, "layout") <- "kk" 38 | attr(layers, "ggraph") <- TRUE 39 | layers 40 | } 41 | -------------------------------------------------------------------------------- /R/cor_test_biweight.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | .cor_test_biweight <- function(data, x, y, ci = 0.95, ...) { 3 | var_x <- .complete_variable_x(data, x, y) 4 | var_y <- .complete_variable_y(data, x, y) 5 | 6 | 7 | # https://github.com/easystats/correlation/issues/13 8 | u <- (var_x - stats::median(var_x)) / (9 * stats::mad(var_x, constant = 1)) 9 | v <- (var_y - stats::median(var_y)) / (9 * stats::mad(var_y, constant = 1)) 10 | 11 | I_x <- as.numeric((1 - abs(u)) > 0) 12 | I_y <- as.numeric((1 - abs(v)) > 0) 13 | 14 | w_x <- I_x * (1 - u^2)^2 15 | w_y <- I_y * (1 - v^2)^2 16 | 17 | 18 | denominator_x <- sqrt(sum(((var_x - stats::median(var_x)) * w_x)^2)) 19 | x_curly <- ((var_x - stats::median(var_x)) * w_x) / denominator_x 20 | 21 | denominator_y <- sqrt(sum(((var_y - stats::median(var_y)) * w_y)^2)) 22 | y_curly <- ((var_y - stats::median(var_y)) * w_y) / denominator_y 23 | 24 | r <- sum(x_curly * y_curly) 25 | 26 | p <- cor_to_p(r, n = nrow(data)) 27 | ci_vals <- cor_to_ci(r, n = nrow(data), ci = ci) 28 | 29 | data.frame( 30 | Parameter1 = x, 31 | Parameter2 = y, 32 | r = r, 33 | t = p$statistic, 34 | df_error = length(var_x) - 2L, 35 | p = p$p, 36 | CI_low = ci_vals$CI_low, 37 | CI_high = ci_vals$CI_high, 38 | Method = "Biweight", 39 | stringsAsFactors = FALSE 40 | ) 41 | } 42 | -------------------------------------------------------------------------------- /R/utils_get_combinations.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | .get_combinations <- function(data, 3 | data2 = NULL, 4 | redundant = TRUE, 5 | include_factors = TRUE, 6 | multilevel = FALSE, 7 | method = "pearson") { 8 | data <- .clean_data(data, include_factors = include_factors, multilevel = multilevel) 9 | 10 | if (method == "polychoric") { 11 | vars <- names(data) 12 | } else if (multilevel) { 13 | vars <- names(data[sapply(data, is.numeric)]) 14 | } else { 15 | vars <- names(data) 16 | } 17 | 18 | 19 | # Find pairs 20 | if (is.null(data2)) { 21 | vars2 <- vars 22 | } else { 23 | data2 <- .clean_data(data2, include_factors = include_factors, multilevel = multilevel) 24 | data2_nums <- data2[sapply(data2, is.numeric)] 25 | vars2 <- names(data2_nums) 26 | } 27 | 28 | combinations <- expand.grid(vars, vars2, stringsAsFactors = FALSE) 29 | combinations <- combinations[order(match(combinations$Var1, vars), match(combinations$Var2, vars2)), ] 30 | 31 | row.names(combinations) <- NULL 32 | names(combinations) <- c("Parameter1", "Parameter2") 33 | 34 | if (!redundant) { 35 | combinations <- .remove_redundant(combinations) 36 | } 37 | 38 | combinations 39 | } 40 | -------------------------------------------------------------------------------- /man/cor_sort.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cor_sort.R 3 | \name{cor_sort} 4 | \alias{cor_sort} 5 | \title{Sort a correlation matrix to improve readability of groups and clusters} 6 | \usage{ 7 | cor_sort(x, distance = "correlation", hclust_method = "complete", ...) 8 | } 9 | \arguments{ 10 | \item{x}{A correlation matrix.} 11 | 12 | \item{distance}{How the distance between each variable should be calculated. 13 | If \code{correlation} (default; suited for correlation matrices), the matrix 14 | will be rescaled to 0-1 (\code{distance = 0} indicating correlation of \code{1}; 15 | \code{distance = 1} indicating correlation of \code{-1}). If \code{raw}, then the matrix 16 | will be used as a distance matrix as-is. Can be others (\code{euclidean}, 17 | \code{manhattan}, ...), in which case it will be passed to \code{\link[=dist]{dist()}} (see the 18 | arguments for it).} 19 | 20 | \item{hclust_method}{Argument passed down into the \code{method} argument of \code{\link[=hclust]{hclust()}}.} 21 | 22 | \item{...}{Other arguments to be passed to or from other functions.} 23 | } 24 | \description{ 25 | Sort a correlation matrix based on \code{\link[=hclust]{hclust()}}. 26 | } 27 | \examples{ 28 | x <- correlation(mtcars) 29 | 30 | cor_sort(as.matrix(x)) 31 | cor_sort(x, hclust_method = "ward.D2") # It can also reorder the long form output 32 | cor_sort(summary(x, redundant = TRUE)) # As well as from the summary 33 | } 34 | -------------------------------------------------------------------------------- /inst/WORDLIST: -------------------------------------------------------------------------------- 1 | Albers 2 | Args 3 | BFs 4 | Bhushan 5 | Biometrika 6 | Biserial 7 | Bishara 8 | Blomqvist 9 | Blomqvist's 10 | Blomqvist’s 11 | Bonett 12 | Boudt 13 | CMD 14 | Cornelissen 15 | Croux 16 | DOI 17 | Dayum 18 | Dom 19 | Dxy 20 | Fieller 21 | GES 22 | GGM 23 | GGMs 24 | Hartley 25 | Hittner 26 | Hoeffding 27 | Hoeffding's 28 | Hoeffding’s 29 | holm 30 | Horvath 31 | JanMarvin 32 | Jans 33 | Jorjani 34 | Langfelder 35 | Mattan 36 | Mmh 37 | Mohnert 38 | ORCID 39 | PNAS 40 | Penrose 41 | Polychoric 42 | Pseudoinverse 43 | Schaeffer 44 | Schimdt 45 | Shachar 46 | Sheperd's 47 | Sheperd’s 48 | Shmid 49 | Sloot 50 | Somers 51 | Somers's 52 | Somers’ 53 | StatsRef 54 | Steg 55 | Tetrachoric 56 | Visualisation 57 | Winsorization 58 | Winsorized 59 | Zar 60 | al 61 | biserial 62 | blomqvist 63 | bmwiernik 64 | bw 65 | codecov 66 | colour 67 | cov 68 | datawizard 69 | dichotomously 70 | doi 71 | easystats 72 | et 73 | favour 74 | favours 75 | fieller 76 | frac 77 | geoms 78 | hoeffding 79 | https 80 | inversed 81 | joss 82 | kendall 83 | labelled 84 | mattansb 85 | midcorrelation 86 | openxlsx 87 | partialization 88 | partialized 89 | partialled 90 | partialling 91 | patilindrajeets 92 | pearson 93 | pinv 94 | polychoric 95 | pracma 96 | rOpenSci 97 | rempsyc 98 | rescaled 99 | ressembles 100 | rmarkdown 101 | semipartial 102 | spearman 103 | strengejacke 104 | tetrachoric 105 | theorised 106 | tidyverse 107 | xy 108 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/cormatrix_to_excel.md: -------------------------------------------------------------------------------- 1 | # cormatrix_to_excel select 2 | 3 | Code 4 | suppressWarnings(cormatrix_to_excel(mtcars, filename = "cormatrix1", overwrite = TRUE, 5 | p_adjust = "none", print.mat = TRUE, select = c("mpg", "cyl", "disp", "hp", 6 | "carb"), verbose = FALSE)) 7 | Output 8 | # Correlation Matrix (pearson-method) 9 | 10 | Parameter | mpg | cyl | disp | hp | carb 11 | --------------------------------------------------------------- 12 | mpg | | -0.85*** | -0.85*** | -0.78*** | -0.55** 13 | cyl | -0.85*** | | 0.90*** | 0.83*** | 0.53** 14 | disp | -0.85*** | 0.90*** | | 0.79*** | 0.39* 15 | hp | -0.78*** | 0.83*** | 0.79*** | | 0.75*** 16 | carb | -0.55** | 0.53** | 0.39* | 0.75*** | 17 | 18 | p-value adjustment method: none 19 | 20 | 21 | [Correlation matrix 'cormatrix1.xlsx' has been saved to working directory (or where specified).] 22 | NULL 23 | 24 | # cormatrix_to_excel p_adjust 25 | 26 | Code 27 | suppressWarnings(cormatrix_to_excel(airquality, filename = "cormatrix1", 28 | overwrite = FALSE, p_adjust = "holm", print.mat = FALSE, method = "spearman", 29 | verbose = FALSE)) 30 | Output 31 | 32 | 33 | [Correlation matrix 'cormatrix1.xlsx' has been saved to working directory (or where specified).] 34 | NULL 35 | 36 | -------------------------------------------------------------------------------- /inst/CITATION: -------------------------------------------------------------------------------- 1 | bibentry( 2 | bibtype = "misc", 3 | key = "correlationPackage", 4 | title = "{{correlation}}: Methods for Correlation Analysis", 5 | shorttitle = "{{correlation}}", 6 | author = c( 7 | person("Dominique", "Makowski"), 8 | person("Brenton M.", "Wiernik"), 9 | person("Indrajeet", "Patil"), 10 | person("Daniel", "Lüdecke"), 11 | person("Mattan S.", "Ben-Shachar") 12 | ), 13 | year = "2022", 14 | month = "oct", 15 | note = "Version 0.8.3", 16 | url = "https://CRAN.R-project.org/package=correlation", 17 | textVersion = "Makowski, D., Wiernik, B. M., Patil, I., Lüdecke, D., & Ben-Shachar, M. S. (2022). correlation: Methods for correlation analysis (0.8.3) [R package]. https://CRAN.R-project.org/package=correlation (Original work published 2020)" 18 | ) 19 | 20 | bibentry( 21 | bibtype="article", 22 | key = "correlationArticle", 23 | title="Methods and Algorithms for Correlation Analysis in {{R}}", 24 | author=c(person("Dominique", "Makowski"), person("Mattan S.", "Ben-Shachar"), person("Indrajeet", "Patil"), person("Daniel", "Lüdecke")), 25 | doi="10.21105/joss.02306", 26 | year="2020", 27 | journal="Journal of Open Source Software", 28 | number = "51", 29 | volume = "5", 30 | pages = "2306", 31 | url="https://joss.theoj.org/papers/10.21105/joss.02306", 32 | textVersion = "Makowski, D., Ben-Shachar, M. S., Patil, I., & Lüdecke, D. (2019). Methods and algorithms for correlation analysis in R. Journal of Open Source Software, 5(51), 2306. https://doi.org/10.21105/joss.02306" 33 | ) 34 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # History files 2 | .Rhistory 3 | .Rapp.history 4 | 5 | # Session Data files 6 | .RData 7 | 8 | # Example code in package build process 9 | *-Ex.R 10 | 11 | # Output files from R CMD build 12 | /*.tar.gz 13 | 14 | # Output files from R CMD check 15 | /*.Rcheck/ 16 | 17 | # RStudio files 18 | .Rproj.user/ 19 | 20 | # produced vignettes 21 | vignettes/*.html 22 | vignettes/*.pdf 23 | 24 | # OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3 25 | .httr-oauth 26 | 27 | # knitr and R markdown default cache directories 28 | /*_cache/ 29 | /cache/ 30 | 31 | # Temporary files created by R markdown 32 | *.utf8.md 33 | *.knit.md 34 | 35 | # Shiny token, see https://shiny.rstudio.com/articles/shinyapps.html 36 | rsconnect/ 37 | 38 | # Windows image file caches 39 | Thumbs.db 40 | ehthumbs.db 41 | 42 | # Folder config file 43 | Desktop.ini 44 | 45 | # Recycle Bin used on file shares 46 | $RECYCLE.BIN/ 47 | 48 | # Windows Installer files 49 | *.cab 50 | *.msi 51 | *.msm 52 | *.msp 53 | 54 | # Windows shortcuts 55 | *.lnk 56 | 57 | # ========================= 58 | # Operating System Files 59 | # OSX 60 | .DS_Store 61 | .AppleDouble 62 | .LSOverride 63 | 64 | # Thumbnails 65 | ._* 66 | 67 | # Files that might appear in the root of a volume 68 | .DocumentRevisions-V100 69 | .fseventsd 70 | .Spotlight-V100 71 | .TemporaryItems 72 | .Trashes 73 | .VolumeIcon.icns 74 | 75 | # Directories potentially created on remote AFP share 76 | .AppleDB 77 | .AppleDesktop 78 | Network Trash Folder 79 | Temporary Items 80 | .apdisk 81 | CRAN-SUBMISSION 82 | -------------------------------------------------------------------------------- /R/utils_find_correlationtype.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | .find_correlationtype <- function(data, x, y) { 3 | type_x <- .vartype(data[[x]]) 4 | type_y <- .vartype(data[[y]]) 5 | 6 | if (type_x$is_binary && type_y$is_continuous) { 7 | if (type_x$is_factor) { 8 | method <- "biserial" 9 | } else { 10 | method <- "pointbiserial" 11 | } 12 | } else if (type_x$is_continuous && type_y$is_binary) { 13 | if (type_y$is_factor) { 14 | method <- "biserial" 15 | } else { 16 | method <- "pointbiserial" 17 | } 18 | } else if (type_x$is_binary && type_y$is_binary) { 19 | method <- "tetrachoric" 20 | } else if (type_x$is_factor || type_y$is_factor) { 21 | method <- "polychoric" 22 | } else { 23 | method <- "pearson" 24 | } 25 | method 26 | } 27 | 28 | 29 | #' @keywords internal 30 | .vartype <- function(x) { 31 | out <- list( 32 | is_factor = FALSE, 33 | is_numeric = FALSE, 34 | is_character = FALSE, 35 | is_binary = FALSE, 36 | is_continuous = FALSE, 37 | is_count = FALSE 38 | ) 39 | 40 | if (is.factor(x)) { 41 | out$is_factor <- TRUE 42 | } 43 | 44 | if (is.character(x)) { 45 | out$is_character <- TRUE 46 | } 47 | 48 | if (is.numeric(x)) { 49 | out$is_numeric <- TRUE 50 | } 51 | 52 | if (length(unique(x)) == 2) { 53 | out$is_binary <- TRUE 54 | } 55 | 56 | if (out$is_numeric && !out$is_binary) { 57 | out$is_continuous <- TRUE 58 | } 59 | 60 | if (all(x %% 1 == 0)) { 61 | out$is_count <- TRUE 62 | } 63 | 64 | out 65 | } 66 | -------------------------------------------------------------------------------- /revdep/README.md: -------------------------------------------------------------------------------- 1 | # Platform 2 | 3 | |field |value | 4 | |:--------|:-----------------------------------------| 5 | |version |R version 4.2.1 (2022-06-23) | 6 | |os |macOS Monterey 12.4 | 7 | |system |aarch64, darwin20 | 8 | |ui |RStudio | 9 | |language |(EN) | 10 | |collate |en_US.UTF-8 | 11 | |ctype |en_US.UTF-8 | 12 | |tz |Europe/Berlin | 13 | |date |2022-08-07 | 14 | |rstudio |2022.07.0+548 Spotted Wakerobin (desktop) | 15 | |pandoc |2.19 @ /usr/local/bin/ (via rmarkdown) | 16 | 17 | # Dependencies 18 | 19 | |package |old |new |Δ | 20 | |:-----------|:-----|:--------|:--| 21 | |correlation |0.8.1 |0.8.2 |* | 22 | |bayestestR |NA |0.12.1.2 |* | 23 | |datawizard |NA |0.5.0 |* | 24 | |insight |NA |0.18.0.4 |* | 25 | 26 | # Revdeps 27 | 28 | ## New problems (3) 29 | 30 | |package |version |error |warning |note | 31 | |:------------------------------------------------|:-------|:------|:-------|:----| 32 | |[effectsize](problems.md#effectsize) |0.7.0 |__+1__ | | | 33 | |[see](problems.md#see) |0.7.1 |__+1__ |__+1__ | | 34 | |[statsExpressions](problems.md#statsexpressions) |1.3.2 |__+1__ | | | 35 | 36 | -------------------------------------------------------------------------------- /R/cor_test_percentage.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | .cor_test_percentage <- function(data, x, y, ci = 0.95, beta = 0.2, ...) { 3 | var_x <- .complete_variable_x(data, x, y) 4 | var_y <- .complete_variable_y(data, x, y) 5 | 6 | temp <- sort(abs(var_x - stats::median(var_x))) 7 | omhatx <- temp[floor((1 - beta) * length(var_x))] 8 | temp <- sort(abs(var_y - stats::median(var_y))) 9 | omhaty <- temp[floor((1 - beta) * length(var_y))] 10 | a <- (var_x - .pbos(var_x, beta)) / omhatx 11 | b <- (var_y - .pbos(var_y, beta)) / omhaty 12 | a <- pmax(a, -1) 13 | a <- pmin(a, 1) 14 | b <- pmax(b, -1) 15 | b <- pmin(b, 1) 16 | 17 | # Result 18 | r <- sum(a * b) / sqrt(sum(a^2) * sum(b^2)) 19 | p <- cor_to_p(r, n = length(var_x)) 20 | ci_vals <- cor_to_ci(r, n = length(var_x), ci = ci) 21 | 22 | data.frame( 23 | Parameter1 = x, 24 | Parameter2 = y, 25 | r = r, 26 | t = p$statistic, 27 | df_error = length(var_x) - 2, 28 | p = p$p, 29 | CI_low = ci_vals$CI_low, 30 | CI_high = ci_vals$CI_high, 31 | Method = "Percentage Bend", 32 | stringsAsFactors = FALSE 33 | ) 34 | } 35 | 36 | 37 | #' @keywords internal 38 | .pbos <- function(x, beta = 0.2) { 39 | temp <- sort(abs(x - stats::median(x))) 40 | omhatx <- temp[floor((1 - beta) * length(x))] 41 | psi <- (x - stats::median(x)) / omhatx 42 | i1 <- length(psi[psi < (-1)]) 43 | i2 <- length(psi[psi > 1]) 44 | sx <- ifelse(psi < (-1), 0, x) 45 | sx <- ifelse(psi > 1, 0, sx) 46 | pbos <- (sum(sx) + omhatx * (i2 - i1)) / (length(x) - i1 - i2) 47 | pbos 48 | } 49 | -------------------------------------------------------------------------------- /R/matrix_inverse.R: -------------------------------------------------------------------------------- 1 | #' Matrix Inversion 2 | #' 3 | #' Performs a Moore-Penrose generalized inverse (also called the Pseudoinverse). 4 | #' 5 | #' @inheritParams cor_to_pcor 6 | #' @examples 7 | #' m <- cor(iris[1:4]) 8 | #' matrix_inverse(m) 9 | #' @param m Matrix for which the inverse is required. 10 | #' 11 | #' @return An inversed matrix. 12 | #' @seealso pinv from the pracma package 13 | #' @export 14 | matrix_inverse <- function(m, tol = .Machine$double.eps^(2 / 3)) { 15 | # valid matrix checks 16 | # valid matrix checks 17 | if (!isSquare(m)) { 18 | stop("The matrix should be a square matrix.", call. = FALSE) 19 | } 20 | 21 | stopifnot(is.numeric(m), length(dim(m)) == 2, is.matrix(m)) 22 | 23 | s <- svd(m) 24 | 25 | p <- (s$d > max(tol * s$d[1], 0)) 26 | if (all(p)) { 27 | mp <- s$v %*% (1 / s$d * t(s$u)) 28 | } else if (any(p)) { 29 | mp <- s$v[, p, drop = FALSE] %*% (1 / s$d[p] * t(s$u[, p, drop = FALSE])) 30 | } else { 31 | mp <- matrix(0, nrow = ncol(m), ncol = nrow(m)) 32 | } 33 | 34 | colnames(mp) <- colnames(m) 35 | row.names(mp) <- row.names(m) 36 | mp 37 | } 38 | 39 | 40 | #' @keywords internal 41 | .invert_matrix <- function(m, tol = .Machine$double.eps^(2 / 3)) { 42 | if (det(m) < tol) { 43 | # The inverse of variance-covariance matrix is calculated using 44 | # Moore-Penrose generalized matrix invers due to its determinant of zero. 45 | out <- matrix_inverse(m, tol) 46 | colnames(out) <- colnames(m) 47 | row.names(out) <- row.names(m) 48 | } else { 49 | out <- solve(m) 50 | } 51 | out 52 | } 53 | -------------------------------------------------------------------------------- /R/cor_test_polychoric.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | .cor_test_polychoric <- function(data, x, y, ci = 0.95, ...) { 3 | insight::check_if_installed("psych", "for 'tetrachronic' correlations") 4 | 5 | var_x <- .complete_variable_x(data, x, y) 6 | var_y <- .complete_variable_y(data, x, y) 7 | 8 | # valid matrix check 9 | if (!is.factor(var_x) && !is.factor(var_y)) { 10 | insight::format_error("Polychoric correlations can only be ran on ordinal factors.") 11 | } 12 | 13 | 14 | if (!is.factor(var_x) || !is.factor(var_y)) { 15 | insight::check_if_installed("polycor", "for 'polyserial' correlations") 16 | 17 | r <- polycor::polyserial( 18 | x = if (is.factor(var_x)) as.numeric(var_y) else as.numeric(var_x), 19 | y = if (is.factor(var_x)) as.numeric(var_x) else as.numeric(var_y) 20 | ) 21 | method <- "Polyserial" 22 | } else { 23 | # Reconstruct dataframe 24 | dat <- data.frame(as.numeric(var_x), as.numeric(var_y)) 25 | names(dat) <- c(x, y) 26 | junk <- utils::capture.output({ 27 | r <- suppressWarnings(psych::polychoric(dat)$rho[2, 1]) 28 | }) 29 | method <- "Polychoric" 30 | } 31 | 32 | # t-value approximation 33 | p <- cor_to_p(r, n = length(var_x)) 34 | ci_vals <- cor_to_ci(r, n = length(var_x), ci = ci) 35 | 36 | data.frame( 37 | Parameter1 = x, 38 | Parameter2 = y, 39 | rho = r, 40 | t = p$statistic, 41 | df_error = length(var_x) - 2, 42 | p = p$p, 43 | CI_low = ci_vals$CI_low, 44 | CI_high = ci_vals$CI_high, 45 | Method = method, 46 | stringsAsFactors = FALSE 47 | ) 48 | } 49 | -------------------------------------------------------------------------------- /R/cor_lower.R: -------------------------------------------------------------------------------- 1 | #' Return the upper or lower triangular part 2 | #' 3 | #' Return the upper or lower triangular part of the correlation matrix. 4 | #' 5 | #' @param x A correlation object. 6 | #' @param diag Should the diagonal be included? 7 | #' @param ... Other arguments to be passed to or from other functions. 8 | #' 9 | #' @examples 10 | #' x <- correlation(mtcars, redundant = TRUE) # Generate full matrix 11 | #' x <- cor_lower(x) 12 | #' 13 | #' if (require("ggplot2")) { 14 | #' ggplot(x, aes(x = Parameter2, y = Parameter1, fill = r)) + 15 | #' geom_tile() 16 | #' } 17 | #' 18 | #' # Sorted 19 | #' x <- correlation(mtcars, redundant = TRUE) # Generate full matrix 20 | #' x <- cor_sort(x) 21 | #' x <- cor_lower(x) 22 | #' 23 | #' if (require("ggplot2")) { 24 | #' ggplot(x, aes(x = Parameter2, y = Parameter1, fill = r)) + 25 | #' geom_tile() 26 | #' } 27 | #' @export 28 | cor_lower <- function(x, diag = FALSE, ...) { 29 | UseMethod("cor_lower") 30 | } 31 | 32 | #' @export 33 | cor_lower.easycorrelation <- function(x, diag = FALSE, ...) { 34 | # Transform easycorrelation into matrix 35 | m <- as.matrix(x) 36 | m <- m[levels(as.factor(x$Parameter1)), levels(as.factor(x$Parameter2))] 37 | 38 | # Select upper triangular 39 | tri <- upper.tri(m, diag = diag) 40 | rownames(tri) <- rownames(m) 41 | colnames(tri) <- colnames(m) 42 | 43 | tokeep <- NULL 44 | 45 | for (param1 in rownames(m)) { 46 | for (param2 in colnames(m)) { 47 | if (tri[param1, param2]) { 48 | tokeep <- c(tokeep, which(x$Parameter1 == param1 & x$Parameter2 == param2)) 49 | } 50 | } 51 | } 52 | 53 | x[tokeep, ] 54 | } 55 | -------------------------------------------------------------------------------- /tests/testthat/test-cor_multilevel.R: -------------------------------------------------------------------------------- 1 | test_that("comparison rmcorr", { 2 | skip_if_not_or_load_if_installed("lme4") 3 | skip_if_not_or_load_if_installed("rmcorr") 4 | set.seed(123) 5 | rez_rmcorr <- rmcorr::rmcorr(Species, Sepal.Length, Sepal.Width, dataset = iris) 6 | 7 | set.seed(123) 8 | rez <- cor_test(iris[c(1, 2, 5)], "Sepal.Length", "Sepal.Width", partial = TRUE, multilevel = TRUE) 9 | 10 | expect_equal(rez$r, rez_rmcorr$r, tolerance = 0.001) 11 | expect_equal(rez$p, rez_rmcorr$p, tolerance = 0.001) 12 | # expect_equal(rez$df_error, rez_rmcorr$df) 13 | expect_equal(rez$CI_low, rez_rmcorr$CI[1], tolerance = 0.01) 14 | expect_equal(rez$CI_high, rez_rmcorr$CI[2], tolerance = 0.01) 15 | }) 16 | 17 | 18 | test_that("Reductio ad absurdum", { 19 | skip_if_not_or_load_if_installed("lme4") 20 | cormatrix <- matrix( 21 | c( 22 | 1.0, 0.3, 0.6, 23 | 0.3, 1.0, 0.0, 24 | 0.6, 0.0, 1.0 25 | ), 26 | nrow = 3 27 | ) 28 | 29 | data <- bayestestR::simulate_correlation(n = 500, r = cormatrix) 30 | # Add factor levels "at random", so the grouping structure should NOT change much 31 | data$Group <- sample(rep_len(c("A", "B", "C"), length.out = 500)) 32 | 33 | rez <- correlation(data) 34 | expect_equal(max(as.matrix(rez) - cormatrix), 0, tolerance = 0.000001) 35 | 36 | rez <- suppressMessages(correlation(data, multilevel = TRUE, verbose = FALSE)) 37 | expect_equal(max(as.matrix(rez) - cormatrix), 0, tolerance = 0.01) 38 | 39 | rez <- suppressMessages(correlation(data, multilevel = TRUE, partial = TRUE, verbose = FALSE)) 40 | expect_equal(max(as.matrix(pcor_to_cor(rez)) - cormatrix), 0, tolerance = 0.01) 41 | }) 42 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/renaming.md: -------------------------------------------------------------------------------- 1 | # renaming columns 2 | 3 | Code 4 | print(out) 5 | Output 6 | # Correlation Matrix (pearson-method) 7 | 8 | Parameter1 | Parameter2 | r | 95% CI | t(9) | p 9 | ------------------------------------------------------------- 10 | x1 | x2 | 1 | [1.00, 1.00] | Inf | < .001*** 11 | 12 | p-value adjustment method: Holm (1979) 13 | Observations: 11 14 | 15 | --- 16 | 17 | Code 18 | correlation(anscombe, select = c("x1", "x2"), rename = c("var1", "var2")) 19 | Output 20 | # Correlation Matrix (pearson-method) 21 | 22 | Parameter1 | Parameter2 | r | 95% CI | t(9) | p 23 | ------------------------------------------------------------- 24 | var1 | var2 | 1 | [1.00, 1.00] | Inf | < .001*** 25 | 26 | p-value adjustment method: Holm (1979) 27 | Observations: 11 28 | 29 | --- 30 | 31 | Code 32 | correlation(anscombe, select = c("x1", "x2"), select2 = c("y1", "y2"), rename = c( 33 | "var1", "var2")) 34 | Output 35 | # Correlation Matrix (pearson-method) 36 | 37 | Parameter1 | Parameter2 | r | 95% CI | t(9) | p 38 | -------------------------------------------------------------- 39 | var1 | y1 | 0.82 | [0.42, 0.95] | 4.24 | 0.009** 40 | var1 | y2 | 0.82 | [0.42, 0.95] | 4.24 | 0.009** 41 | var2 | y1 | 0.82 | [0.42, 0.95] | 4.24 | 0.009** 42 | var2 | y2 | 0.82 | [0.42, 0.95] | 4.24 | 0.009** 43 | 44 | p-value adjustment method: Holm (1979) 45 | Observations: 11 46 | 47 | -------------------------------------------------------------------------------- /man/cor_smooth.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cor_smooth.R 3 | \name{cor_smooth} 4 | \alias{cor_smooth} 5 | \alias{is.positive_definite} 6 | \alias{is_positive_definite} 7 | \title{Smooth a non-positive definite correlation matrix to make it positive definite} 8 | \usage{ 9 | cor_smooth(x, method = "psych", verbose = TRUE, ...) 10 | 11 | is.positive_definite(x, tol = 10^-12, ...) 12 | 13 | is_positive_definite(x, tol = 10^-12, ...) 14 | } 15 | \arguments{ 16 | \item{x}{A correlation matrix.} 17 | 18 | \item{method}{Smoothing method. Can be \code{psych} (will use 19 | \code{psych::cor.smooth()}), \code{hj} (Jorjani et al., 2003) or \code{lrs} (Schaeffer, 20 | 2014). For the two last, will use \code{mbend::bend()} (check its documentation 21 | for details).} 22 | 23 | \item{verbose}{Set to \code{FALSE} to silence the function.} 24 | 25 | \item{...}{Other arguments to be passed to or from other functions.} 26 | 27 | \item{tol}{The minimum eigenvalue to be considered as acceptable.} 28 | } 29 | \description{ 30 | Make correlations positive definite using \code{psych::cor.smooth}. If smoothing 31 | is done, inferential statistics (\emph{p}-values, confidence intervals, etc.) are 32 | removed, as they are no longer valid. 33 | } 34 | \examples{ 35 | \dontshow{if (requireNamespace("psych", quietly = TRUE)) withAutoprint(\{ # examplesIf} 36 | set.seed(123) 37 | data <- as.matrix(mtcars) 38 | # Make missing data so pairwise correlation matrix is non-positive definite 39 | data[sample(seq_len(352), size = 60)] <- NA 40 | data <- as.data.frame(data) 41 | x <- correlation(data) 42 | is.positive_definite(x) 43 | 44 | smoothed <- cor_smooth(x) 45 | \dontshow{\}) # examplesIf} 46 | } 47 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/display_print_matrix.md: -------------------------------------------------------------------------------- 1 | # display and print method works - markdown 2 | 3 | Code 4 | display(summary(correlation(iris))) 5 | Output 6 | 7 | 8 | Table: Correlation Matrix (pearson-method) 9 | 10 | |Parameter | Petal.Width | Petal.Length | Sepal.Width | 11 | |:------------|:-----------:|:------------:|:-----------:| 12 | |Sepal.Length | 0.82*** | 0.87*** | -0.12 | 13 | |Sepal.Width | -0.37*** | -0.43*** | | 14 | |Petal.Length | 0.96*** | | | 15 | p-value adjustment method: Holm (1979) 16 | 17 | --- 18 | 19 | Code 20 | print_md(summary(correlation(iris))) 21 | Output 22 | 23 | 24 | Table: Correlation Matrix (pearson-method) 25 | 26 | |Parameter | Petal.Width | Petal.Length | Sepal.Width | 27 | |:------------|:-----------:|:------------:|:-----------:| 28 | |Sepal.Length | 0.82*** | 0.87*** | -0.12 | 29 | |Sepal.Width | -0.37*** | -0.43*** | | 30 | |Petal.Length | 0.96*** | | | 31 | p-value adjustment method: Holm (1979) 32 | 33 | # as.matrix works 34 | 35 | Code 36 | list(mat1, mat2) 37 | Output 38 | [[1]] 39 | am wt hp 40 | am 1.0000000 -0.6924953 -0.2432043 41 | wt -0.6924953 1.0000000 0.6587479 42 | hp -0.2432043 0.6587479 1.0000000 43 | 44 | [[2]] 45 | wt hp 46 | 0 - wt 1.0000000 0.6797596 47 | 0 - hp 0.6797596 1.0000000 48 | 1 - wt 1.0000000 0.8145279 49 | 1 - hp 0.8145279 1.0000000 50 | 51 | 52 | -------------------------------------------------------------------------------- /.github/SUPPORT.md: -------------------------------------------------------------------------------- 1 | # Getting help with `{correlation}` 2 | 3 | Thanks for using `{correlation}`. Before filing an issue, there are a few places 4 | to explore and pieces to put together to make the process as smooth as possible. 5 | 6 | Start by making a minimal **repr**oducible **ex**ample using the 7 | [reprex](http://reprex.tidyverse.org/) package. If you haven't heard of or used 8 | reprex before, you're in for a treat! Seriously, reprex will make all of your 9 | R-question-asking endeavors easier (which is a pretty insane ROI for the five to 10 | ten minutes it'll take you to learn what it's all about). For additional reprex 11 | pointers, check out the [Get help!](https://www.tidyverse.org/help/) resource 12 | used by the tidyverse team. 13 | 14 | Armed with your reprex, the next step is to figure out where to ask: 15 | 16 | * If it's a question: start with StackOverflow. There are more people there to answer questions. 17 | * If it's a bug: you're in the right place, file an issue. 18 | * If you're not sure: let's [discuss](https://github.com/easystats/correlation/discussions) it and try to figure it out! If your 19 | problem _is_ a bug or a feature request, you can easily return here and 20 | report it. 21 | 22 | Before opening a new issue, be sure to [search issues and pull requests](https://github.com/easystats/correlation/issues) to make sure the 23 | bug hasn't been reported and/or already fixed in the development version. By 24 | default, the search will be pre-populated with `is:issue is:open`. You can 25 | [edit the qualifiers](https://help.github.com/articles/searching-issues-and-pull-requests/) 26 | (e.g. `is:pr`, `is:closed`) as needed. For example, you'd simply 27 | remove `is:open` to search _all_ issues in the repo, open or closed. 28 | 29 | Thanks for your help! -------------------------------------------------------------------------------- /R/utils_remove_redundant.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | .remove_redundant <- function(params) { 3 | if (all(params$Parameter1 %in% params$Parameter2) && all(params$Parameter2 %in% params$Parameter1)) { 4 | m <- .get_matrix(params) 5 | m[upper.tri(m, diag = TRUE)] <- NA 6 | rows_NA <- .get_rows_non_NA(m) 7 | out <- params[!paste0(params$Parameter1, "_", params$Parameter2) %in% rows_NA, ] 8 | } else { 9 | # Might be some edgecases here 10 | out <- params 11 | } 12 | 13 | out <- out[out$Parameter1 != out$Parameter2, ] 14 | row.names(out) <- NULL 15 | out 16 | } 17 | 18 | 19 | #' @keywords internal 20 | .add_redundant <- function(params, data = NULL) { 21 | # save in case of failure 22 | original_params <- params 23 | 24 | # inverse parameters 25 | inversed <- params 26 | inversed[, c("Parameter1", "Parameter2")] <- params[, c("Parameter2", "Parameter1")] 27 | 28 | # bind and get diagonal data 29 | params <- rbind(params, inversed) 30 | diagonal <- .create_diagonal(params) 31 | 32 | # skip diagonal if no matching data was found... 33 | if (ncol(diagonal) != ncol(params)) { 34 | return(original_params) 35 | } 36 | 37 | params <- rbind(params, diagonal) 38 | 39 | # Reorder 40 | if (!is.null(data)) { 41 | params <- params[order(match(params$Parameter1, names(data)), match(params$Parameter2, names(data))), ] 42 | } 43 | 44 | params 45 | } 46 | 47 | 48 | #' @keywords internal 49 | .get_rows_non_NA <- function(m) { 50 | rows <- NULL 51 | cols <- NULL 52 | 53 | for (col in colnames(m)) { 54 | for (row in seq_len(nrow(m))) { 55 | if (!is.na(m[row, col])) { 56 | rows <- c(rows, row.names(m)[row]) 57 | cols <- c(cols, col) 58 | } 59 | } 60 | } 61 | 62 | paste0(rows, "_", cols) 63 | } 64 | -------------------------------------------------------------------------------- /tests/testthat/test-cor_to_pcor.R: -------------------------------------------------------------------------------- 1 | test_that("pcor_to_cor", { 2 | skip_if_not_or_load_if_installed("ppcor") 3 | skip_if_not_or_load_if_installed("Hmisc") 4 | 5 | set.seed(333) 6 | 7 | # easycormatrix 8 | out <- correlation(iris, partial = TRUE, p_adjust = "none") 9 | pcormat <- summary(out, redundant = TRUE) 10 | 11 | ppcor <- ppcor::pcor(iris[1:4]) 12 | expect_equal(max(as.matrix(pcormat[2:5]) - as.matrix(ppcor$estimate)), 0, tolerance = 0.01) 13 | 14 | # TODO: fix 15 | # cormat <- pcor_to_cor(pcormat) 16 | # expect_equal(max(as.matrix(cormat[2:5]) - as.matrix(cor(iris[1:4]))), 0, tolerance = 0.01) 17 | 18 | # hmisc <- Hmisc::rcorr(as.matrix(iris[1:4]), type = c("pearson")) 19 | # expect_equal(mean(as.matrix(cormat[2:5]) - hmisc$r), 0, tolerance = 0.0001) 20 | 21 | # p <- as.matrix(attributes(cormat)$p[2:5]) 22 | # expect_equal(mean(p - hmisc$P, na.rm = TRUE), 0, tolerance = 0.001) 23 | 24 | # easycorrelation 25 | cormat <- summary(pcor_to_cor(correlation(iris, partial = TRUE)), redundant = TRUE) 26 | 27 | expect_equal(max(as.matrix(cormat[2:5]) - as.matrix(cor(iris[1:4]))), 0, tolerance = 0.01) 28 | 29 | hmisc <- Hmisc::rcorr(as.matrix(iris[1:4]), type = c("pearson")) 30 | expect_equal(mean(as.matrix(cormat[2:5]) - hmisc$r), 0, tolerance = 0.0001) 31 | 32 | p <- as.matrix(attributes(cormat)$p[2:5]) 33 | expect_equal(mean(p - hmisc$P, na.rm = TRUE), 0, tolerance = 0.001) 34 | }) 35 | 36 | 37 | test_that("spcor_to_cor", { 38 | skip_if_not_or_load_if_installed("ppcor") 39 | 40 | set.seed(333) 41 | 42 | # easycormatrix 43 | out <- correlation(iris) 44 | cormat <- summary(out, redundant = TRUE) 45 | spcormat <- cor_to_spcor(cormat, cov = cov(iris[1:4])) 46 | 47 | spcor <- ppcor::spcor(iris[1:4]) 48 | expect_equal(max(spcormat - as.matrix(spcor$estimate)), 0, tolerance = 0.01) 49 | }) 50 | -------------------------------------------------------------------------------- /R/cor_to_p.R: -------------------------------------------------------------------------------- 1 | #' Convert correlation to p-values and CIs 2 | #' 3 | #' Get statistics, *p*-values and confidence intervals (CI) from correlation 4 | #' coefficients. 5 | #' 6 | #' @param cor A correlation matrix or coefficient. 7 | #' @param n The sample size (number of observations). 8 | #' @inheritParams cor_test 9 | #' 10 | #' @return A list containing a *p*-value and the statistic or the CI bounds. 11 | #' 12 | #' @examples 13 | #' cor.test(iris$Sepal.Length, iris$Sepal.Width) 14 | #' cor_to_p(-0.1175698, n = 150) 15 | #' cor_to_p(cor(iris[1:4]), n = 150) 16 | #' cor_to_ci(-0.1175698, n = 150) 17 | #' cor_to_ci(cor(iris[1:4]), n = 150) 18 | #' 19 | #' cor.test(iris$Sepal.Length, iris$Sepal.Width, method = "spearman", exact = FALSE) 20 | #' cor_to_p(-0.1667777, n = 150, method = "spearman") 21 | #' cor_to_ci(-0.1667777, ci = 0.95, n = 150) 22 | #' 23 | #' cor.test(iris$Sepal.Length, iris$Sepal.Width, method = "kendall", exact = FALSE) 24 | #' cor_to_p(-0.07699679, n = 150, method = "kendall") 25 | #' 26 | #' @references Bishara, A. J., & Hittner, J. B. (2017). Confidence intervals for 27 | #' correlations when data are not normal. Behavior research methods, 49(1), 28 | #' 294-309. 29 | #' 30 | #' @export 31 | cor_to_p <- function(cor, n, method = "pearson") { 32 | # Statistic 33 | if (method == "kendall") { 34 | insight::format_alert( 35 | "p-value estimation for Kendall's correlation is not perfectly correct.", 36 | "Help us to improve it." 37 | ) 38 | statistic <- (3 * cor * sqrt(n * (n - 1))) / sqrt(2 * (2 * n + 5)) 39 | } else { 40 | statistic <- cor * sqrt((n - 2) / (1 - cor^2)) 41 | } 42 | 43 | # p-value 44 | if (method == "kendall") { 45 | p <- 2 * stats::pnorm(-abs(statistic)) 46 | } else { 47 | p <- 2 * stats::pt(-abs(statistic), df = n - 2) 48 | } 49 | 50 | list(p = p, statistic = statistic) 51 | } 52 | -------------------------------------------------------------------------------- /man/correlation-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/correlation-package.R 3 | \docType{package} 4 | \name{correlation-package} 5 | \alias{correlation-package} 6 | \title{correlation: Methods for correlation analysis} 7 | \description{ 8 | Lightweight package for computing different kinds of correlations, 9 | such as partial correlations, Bayesian correlations, multilevel correlations, 10 | polychoric correlations, biweight correlations, distance correlations and more. 11 | Part of the 'easystats' ecosystem. 12 | 13 | References: Makowski et al. (2020) \doi{10.21105/joss.02306}. 14 | } 15 | \details{ 16 | \code{correlation} 17 | } 18 | \seealso{ 19 | Useful links: 20 | \itemize{ 21 | \item \url{https://easystats.github.io/correlation/} 22 | \item Report bugs at \url{https://github.com/easystats/correlation/issues} 23 | } 24 | 25 | } 26 | \author{ 27 | \strong{Maintainer}: Brenton M. Wiernik \email{brenton@wiernik.org} (\href{https://orcid.org/0000-0001-9560-6336}{ORCID}) 28 | 29 | Authors: 30 | \itemize{ 31 | \item Dominique Makowski \email{dom.makowski@gmail.com} (\href{https://orcid.org/0000-0001-5375-9967}{ORCID}) [inventor] 32 | \item Indrajeet Patil \email{patilindrajeet.science@gmail.com} (\href{https://orcid.org/0000-0003-1995-6531}{ORCID}) 33 | \item Daniel Lüdecke \email{d.luedecke@uke.de} (\href{https://orcid.org/0000-0002-8895-3206}{ORCID}) 34 | \item Mattan S. Ben-Shachar \email{matanshm@post.bgu.ac.il} (\href{https://orcid.org/0000-0002-4287-4801}{ORCID}) 35 | \item Rémi Thériault \email{remi.theriault@mail.mcgill.ca} (\href{https://orcid.org/0000-0003-4315-6788}{ORCID}) 36 | } 37 | 38 | Other contributors: 39 | \itemize{ 40 | \item Mark White \email{markhwhiteii@gmail.com} [reviewer] 41 | \item Maximilian M. Rabe \email{maximilian.rabe@uni-potsdam.de} (\href{https://orcid.org/0000-0002-2556-5644}{ORCID}) [reviewer] 42 | } 43 | 44 | } 45 | \keyword{internal} 46 | -------------------------------------------------------------------------------- /R/cor_to_cov.R: -------------------------------------------------------------------------------- 1 | #' Convert a correlation to covariance 2 | #' 3 | #' @inheritParams cor_to_pcor 4 | #' @param sd,variance A vector that contains the standard deviations, or the 5 | #' variance, of the variables in the correlation matrix. 6 | #' 7 | #' @return A covariance matrix. 8 | #' 9 | #' @examples 10 | #' cor <- cor(iris[1:4]) 11 | #' cov(iris[1:4]) 12 | #' 13 | #' cor_to_cov(cor, sd = sapply(iris[1:4], sd)) 14 | #' cor_to_cov(cor, variance = sapply(iris[1:4], var)) 15 | #' @export 16 | cor_to_cov <- function(cor, sd = NULL, variance = NULL, tol = .Machine$double.eps^(2 / 3)) { 17 | # valid matrix checks 18 | if (!isSquare(cor)) { 19 | insight::format_error("The matrix should be a square matrix.") 20 | } 21 | 22 | if (is.null(sd)) { 23 | if (is.null(variance)) { 24 | insight::format_error("SD or variance of variables needs to be provided.") 25 | } else { 26 | sd <- sqrt(variance) 27 | } 28 | } 29 | 30 | n <- nrow(cor) 31 | 32 | if (n != length(sd)) { 33 | insight::format_error("The length of 'sd' or 'variance' should be the same as the number of rows of the matrix.") 34 | } 35 | 36 | if (length(sd[sd > 0]) != n) { 37 | insight::format_error("The elements in 'sd' or 'variance' should all be non-negative.") 38 | } 39 | 40 | if (isSymmetric(cor)) { 41 | is_symmetric <- TRUE 42 | } else { 43 | is_symmetric <- FALSE 44 | } 45 | p <- dim(cor)[1] 46 | quan <- p * (p - 1) / 2 47 | if (isTRUE(all.equal(cor[lower.tri(cor)], rep(0, quan))) || isTRUE(all.equal(cor[upper.tri(cor)], rep(0, quan)))) { 48 | is_triangular <- TRUE 49 | } else { 50 | is_triangular <- FALSE 51 | } 52 | if (!is_symmetric && !is_triangular) { 53 | insight::format_error("'cor' should be either a symmetric or a triangular matrix") 54 | } 55 | 56 | cov_matrix <- diag(sd) %*% cor %*% diag(sd) 57 | colnames(cov_matrix) <- rownames(cov_matrix) <- colnames(cor) 58 | cov_matrix 59 | } 60 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/display_print_dataframe.md: -------------------------------------------------------------------------------- 1 | # display and print method works - markdown 2 | 3 | Code 4 | display(correlation(iris)) 5 | Output 6 | 7 | 8 | Table: Correlation Matrix (pearson-method) 9 | 10 | |Parameter1 | Parameter2 | r | 95% CI | t(148) | p | 11 | |:------------|:------------:|:-----:|:--------------:|:------:|:---------:| 12 | |Sepal.Length | Sepal.Width | -0.12 | (-0.27, 0.04) | -1.44 | 0.152 | 13 | |Sepal.Length | Petal.Length | 0.87 | (0.83, 0.91) | 21.65 | < .001*** | 14 | |Sepal.Length | Petal.Width | 0.82 | (0.76, 0.86) | 17.30 | < .001*** | 15 | |Sepal.Width | Petal.Length | -0.43 | (-0.55, -0.29) | -5.77 | < .001*** | 16 | |Sepal.Width | Petal.Width | -0.37 | (-0.50, -0.22) | -4.79 | < .001*** | 17 | |Petal.Length | Petal.Width | 0.96 | (0.95, 0.97) | 43.39 | < .001*** | 18 | p-value adjustment method: Holm (1979) 19 | Observations: 150 20 | 21 | --- 22 | 23 | Code 24 | print_md(correlation(iris)) 25 | Output 26 | 27 | 28 | Table: Correlation Matrix (pearson-method) 29 | 30 | |Parameter1 | Parameter2 | r | 95% CI | t(148) | p | 31 | |:------------|:------------:|:-----:|:--------------:|:------:|:---------:| 32 | |Sepal.Length | Sepal.Width | -0.12 | (-0.27, 0.04) | -1.44 | 0.152 | 33 | |Sepal.Length | Petal.Length | 0.87 | (0.83, 0.91) | 21.65 | < .001*** | 34 | |Sepal.Length | Petal.Width | 0.82 | (0.76, 0.86) | 17.30 | < .001*** | 35 | |Sepal.Width | Petal.Length | -0.43 | (-0.55, -0.29) | -5.77 | < .001*** | 36 | |Sepal.Width | Petal.Width | -0.37 | (-0.50, -0.22) | -4.79 | < .001*** | 37 | |Petal.Length | Petal.Width | 0.96 | (0.95, 0.97) | 43.39 | < .001*** | 38 | p-value adjustment method: Holm (1979) 39 | Observations: 150 40 | 41 | -------------------------------------------------------------------------------- /WIP/utils_bootstrapping.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | .bootstrap_data <- function(data, n) { 3 | # generate bootstrap resamples 4 | strap <- replicate(n, .resample(data), simplify = FALSE) 5 | 6 | # add resample ID, may be used for other functions 7 | for (i in seq_len(length(strap))) strap[[i]]$Resample_id <- i 8 | 9 | # return as list variable 10 | data.frame(bootstraps = I(strap)) 11 | } 12 | 13 | 14 | 15 | 16 | #' @keywords internal 17 | .resample <- function(data) { 18 | structure( 19 | class = "correlation_resample", 20 | list( 21 | data = data, 22 | id = sample(nrow(data), size = nrow(data), replace = TRUE) 23 | ) 24 | ) 25 | } 26 | 27 | 28 | 29 | 30 | #' @importFrom stats qt sd quantile na.omit 31 | #' @keywords internal 32 | .bootstrapped_ci <- function(data, select = NULL, method = c("normal", "quantile"), ci.lvl = .95) { 33 | # match arguments 34 | method <- match.arg(method) 35 | 36 | if (is.null(select)) { 37 | .dat <- data 38 | } else { 39 | .dat <- data[select] 40 | } 41 | 42 | # compute confidence intervals for all values 43 | .transform_boot_result(lapply(.dat, function(x) { 44 | # check if method should be based on t-distribution of 45 | # bootstrap values or quantiles 46 | if (method == "normal") { 47 | # get bootstrap standard error 48 | bootse <- stats::qt((1 + ci.lvl) / 2, df = length(stats::na.omit(x)) - 1) * stats::sd(x, na.rm = T) 49 | # lower and upper confidence interval 50 | ci <- mean(x, na.rm = T) + c(-bootse, bootse) 51 | } else { 52 | # CI based on quantiles of bootstrapped values 53 | ci <- stats::quantile(x, probs = c((1 - ci.lvl) / 2, (1 + ci.lvl) / 2)) 54 | } 55 | # give proper names 56 | names(ci) <- c("CI_low", "CI_high") 57 | ci 58 | })) 59 | } 60 | 61 | 62 | 63 | 64 | #' @keywords internal 65 | .transform_boot_result <- function(result) { 66 | as.data.frame(t(as.data.frame(result))) 67 | } 68 | 69 | 70 | 71 | 72 | #' @keywords internal 73 | as.data.frame.correlation_resample <- function(x, ...) { 74 | x$data[x$id, , drop = FALSE] 75 | } 76 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/selecting_variables.md: -------------------------------------------------------------------------------- 1 | # selecting specific variables works 2 | 3 | Code 4 | list(df1, df2, df3, df4) 5 | Output 6 | [[1]] 7 | # Correlation Matrix (pearson-method) 8 | 9 | Parameter1 | Parameter2 | r | 95% CI | t(30) | p 10 | ----------------------------------------------------------------- 11 | cyl | hp | 0.83 | [0.68, 0.92] | 8.23 | < .001*** 12 | wt | hp | 0.66 | [0.40, 0.82] | 4.80 | < .001*** 13 | 14 | p-value adjustment method: Holm (1979) 15 | Observations: 32 16 | 17 | [[2]] 18 | # Correlation Matrix (pearson-method) 19 | 20 | Group | Parameter1 | Parameter2 | r | 95% CI | t | df | p 21 | ----------------------------------------------------------------------------- 22 | 0 | cyl | hp | 0.85 | [0.64, 0.94] | 6.53 | 17 | < .001*** 23 | 0 | wt | hp | 0.68 | [0.33, 0.87] | 3.82 | 17 | 0.001** 24 | 1 | cyl | hp | 0.90 | [0.69, 0.97] | 6.87 | 11 | < .001*** 25 | 1 | wt | hp | 0.81 | [0.48, 0.94] | 4.66 | 11 | < .001*** 26 | 27 | p-value adjustment method: Holm (1979) 28 | Observations: 13-19 29 | 30 | [[3]] 31 | # Correlation Matrix (pearson-method) 32 | 33 | Parameter1 | Parameter2 | r | 95% CI | t(30) | p 34 | ----------------------------------------------------------------- 35 | wt | hp | 0.66 | [0.40, 0.82] | 4.80 | < .001*** 36 | 37 | p-value adjustment method: Holm (1979) 38 | Observations: 32 39 | 40 | [[4]] 41 | # Correlation Matrix (pearson-method) 42 | 43 | Parameter1 | Parameter2 | r | 95% CI | t(30) | p 44 | ----------------------------------------------------------------- 45 | wt | hp | 0.66 | [0.40, 0.82] | 4.80 | < .001*** 46 | 47 | p-value adjustment method: Holm (1979) 48 | Observations: 32 49 | 50 | 51 | -------------------------------------------------------------------------------- /man/cormatrix_to_excel.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cormatrix_to_excel.R 3 | \name{cormatrix_to_excel} 4 | \alias{cormatrix_to_excel} 5 | \title{Easy export of correlation matrix to Excel} 6 | \usage{ 7 | cormatrix_to_excel(data, filename, overwrite = TRUE, print.mat = TRUE, ...) 8 | } 9 | \arguments{ 10 | \item{data}{The data frame} 11 | 12 | \item{filename}{Desired filename (path can be added before hand 13 | but no need to specify extension).} 14 | 15 | \item{overwrite}{Whether to allow overwriting previous file.} 16 | 17 | \item{print.mat}{Logical, whether to also print the correlation matrix 18 | to console.} 19 | 20 | \item{...}{Parameters to be passed to \code{\link[=correlation]{correlation()}}} 21 | } 22 | \value{ 23 | A Microsoft Excel document, containing the colour-coded 24 | correlation matrix with significance stars, on the first 25 | sheet, and the colour-coded p-values on the second sheet. 26 | } 27 | \description{ 28 | Easily output a correlation matrix and export it to 29 | Microsoft Excel, with the first row and column frozen, and 30 | correlation coefficients colour-coded based on effect size 31 | (0.0-0.2: small (no colour); 0.2-0.4: medium (pink/light blue); 32 | 0.4-1.0: large (red/dark blue)), following Cohen's suggestions 33 | for small (.10), medium (.30), and large (.50) correlation sizes. 34 | } 35 | \examples{ 36 | \dontshow{if (requireNamespace("openxlsx2", quietly = TRUE)) withAutoprint(\{ # examplesIf} 37 | \dontshow{ 38 | .old_wd <- setwd(tempdir()) 39 | } 40 | # Basic example 41 | suppressWarnings(cormatrix_to_excel(mtcars, 42 | select = c("mpg", "cyl", "disp", "hp", "carb"), filename = "cormatrix1" 43 | )) 44 | suppressWarnings(cormatrix_to_excel(iris, 45 | p_adjust = "none", 46 | filename = "cormatrix2" 47 | )) 48 | suppressWarnings(cormatrix_to_excel(airquality, 49 | method = "spearman", 50 | filename = "cormatrix3" 51 | )) 52 | \dontshow{ 53 | setwd(.old_wd) 54 | } 55 | \dontshow{\}) # examplesIf} 56 | } 57 | \author{ 58 | Adapted from @JanMarvin (JanMarvin/openxlsx2#286) and 59 | the original \code{rempsyc::cormatrix_excel}. 60 | } 61 | \keyword{Excel} 62 | \keyword{correlation} 63 | \keyword{matrix} 64 | -------------------------------------------------------------------------------- /tests/testthat/test-cor_sort.R: -------------------------------------------------------------------------------- 1 | test_that("cor_sort", { 2 | # Basic ------------------------------------------------------------------- 3 | 4 | # Square 5 | r1 <- cor(mtcars) 6 | expect_equal(as.numeric(diag(r1)), rep(1, ncol(mtcars))) 7 | # heatmap(r1, Rowv = NA, Colv = NA) # visualize 8 | 9 | r1sort <- cor_sort(r1) 10 | expect_equal(as.numeric(diag(r1sort)), rep(1, ncol(mtcars))) 11 | # heatmap(r1sort, Rowv = NA, Colv = NA) # visualize 12 | 13 | # Non-square 14 | r2 <- cor(mtcars[names(mtcars)[1:5]], mtcars[names(mtcars)[6:11]]) 15 | expect_equal(rownames(r2), names(mtcars)[1:5]) 16 | expect_identical(colnames(r2), c("wt", "qsec", "vs", "am", "gear", "carb")) 17 | expect_identical(rownames(r2), c("mpg", "cyl", "disp", "hp", "drat")) 18 | # heatmap(r2, Rowv = NA, Colv = NA) # visualize 19 | 20 | r2sort <- cor_sort(r2) 21 | expect_false(all(rownames(r2sort) == names(mtcars)[1:5])) 22 | expect_identical(colnames(r2sort), c("am", "gear", "qsec", "vs", "wt", "carb")) 23 | expect_identical(rownames(r2sort), c("drat", "disp", "hp", "cyl", "mpg")) 24 | # heatmap(r2sort, Rowv = NA, Colv = NA) # visualize 25 | 26 | # correlation() ----------------------------------------------------------- 27 | # Square 28 | rez1 <- correlation::correlation(mtcars) 29 | rez1sort <- cor_sort(rez1) 30 | expect_false(all(rez1$Parameter1 == rez1sort$Parameter1)) 31 | 32 | # Non-square 33 | rez2 <- correlation::correlation(mtcars[names(mtcars)[1:5]], mtcars[names(mtcars)[6:11]]) 34 | rez2sort <- cor_sort(rez2) 35 | expect_false(all(rez2$Parameter1 == rez2sort$Parameter1)) 36 | 37 | # summary(correlation()) -------------------------------------------------- 38 | # Square 39 | rez1sum <- summary(rez1) # TODO: doesn't work with non-redundant 40 | # TODO: fix 41 | expect_error(cor_sort(rez1sum)) 42 | 43 | rez1sum <- summary(rez1, redundant = TRUE) 44 | rez1sumsort <- cor_sort(rez1sum) 45 | expect_false(all(rownames(rez1sumsort) == rownames(rez1sum))) 46 | 47 | # Non-square 48 | rez2sum <- summary(rez2) 49 | rez2sumsort <- cor_sort(rez2sum) 50 | expect_false(all(rownames(rez2sumsort) == rownames(rez2sum))) 51 | 52 | # as.matrix(correlation()) ------------------------------------------------ 53 | # TODO. 54 | m1 <- as.matrix(rez1) 55 | # m1sort <- as.matrix(rez1sort) 56 | }) 57 | -------------------------------------------------------------------------------- /man/cor_to_pcor.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cor_to_pcor.R, R/cor_to_spcor.R 3 | \name{cor_to_pcor} 4 | \alias{cor_to_pcor} 5 | \alias{pcor_to_cor} 6 | \alias{cor_to_spcor} 7 | \title{Correlation Matrix to (Semi) Partial Correlations} 8 | \usage{ 9 | cor_to_pcor(cor, tol = .Machine$double.eps^(2/3)) 10 | 11 | pcor_to_cor(pcor, tol = .Machine$double.eps^(2/3)) 12 | 13 | cor_to_spcor(cor = NULL, cov = NULL, tol = .Machine$double.eps^(2/3)) 14 | } 15 | \arguments{ 16 | \item{cor}{A correlation matrix, or a partial or a semipartial 17 | correlation matrix.} 18 | 19 | \item{tol}{Relative tolerance to detect zero singular values.} 20 | 21 | \item{pcor}{A correlation matrix, or a partial or a semipartial 22 | correlation matrix.} 23 | 24 | \item{cov}{A covariance matrix (or a vector of the SD of the variables). 25 | Required for semi-partial correlations.} 26 | } 27 | \value{ 28 | The (semi) partial correlation matrix. 29 | } 30 | \description{ 31 | Convert a correlation matrix to a (semi)partial correlation matrix. Partial 32 | correlations are a measure of the correlation between two variables that 33 | remains after controlling for (i.e., "partialling" out) all the other 34 | relationships. They can be used for graphical Gaussian models, as they 35 | represent the direct interactions between two variables, conditioned on all 36 | remaining variables. This means that the squared partial correlation between 37 | a predictor X1 and a response variable Y can be interpreted as the proportion 38 | of (unique) variance accounted for by X1 relative to the residual or 39 | unexplained variance of Y that cannot be accounted by the other variables. 40 | } 41 | \details{ 42 | The semi-partial correlation is similar to the partial correlation statistic. 43 | However, it represents (when squared) the proportion of (unique) variance 44 | accounted for by the predictor X1, relative to the total variance of Y. Thus, 45 | it might be seen as a better indicator of the "practical relevance" of a 46 | predictor, because it is scaled to (i.e., relative to) the total variability 47 | in the response variable. 48 | } 49 | \examples{ 50 | cor <- cor(iris[1:4]) 51 | 52 | # Partialize 53 | cor_to_pcor(cor) 54 | cor_to_spcor(cor, cov = sapply(iris[1:4], sd)) 55 | 56 | # Inverse 57 | round(pcor_to_cor(cor_to_pcor(cor)) - cor, 2) # Should be 0 58 | } 59 | -------------------------------------------------------------------------------- /man/display.easycormatrix.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/display.R, R/methods_print.R 3 | \name{display.easycormatrix} 4 | \alias{display.easycormatrix} 5 | \alias{print_md.easycorrelation} 6 | \alias{print_html.easycorrelation} 7 | \alias{print_md.easycormatrix} 8 | \alias{print_html.easycormatrix} 9 | \title{Export tables into different output formats} 10 | \usage{ 11 | \method{display}{easycormatrix}( 12 | object, 13 | format = "markdown", 14 | digits = 2, 15 | p_digits = 3, 16 | stars = TRUE, 17 | include_significance = NULL, 18 | ... 19 | ) 20 | 21 | \method{print_md}{easycorrelation}(x, digits = NULL, p_digits = NULL, stars = NULL, ...) 22 | 23 | \method{print_html}{easycorrelation}(x, digits = NULL, p_digits = NULL, stars = NULL, ...) 24 | 25 | \method{print_md}{easycormatrix}( 26 | x, 27 | digits = NULL, 28 | p_digits = NULL, 29 | stars = NULL, 30 | include_significance = NULL, 31 | ... 32 | ) 33 | 34 | \method{print_html}{easycormatrix}( 35 | x, 36 | digits = NULL, 37 | p_digits = NULL, 38 | stars = NULL, 39 | include_significance = NULL, 40 | ... 41 | ) 42 | } 43 | \arguments{ 44 | \item{object, x}{An object returned by 45 | \code{\link[=correlation]{correlation()}} or its summary.} 46 | 47 | \item{format}{String, indicating the output format. Currently, only 48 | \code{"markdown"} is supported.} 49 | 50 | \item{digits, p_digits}{To do...} 51 | 52 | \item{stars}{To do...} 53 | 54 | \item{include_significance}{To do...} 55 | 56 | \item{...}{Currently not used.} 57 | } 58 | \value{ 59 | A character vector. If \code{format = "markdown"}, the return value 60 | will be a character vector in markdown-table format. 61 | } 62 | \description{ 63 | Export tables (i.e. data frame) into different output formats. 64 | \code{print_md()} is a alias for \code{display(format = "markdown")}. Note that 65 | you can use \code{format()} to get the formatted table as a dataframe. 66 | } 67 | \details{ 68 | \code{display()} is useful when the table-output from functions, 69 | which is usually printed as formatted text-table to console, should 70 | be formatted for pretty table-rendering in markdown documents, or if 71 | knitted from rmarkdown to PDF or Word files. 72 | } 73 | \examples{ 74 | data(iris) 75 | corr <- correlation(iris) 76 | display(corr) 77 | 78 | s <- summary(corr) 79 | display(s) 80 | } 81 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/methods.md: -------------------------------------------------------------------------------- 1 | # summary.correlation - target column 2 | 3 | Code 4 | summary(correlation(ggplot2::msleep), target = "t") 5 | Output 6 | # Correlation Matrix (pearson-method) 7 | 8 | Parameter | bodywt | brainwt | awake | sleep_cycle | sleep_rem 9 | ------------------------------------------------------------------------ 10 | sleep_total | -2.96* | -2.84* | -5328.71*** | -2.95* | 8.76*** 11 | sleep_rem | -2.66* | -1.54 | -8.76*** | -1.97 | 12 | sleep_cycle | 2.52 | 8.60*** | 2.95* | | 13 | awake | 2.96* | 2.84* | | | 14 | brainwt | 19.18*** | | | | 15 | 16 | p-value adjustment method: Holm (1979) 17 | 18 | --- 19 | 20 | Code 21 | summary(correlation(ggplot2::msleep), target = "df_error") 22 | Output 23 | # Correlation Matrix (pearson-method) 24 | 25 | Parameter | bodywt | brainwt | awake | sleep_cycle | sleep_rem 26 | ---------------------------------------------------------------------- 27 | sleep_total | 81.00* | 54.00* | 81.00*** | 30.00* | 59.00*** 28 | sleep_rem | 59.00* | 46.00 | 59.00*** | 30.00 | 29 | sleep_cycle | 30.00 | 28.00*** | 30.00* | | 30 | awake | 81.00* | 54.00* | | | 31 | brainwt | 54.00*** | | | | 32 | 33 | p-value adjustment method: Holm (1979) 34 | 35 | --- 36 | 37 | Code 38 | summary(correlation(ggplot2::msleep), target = "p") 39 | Output 40 | # Correlation Matrix (pearson-method) 41 | 42 | Parameter | bodywt | brainwt | awake | sleep_cycle | sleep_rem 43 | ---------------------------------------------------------------- 44 | sleep_total | 0.04 | 0.05 | 0.00 | 0.05 | 0.00 45 | sleep_rem | 0.05 | 0.13 | 0.00 | 0.12 | 46 | sleep_cycle | 0.05 | 0.00 | 0.05 | | 47 | awake | 0.04 | 0.05 | | | 48 | brainwt | 0.00 | | | | 49 | 50 | p-value adjustment method: Holm (1979) 51 | 52 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(as.data.frame,easycorrelation) 4 | S3method(as.list,easycorrelation) 5 | S3method(as.matrix,easycorrelation) 6 | S3method(as.table,easycorrelation) 7 | S3method(cor_lower,easycorrelation) 8 | S3method(cor_smooth,easycorrelation) 9 | S3method(cor_smooth,matrix) 10 | S3method(cor_sort,easycormatrix) 11 | S3method(cor_sort,easycorrelation) 12 | S3method(cor_sort,matrix) 13 | S3method(cor_to_pcor,easycormatrix) 14 | S3method(cor_to_pcor,easycorrelation) 15 | S3method(cor_to_pcor,matrix) 16 | S3method(display,easycormatrix) 17 | S3method(display,easycorrelation) 18 | S3method(format,easycormatrix) 19 | S3method(format,easycorrelation) 20 | S3method(is.positive_definite,easycorrelation) 21 | S3method(is.positive_definite,matrix) 22 | S3method(pcor_to_cor,easycormatrix) 23 | S3method(pcor_to_cor,easycorrelation) 24 | S3method(pcor_to_cor,matrix) 25 | S3method(plot,easycor_test) 26 | S3method(plot,easycormatrix) 27 | S3method(plot,easycorrelation) 28 | S3method(print,easycormatrix) 29 | S3method(print,easycorrelation) 30 | S3method(print,easymatrixlist) 31 | S3method(print,grouped_easymatrixlist) 32 | S3method(print_html,easycormatrix) 33 | S3method(print_html,easycorrelation) 34 | S3method(print_md,easycormatrix) 35 | S3method(print_md,easycorrelation) 36 | S3method(standardize_names,easycorrelation) 37 | S3method(summary,easycorrelation) 38 | S3method(visualisation_recipe,easycor_test) 39 | S3method(visualisation_recipe,easycormatrix) 40 | S3method(visualisation_recipe,easycorrelation) 41 | export(cor_lower) 42 | export(cor_smooth) 43 | export(cor_sort) 44 | export(cor_test) 45 | export(cor_text) 46 | export(cor_to_ci) 47 | export(cor_to_cov) 48 | export(cor_to_p) 49 | export(cor_to_pcor) 50 | export(cor_to_spcor) 51 | export(cormatrix_to_excel) 52 | export(correlation) 53 | export(display) 54 | export(distance_mahalanobis) 55 | export(is.cor) 56 | export(is.positive_definite) 57 | export(isSquare) 58 | export(is_positive_definite) 59 | export(matrix_inverse) 60 | export(pcor_to_cor) 61 | export(print_html) 62 | export(print_md) 63 | export(simulate_simpson) 64 | export(standardize_names) 65 | export(visualisation_recipe) 66 | export(z_fisher) 67 | importFrom(bayestestR,simulate_simpson) 68 | importFrom(datawizard,visualisation_recipe) 69 | importFrom(insight,display) 70 | importFrom(insight,print_html) 71 | importFrom(insight,print_md) 72 | importFrom(insight,standardize_names) 73 | -------------------------------------------------------------------------------- /R/utils_create_diagonal.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | .create_diagonal <- function(params) { 3 | diagonal <- data.frame( 4 | "Parameter1" = unique(params$Parameter1), 5 | "Parameter2" = unique(params$Parameter1) 6 | ) 7 | 8 | if ("Group" %in% names(params)) diagonal$Group <- unique(params$Group)[1] 9 | if ("r" %in% names(params)) diagonal$r <- 1 10 | if ("rho" %in% names(params)) diagonal$rho <- 1 11 | if ("tau" %in% names(params)) diagonal$tau <- 1 12 | if ("p" %in% names(params)) diagonal$p <- 0 13 | if ("t" %in% names(params)) diagonal$t <- Inf 14 | if ("S" %in% names(params)) diagonal$S <- Inf 15 | if ("z" %in% names(params)) diagonal$z <- Inf 16 | if ("df" %in% names(params)) diagonal$df <- unique(params$df)[1] 17 | if ("df_error" %in% names(params)) diagonal$df_error <- unique(params$df_error)[1] 18 | if ("CI" %in% names(params)) diagonal$CI <- unique(params$CI)[1] 19 | if ("CI_low" %in% names(params)) diagonal$CI_low <- 1 20 | if ("CI_high" %in% names(params)) diagonal$CI_high <- 1 21 | if ("Method" %in% names(params)) diagonal$Method <- unique(params$Method)[1] 22 | if ("n_Obs" %in% names(params)) diagonal$n_Obs <- unique(params$n_Obs)[1] 23 | 24 | # Bayesian 25 | if ("Median" %in% names(params)) diagonal$Median <- 1 26 | if ("Mean" %in% names(params)) diagonal$Mean <- 1 27 | if ("MAP" %in% names(params)) diagonal$MAP <- 1 28 | if ("SD" %in% names(params)) diagonal$SD <- 0 29 | if ("MAD" %in% names(params)) diagonal$MAD <- 0 30 | if ("pd" %in% names(params)) diagonal$pd <- 1 31 | if ("ROPE_Percentage" %in% names(params)) diagonal$ROPE_Percentage <- 0 32 | if ("BF" %in% names(params)) diagonal$BF <- Inf 33 | if ("log_BF" %in% names(params)) diagonal$log_BF <- Inf 34 | if ("Prior_Distribution" %in% names(params)) diagonal$Prior_Distribution <- unique(params$Prior_Distribution)[1] 35 | if ("Prior_Location" %in% names(params)) diagonal$Prior_Location <- unique(params$Prior_Location)[1] 36 | if ("Prior_Scale" %in% names(params)) diagonal$Prior_Scale <- unique(params$Prior_Scale)[1] 37 | 38 | for (var in names(params)[!names(params) %in% names(diagonal)]) { 39 | if (length(unique(params[[var]])) > 1L) { 40 | insight::format_error("Something's unexpected happened when creating the diagonal data. Please open an issue at https://github.com/easystats/correlation/issues") 41 | } 42 | diagonal[[var]] <- unique(params[[var]])[1] 43 | } 44 | 45 | diagonal 46 | } 47 | -------------------------------------------------------------------------------- /R/cor_test_biserial.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | .cor_test_biserial <- function(data, x, y, ci = 0.95, method = "biserial", ...) { 3 | # valid matrix 4 | if (.vartype(data[[x]])$is_binary && !.vartype(data[[y]])$is_binary) { 5 | binary <- x 6 | continuous <- y 7 | } else if (.vartype(data[[y]])$is_binary && !.vartype(data[[x]])$is_binary) { 8 | binary <- y 9 | continuous <- x 10 | } else { 11 | insight::format_error( 12 | "Biserial and point-biserial correlations can only be applied for one dichotomous and one continuous variables." 13 | ) 14 | } 15 | 16 | # Rescale to 0-1 17 | if (.vartype(data[[binary]])$is_factor || .vartype(data[[binary]])$is_character) { 18 | data[[binary]] <- as.numeric(as.factor(data[[binary]])) 19 | } 20 | 21 | data[[binary]] <- as.vector( 22 | (data[[binary]] - min(data[[binary]], na.rm = TRUE)) / 23 | (diff(range(data[[binary]], na.rm = TRUE), na.rm = TRUE)) 24 | ) 25 | 26 | # Get biserial or point-biserial correlation 27 | if (method == "biserial") { 28 | out <- .cor_test_biserial_biserial(data, x, y, continuous, binary, ci) 29 | } else { 30 | out <- .cor_test_biserial_pointbiserial(data, x, y, continuous, binary, ci, ...) 31 | } 32 | 33 | out 34 | } 35 | 36 | 37 | #' @keywords internal 38 | .cor_test_biserial_pointbiserial <- function(data, x, y, continuous, binary, ci, ...) { 39 | out <- .cor_test_freq(data, continuous, binary, ci = ci, method = "pearson", ...) 40 | names(out)[names(out) == "r"] <- "rho" 41 | out$Parameter1 <- x 42 | out$Parameter2 <- y 43 | out$Method <- "Point-biserial" 44 | 45 | out 46 | } 47 | 48 | 49 | #' @keywords internal 50 | .cor_test_biserial_biserial <- function(data, x, y, continuous, binary, ci) { 51 | var_x <- .complete_variable_x(data, continuous, binary) 52 | var_y <- .complete_variable_y(data, continuous, binary) 53 | 54 | 55 | m1 <- mean(var_x[var_y == 1]) 56 | m0 <- mean(var_x[var_y == 0]) 57 | quan <- mean(var_y) 58 | p <- 1 - quan 59 | zp <- stats::dnorm(stats::qnorm(quan)) 60 | 61 | r <- (((m1 - m0) * (p * quan / zp)) / stats::sd(var_x)) 62 | 63 | p <- cor_to_p(r, n = length(var_x)) 64 | ci_vals <- cor_to_ci(r, n = length(var_x), ci = ci) 65 | 66 | data.frame( 67 | Parameter1 = x, 68 | Parameter2 = y, 69 | rho = r, 70 | t = p$statistic, 71 | df_error = length(var_y) - 2, 72 | p = p$p, 73 | CI_low = ci_vals$CI_low, 74 | CI_high = ci_vals$CI_high, 75 | Method = "Biserial", 76 | stringsAsFactors = FALSE 77 | ) 78 | } 79 | -------------------------------------------------------------------------------- /tests/testthat/_snaps/correlation.md: -------------------------------------------------------------------------------- 1 | # as.data.frame for correlation output 2 | 3 | Code 4 | as.data.frame(correlation(ggplot2::msleep)) 5 | Output 6 | Parameter1 Parameter2 r CI CI_low CI_high t 7 | 1 sleep_total sleep_rem 0.7517550 0.95 0.61667557 0.84383201 8.756396 8 | 2 sleep_total sleep_cycle -0.4737127 0.95 -0.70581894 -0.14975542 -2.946170 9 | 3 sleep_total awake -0.9999986 0.95 -0.99999908 -0.99999779 -5328.711772 10 | 4 sleep_total brainwt -0.3604874 0.95 -0.56942242 -0.10780364 -2.839979 11 | 5 sleep_total bodywt -0.3120106 0.95 -0.49442632 -0.10327118 -2.955645 12 | 6 sleep_rem sleep_cycle -0.3381235 0.95 -0.61438094 0.01198335 -1.967883 13 | 7 sleep_rem awake -0.7517713 0.95 -0.84384279 -0.61669876 -8.756832 14 | 8 sleep_rem brainwt -0.2213348 0.95 -0.47556189 0.06701441 -1.539344 15 | 9 sleep_rem bodywt -0.3276507 0.95 -0.53530394 -0.08264933 -2.663776 16 | 10 sleep_cycle awake 0.4737127 0.95 0.14975542 0.70581894 2.946170 17 | 11 sleep_cycle brainwt 0.8516203 0.95 0.70882870 0.92736294 8.597296 18 | 12 sleep_cycle bodywt 0.4178029 0.95 0.08089399 0.66902912 2.518773 19 | 13 awake brainwt 0.3604874 0.95 0.10780364 0.56942242 2.839979 20 | 14 awake bodywt 0.3119801 0.95 0.10323781 0.49440083 2.955326 21 | 15 brainwt bodywt 0.9337822 0.95 0.88916423 0.96081138 19.175704 22 | df_error p Method n_Obs 23 | 1 59 3.783810e-11 Pearson correlation 61 24 | 2 30 4.934837e-02 Pearson correlation 32 25 | 3 81 3.627785e-225 Pearson correlation 83 26 | 4 54 4.934837e-02 Pearson correlation 56 27 | 5 81 4.085332e-02 Pearson correlation 83 28 | 6 30 1.167709e-01 Pearson correlation 32 29 | 7 59 3.783810e-11 Pearson correlation 61 30 | 8 46 1.305716e-01 Pearson correlation 48 31 | 9 59 4.934837e-02 Pearson correlation 61 32 | 10 30 4.934837e-02 Pearson correlation 32 33 | 11 28 2.662362e-08 Pearson correlation 30 34 | 12 30 5.202211e-02 Pearson correlation 32 35 | 13 54 4.934837e-02 Pearson correlation 56 36 | 14 81 4.085332e-02 Pearson correlation 83 37 | 15 54 1.281756e-24 Pearson correlation 56 38 | 39 | -------------------------------------------------------------------------------- /R/cor_test_freq.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | .cor_test_freq <- function(data, x, y, ci = 0.95, method = "pearson", ...) { 3 | var_x <- .complete_variable_x(data, x, y) 4 | var_y <- .complete_variable_y(data, x, y) 5 | 6 | .cor_test_base(x, y, var_x, var_y, ci = ci, method = method, ...) 7 | } 8 | 9 | 10 | #' @keywords internal 11 | .cor_test_base <- function(x, y, var_x, var_y, ci = 0.95, method = "pearson", ...) { 12 | method <- match.arg(tolower(method), c("pearson", "kendall", "spearman", "somers"), several.ok = FALSE) 13 | rez <- stats::cor.test(var_x, var_y, conf.level = ci, method = method, exact = FALSE, ...) 14 | 15 | # params <- parameters::model_parameters(rez) 16 | # this doubles performance according to computation time 17 | params <- .extract_corr_parameters(rez) 18 | 19 | params$Parameter1 <- x 20 | params$Parameter2 <- y 21 | 22 | if (x == y) { 23 | if ("t" %in% names(params)) params$t <- Inf 24 | if ("z" %in% names(params)) params$z <- Inf 25 | if ("S" %in% names(params)) params$S <- Inf 26 | } 27 | 28 | # Add CI for non-pearson correlations 29 | if (method %in% c("kendall", "spearman")) { 30 | rez_ci <- cor_to_ci(rez$estimate, n = length(var_x), ci = ci, method = method, ...) 31 | params$CI_low <- rez_ci$CI_low 32 | params$CI_high <- rez_ci$CI_high 33 | } 34 | 35 | # see ?cor.test: CI only in case of at least 4 complete pairs of observations 36 | if (!("CI_low" %in% names(params))) params$CI_low <- NA 37 | if (!("CI_high" %in% names(params))) params$CI_high <- NA 38 | 39 | params 40 | } 41 | 42 | 43 | .extract_corr_parameters <- function(model) { 44 | data_names <- unlist(strsplit(model$data.name, " and ", fixed = TRUE)) 45 | out <- data.frame( 46 | Parameter1 = data_names[1], 47 | Parameter2 = data_names[2], 48 | stringsAsFactors = FALSE 49 | ) 50 | 51 | if (model$method == "Pearson's Chi-squared test") { 52 | out$Chi2 <- model$statistic 53 | out$df_error <- model$parameter 54 | out$p <- model$p.value 55 | out$Method <- "Pearson" 56 | } else if (grepl("Pearson", model$method, fixed = TRUE)) { 57 | out$r <- model$estimate 58 | out$t <- model$statistic 59 | out$df_error <- model$parameter 60 | out$p <- model$p.value 61 | out$CI_low <- model$conf.int[1] 62 | out$CI_high <- model$conf.int[2] 63 | out$Method <- "Pearson" 64 | } else if (grepl("Spearman", model$method, fixed = TRUE)) { 65 | out$rho <- model$estimate 66 | out$S <- model$statistic 67 | out$df_error <- model$parameter 68 | out$p <- model$p.value 69 | out$Method <- "Spearman" 70 | } else { 71 | out$tau <- model$estimate 72 | out$z <- model$statistic 73 | out$df_error <- model$parameter 74 | out$p <- model$p.value 75 | out$Method <- "Kendall" 76 | } 77 | out 78 | } 79 | -------------------------------------------------------------------------------- /R/cor_to_ci.R: -------------------------------------------------------------------------------- 1 | #' @rdname cor_to_p 2 | #' @param correction Only used if method is 'spearman' or 'kendall'. Can be 3 | #' 'fieller' (default; Fieller et al., 1957), 'bw' (only for Spearman) or 4 | #' 'none'. Bonett and Wright (2000) claim their correction ('bw') performs 5 | #' better, though the Bishara and Hittner (2017) paper favours the Fieller 6 | #' correction. Both are generally very similar. 7 | #' @export 8 | cor_to_ci <- function(cor, n, ci = 0.95, method = "pearson", correction = "fieller", ...) { 9 | method <- match.arg(tolower(method), c("pearson", "kendall", "spearman"), several.ok = FALSE) 10 | 11 | if (method == "kendall") { 12 | out <- .cor_to_ci_kendall(cor, n, ci = ci, correction = correction, ...) 13 | } else if (method == "spearman") { 14 | out <- .cor_to_ci_spearman(cor, n, ci = ci, correction = correction, ...) 15 | } else { 16 | out <- .cor_to_ci_pearson(cor, n, ci = ci, ...) 17 | } 18 | 19 | out 20 | } 21 | 22 | 23 | # Kendall ----------------------------------------------------------------- 24 | .cor_to_ci_kendall <- function(cor, n, ci = 0.95, correction = "fieller", ...) { 25 | # by @tsbaguley (https://rpubs.com/seriousstats/616206) 26 | 27 | if (correction == "fieller") { 28 | tau.se <- (0.437 / (n - 4))^0.5 29 | } else { 30 | tau.se <- 1 / (n - 3)^0.5 31 | } 32 | 33 | moe <- stats::qnorm(1 - (1 - ci) / 2) * tau.se 34 | zu <- atanh(cor) + moe 35 | zl <- atanh(cor) - moe 36 | 37 | # Convert back to r 38 | ci_low <- tanh(zl) 39 | ci_high <- tanh(zu) 40 | 41 | list(CI_low = ci_low, CI_high = ci_high) 42 | } 43 | 44 | 45 | # Spearman ----------------------------------------------------------------- 46 | .cor_to_ci_spearman <- function(cor, n, ci = 0.95, correction = "fieller", ...) { 47 | # by @tsbaguley (https://rpubs.com/seriousstats/616206) 48 | 49 | if (correction == "fieller") { 50 | zrs.se <- (1.06 / (n - 3))^0.5 51 | } else if (correction == "bw") { 52 | zrs.se <- ((1 + (cor^2) / 2) / (n - 3))^0.5 53 | } else { 54 | zrs.se <- 1 / (n - 3)^0.5 55 | } 56 | 57 | moe <- stats::qnorm(1 - (1 - ci) / 2) * zrs.se 58 | 59 | zu <- atanh(cor) + moe 60 | zl <- atanh(cor) - moe 61 | 62 | # Convert back to r 63 | ci_low <- tanh(zl) 64 | ci_high <- tanh(zu) 65 | 66 | list(CI_low = ci_low, CI_high = ci_high) 67 | } 68 | 69 | 70 | # Pearson ----------------------------------------------------------------- 71 | .cor_to_ci_pearson <- function(cor, n, ci = 0.95, ...) { 72 | z <- atanh(cor) 73 | se <- 1 / sqrt(n - 3) # Sample standard error 74 | 75 | # CI 76 | alpha <- 1 - (1 - ci) / 2 77 | ci_low <- z - se * stats::qnorm(alpha) 78 | ci_high <- z + se * stats::qnorm(alpha) 79 | 80 | # Convert back to r 81 | ci_low <- tanh(ci_low) 82 | ci_high <- tanh(ci_high) 83 | 84 | list(CI_low = ci_low, CI_high = ci_high) 85 | } 86 | -------------------------------------------------------------------------------- /R/display.R: -------------------------------------------------------------------------------- 1 | #' @title Export tables into different output formats 2 | #' @name display.easycormatrix 3 | #' 4 | #' @description Export tables (i.e. data frame) into different output formats. 5 | #' `print_md()` is a alias for `display(format = "markdown")`. Note that 6 | #' you can use `format()` to get the formatted table as a dataframe. 7 | #' 8 | #' @param object,x An object returned by 9 | #' [`correlation()`][correlation] or its summary. 10 | #' @param format String, indicating the output format. Currently, only 11 | #' `"markdown"` is supported. 12 | #' @param digits,p_digits To do... 13 | #' @param stars To do... 14 | #' @param include_significance To do... 15 | #' @param ... Currently not used. 16 | #' 17 | #' @return A character vector. If `format = "markdown"`, the return value 18 | #' will be a character vector in markdown-table format. 19 | #' 20 | #' @details `display()` is useful when the table-output from functions, 21 | #' which is usually printed as formatted text-table to console, should 22 | #' be formatted for pretty table-rendering in markdown documents, or if 23 | #' knitted from rmarkdown to PDF or Word files. 24 | #' 25 | #' @examples 26 | #' data(iris) 27 | #' corr <- correlation(iris) 28 | #' display(corr) 29 | #' 30 | #' s <- summary(corr) 31 | #' display(s) 32 | #' @export 33 | display.easycormatrix <- function(object, 34 | format = "markdown", 35 | digits = 2, 36 | p_digits = 3, 37 | stars = TRUE, 38 | include_significance = NULL, 39 | ...) { 40 | if (format == "markdown") { 41 | print_md( 42 | x = object, 43 | digits = digits, 44 | p_digits = p_digits, 45 | stars = stars, 46 | include_significance = include_significance, 47 | ... 48 | ) 49 | } else { 50 | print_html( 51 | x = object, 52 | digits = digits, 53 | p_digits = p_digits, 54 | stars = stars, 55 | include_significance = include_significance, 56 | ... 57 | ) 58 | } 59 | } 60 | 61 | 62 | #' @export 63 | display.easycorrelation <- function(object, 64 | format = "markdown", 65 | digits = 2, 66 | p_digits = 3, 67 | stars = TRUE, 68 | ...) { 69 | if (format == "markdown") { 70 | print_md( 71 | x = object, 72 | digits = digits, 73 | p_digits = p_digits, 74 | stars = stars, 75 | ... 76 | ) 77 | } else { 78 | print_html( 79 | x = object, 80 | digits = digits, 81 | p_digits = p_digits, 82 | stars = stars, 83 | ... 84 | ) 85 | } 86 | } 87 | -------------------------------------------------------------------------------- /R/cor_text.R: -------------------------------------------------------------------------------- 1 | #' Correlation text 2 | #' 3 | #' This function returns a formatted character of correlation statistics. 4 | #' 5 | #' @param x A dataframe with correlation statistics. 6 | #' @param show_ci,show_statistic,show_sig Toggle on/off different parts of the text. 7 | #' @param ... Other arguments to be passed to or from other functions. 8 | #' 9 | #' @examples 10 | #' rez <- cor_test(mtcars, "mpg", "wt") 11 | #' 12 | #' cor_text(rez) 13 | #' cor_text(rez, show_statistic = FALSE, show_ci = FALSE, stars = TRUE) 14 | #' 15 | #' rez <- correlation(mtcars) 16 | #' 17 | #' cor_text(rez) 18 | #' @export 19 | cor_text <- function(x, show_ci = TRUE, show_statistic = TRUE, show_sig = TRUE, ...) { 20 | # Estimate 21 | candidates <- c("rho", "r", "tau", "Difference", "r_rank_biserial") 22 | estimate <- candidates[candidates %in% names(x)][1] 23 | out_text <- paste0(tolower(estimate), " = ", insight::format_value(x[[estimate]])) 24 | 25 | # CI 26 | if (show_ci && all(c("CI_high", "CI_low") %in% names(x))) { 27 | if (!is.null(attributes(x$conf.int)$conf.level)) { 28 | # htest 29 | out_text <- paste0( 30 | out_text, 31 | ", ", 32 | insight::format_ci(x$CI_low, x$CI_high, ci = attributes(x$conf.int)$conf.level) 33 | ) 34 | } else if ("CI" %in% names(x)) { 35 | # param 36 | out_text <- paste0( 37 | out_text, 38 | ", ", 39 | insight::format_ci(x$CI_low, x$CI_high, ci = x$CI) 40 | ) 41 | } else if ("ci" %in% names(attributes(x))) { 42 | # param 43 | out_text <- paste0( 44 | out_text, 45 | ", ", 46 | insight::format_ci(x$CI_low, x$CI_high, ci = attributes(x)$ci) 47 | ) 48 | } 49 | } 50 | 51 | # Statistic 52 | if (show_statistic) { 53 | if ("t" %in% names(x)) { 54 | out_text <- paste0( 55 | out_text, 56 | ", t(", 57 | insight::format_value(x$df_error, protect_integers = TRUE), 58 | ") = ", 59 | insight::format_value(x$t) 60 | ) 61 | } else if ("S" %in% names(x)) { 62 | out_text <- paste0(out_text, ", S = ", insight::format_value(x$S)) 63 | } else if ("z" %in% names(x)) { 64 | out_text <- paste0(out_text, ", z = ", insight::format_value(table$z)) 65 | } else if ("W" %in% names(x)) { 66 | out_text <- paste0("W = ", insight::format_value(x$W)) 67 | } else if ("Chi2" %in% names(x)) { 68 | out_text <- paste0(out_text, ", Chi2 = ", insight::format_value(x$Chi2)) 69 | } 70 | } 71 | 72 | # Significance 73 | if (show_sig) { 74 | if ("p" %in% names(x)) { 75 | out_text <- paste0(out_text, ", ", insight::format_p(x$p, digits = "apa", ...)) 76 | } else if ("BF" %in% names(x)) { 77 | exact <- match.call()[["exact"]] 78 | if (is.null(exact)) exact <- TRUE 79 | out_text <- paste0(out_text, ", ", insight::format_bf(x$BF, exact = exact, ...)) 80 | } else if ("pd" %in% names(x)) { 81 | out_text <- paste0(out_text, ", ", insight::format_pd(x$pd, ...)) 82 | } 83 | } 84 | 85 | out_text 86 | } 87 | -------------------------------------------------------------------------------- /man/cor_to_p.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cor_to_ci.R, R/cor_to_p.R 3 | \name{cor_to_ci} 4 | \alias{cor_to_ci} 5 | \alias{cor_to_p} 6 | \title{Convert correlation to p-values and CIs} 7 | \usage{ 8 | cor_to_ci(cor, n, ci = 0.95, method = "pearson", correction = "fieller", ...) 9 | 10 | cor_to_p(cor, n, method = "pearson") 11 | } 12 | \arguments{ 13 | \item{cor}{A correlation matrix or coefficient.} 14 | 15 | \item{n}{The sample size (number of observations).} 16 | 17 | \item{ci}{Confidence/Credible Interval level. If \code{"default"}, then it is 18 | set to \code{0.95} (\verb{95\%} CI).} 19 | 20 | \item{method}{A character string indicating which correlation coefficient is 21 | to be used for the test. One of \code{"pearson"} (default), \code{"kendall"}, 22 | \code{"spearman"} (but see also the \code{robust} argument), \code{"biserial"}, 23 | \code{"polychoric"}, \code{"tetrachoric"}, \code{"biweight"}, \code{"distance"}, \code{"percentage"} 24 | (for percentage bend correlation), \code{"blomqvist"} (for Blomqvist's 25 | coefficient), \code{"hoeffding"} (for Hoeffding's D), \code{"gamma"}, \code{"gaussian"} 26 | (for Gaussian Rank correlation) or \code{"shepherd"} (for Shepherd's Pi 27 | correlation). Setting \code{"auto"} will attempt at selecting the most relevant 28 | method (polychoric when ordinal factors involved, tetrachoric when 29 | dichotomous factors involved, point-biserial if one dichotomous and one 30 | continuous and pearson otherwise). See below the \strong{details} section for a 31 | description of these indices.} 32 | 33 | \item{correction}{Only used if method is 'spearman' or 'kendall'. Can be 34 | 'fieller' (default; Fieller et al., 1957), 'bw' (only for Spearman) or 35 | 'none'. Bonett and Wright (2000) claim their correction ('bw') performs 36 | better, though the Bishara and Hittner (2017) paper favours the Fieller 37 | correction. Both are generally very similar.} 38 | 39 | \item{...}{Additional arguments (e.g., \code{alternative}) to be passed to 40 | other methods. See \code{stats::cor.test} for further details.} 41 | } 42 | \value{ 43 | A list containing a \emph{p}-value and the statistic or the CI bounds. 44 | } 45 | \description{ 46 | Get statistics, \emph{p}-values and confidence intervals (CI) from correlation 47 | coefficients. 48 | } 49 | \examples{ 50 | cor.test(iris$Sepal.Length, iris$Sepal.Width) 51 | cor_to_p(-0.1175698, n = 150) 52 | cor_to_p(cor(iris[1:4]), n = 150) 53 | cor_to_ci(-0.1175698, n = 150) 54 | cor_to_ci(cor(iris[1:4]), n = 150) 55 | 56 | cor.test(iris$Sepal.Length, iris$Sepal.Width, method = "spearman", exact = FALSE) 57 | cor_to_p(-0.1667777, n = 150, method = "spearman") 58 | cor_to_ci(-0.1667777, ci = 0.95, n = 150) 59 | 60 | cor.test(iris$Sepal.Length, iris$Sepal.Width, method = "kendall", exact = FALSE) 61 | cor_to_p(-0.07699679, n = 150, method = "kendall") 62 | 63 | } 64 | \references{ 65 | Bishara, A. J., & Hittner, J. B. (2017). Confidence intervals for 66 | correlations when data are not normal. Behavior research methods, 49(1), 67 | 294-309. 68 | } 69 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Type: Package 2 | Package: correlation 3 | Title: Methods for Correlation Analysis 4 | Version: 0.8.8.1 5 | Authors@R: 6 | c(person(given = "Dominique", 7 | family = "Makowski", 8 | role = c("aut", "inv"), 9 | email = "dom.makowski@gmail.com", 10 | comment = c(ORCID = "0000-0001-5375-9967")), 11 | person(given = "Brenton M.", 12 | family = "Wiernik", 13 | role = c("aut", "cre"), 14 | email = "brenton@wiernik.org", 15 | comment = c(ORCID = "0000-0001-9560-6336")), 16 | person(given = "Indrajeet", 17 | family = "Patil", 18 | role = "aut", 19 | email = "patilindrajeet.science@gmail.com", 20 | comment = c(ORCID = "0000-0003-1995-6531")), 21 | person(given = "Daniel", 22 | family = "Lüdecke", 23 | role = "aut", 24 | email = "d.luedecke@uke.de", 25 | comment = c(ORCID = "0000-0002-8895-3206")), 26 | person(given = "Mattan S.", 27 | family = "Ben-Shachar", 28 | role = "aut", 29 | email = "matanshm@post.bgu.ac.il", 30 | comment = c(ORCID = "0000-0002-4287-4801")), 31 | person(given = "Rémi", 32 | family = "Thériault", 33 | role = c("aut"), 34 | email = "remi.theriault@mail.mcgill.ca", 35 | comment = c(ORCID = "0000-0003-4315-6788")), 36 | person(given = "Mark", 37 | family = "White", 38 | email = "markhwhiteii@gmail.com", 39 | role = "rev"), 40 | person(given = "Maximilian M.", 41 | family = "Rabe", 42 | email = "maximilian.rabe@uni-potsdam.de", 43 | role = "rev", 44 | comment = c(ORCID = "0000-0002-2556-5644"))) 45 | Maintainer: Brenton M. Wiernik 46 | Description: Lightweight package for computing different kinds 47 | of correlations, such as partial correlations, Bayesian correlations, 48 | multilevel correlations, polychoric correlations, biweight 49 | correlations, distance correlations and more. Part of the 'easystats' 50 | ecosystem. References: Makowski et al. (2020) . 51 | License: MIT + file LICENSE 52 | URL: https://easystats.github.io/correlation/ 53 | BugReports: https://github.com/easystats/correlation/issues 54 | Depends: 55 | R (>= 4.1) 56 | Imports: 57 | bayestestR (>= 0.17.0), 58 | datasets, 59 | datawizard (>= 1.2.0), 60 | insight (>= 1.4.2), 61 | parameters (>= 0.28.2), 62 | stats 63 | Suggests: 64 | BayesFactor, 65 | energy, 66 | ggplot2, 67 | ggraph, 68 | gt, 69 | Hmisc, 70 | knitr, 71 | lme4, 72 | MASS, 73 | mbend, 74 | polycor, 75 | poorman, 76 | ppcor, 77 | psych, 78 | rmarkdown, 79 | rmcorr, 80 | rstanarm, 81 | see (>= 0.8.1), 82 | testthat (>= 3.2.1), 83 | tidygraph, 84 | wdm, 85 | WRS2, 86 | openxlsx2 (>= 1.0) 87 | VignetteBuilder: 88 | knitr 89 | Encoding: UTF-8 90 | Language: en-US 91 | RoxygenNote: 7.3.3 92 | Roxygen: list(markdown = TRUE) 93 | Config/testthat/edition: 3 94 | Config/Needs/website: 95 | rstudio/bslib, 96 | r-lib/pkgdown, 97 | easystats/easystatstemplate 98 | -------------------------------------------------------------------------------- /.github/CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # Contribution Guidelines 2 | 3 | easystats guidelines 0.1.0 4 | 5 | **All people are very much welcome to contribute to code, documentation, testing and suggestions.** 6 | 7 | This package aims at being beginner-friendly. Even if you're new to this open-source way of life, new to coding and github stuff, we encourage you to try submitting pull requests (PRs). 8 | 9 | - **"I'd like to help, but I'm not good enough with programming yet"** 10 | 11 | It's alright, don't worry! You can always dig in the code, in the documentation or tests. There are always some typos to fix, some docs to improve, some details to add, some code lines to document, some tests to add... **Even the smaller PRs are appreciated**. 12 | 13 | - **"I'd like to help, but I don't know where to start"** 14 | 15 | You can look around the **issue section** to find some features / ideas / bugs to start working on. You can also open a new issue **just to say that you're there, interested in helping out**. We might have some ideas adapted to your skills. 16 | 17 | - **"I'm not sure if my suggestion or idea is worthwile"** 18 | 19 | Enough with the impostor syndrom! All suggestions and opinions are good, and even if it's just a thought or so, it's always good to receive feedback. 20 | 21 | - **"Why should I waste my time with this? Do I get any credit?"** 22 | 23 | Software contributions are getting more and more valued in the academic world, so it is a good time to collaborate with us! Authors of substantial contributions will be added within the **authors** list. We're also very keen on including them to eventual academic publications. 24 | 25 | 26 | **Anyway, starting is the most important! You will then enter a *whole new world, a new fantastic point of view*... So fork this repo, do some changes and submit them. We will then work together to make the best out of it :)** 27 | 28 | 29 | ## Code 30 | 31 | - Please document and comment your code, so that the purpose of each step (or code line) is stated in a clear and understandable way. 32 | - Before submitting a change, please read the [**R style guide**](https://style.tidyverse.org/) and in particular our [**easystats convention of code-style**](https://github.com/easystats/easystats#convention-of-code-style) to keep some consistency in code formatting. 33 | - Regarding the style guide, note this exception: we put readability and clarity before everything. Thus, we like underscores and full names (prefer `model_performance` over `modelperf` and `interpret_odds_logistic` over `intoddslog`). 34 | - Before you start to code, make sure you're on the `dev` branch (the most "advanced"). Then, you can create a new branch named by your feature (e.g., `feature_lightsaber`) and do your changes. Finally, submit your branch to be merged into the `dev` branch. Then, every now and then, the dev branch will merge into `main`, as a new package version. 35 | 36 | ## Checks to do before submission 37 | 38 | - Make sure **documentation** (roxygen) is good 39 | - Make sure to add **tests** for the new functions 40 | - Run: 41 | 42 | - `styler::style_pkg()`: Automatic style formatting 43 | - `lintr::lint_package()`: Style checks 44 | - `devtools::check()`: General checks 45 | 46 | 47 | 48 | ## Useful Materials 49 | 50 | - [Understanding the GitHub flow](https://guides.github.com/introduction/flow/) 51 | 52 | 53 | -------------------------------------------------------------------------------- /R/cor_test_distance.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | .cor_test_distance <- function(data, x, y, ci = 0.95, corrected = TRUE, ...) { 3 | var_x <- .complete_variable_x(data, x, y) 4 | var_y <- .complete_variable_y(data, x, y) 5 | 6 | if (corrected) { 7 | rez <- .cor_test_distance_corrected(var_x, var_y, ci = ci) 8 | rez <- data.frame( 9 | Parameter1 = x, 10 | Parameter2 = y, 11 | r = rez$r, 12 | CI_low = rez$CI_low, 13 | CI_high = rez$CI_high, 14 | t = rez$t, 15 | df_error = rez$df_error, 16 | p = rez$p, 17 | Method = "Distance (Bias Corrected)", 18 | stringsAsFactors = FALSE 19 | ) 20 | } else { 21 | rez <- .cor_test_distance_raw(var_x, var_y, index = 1) 22 | rez <- data.frame( 23 | Parameter1 = x, 24 | Parameter2 = y, 25 | r = rez$r, 26 | CI_low = NA, 27 | CI_high = NA, 28 | t = NA, 29 | df_error = NA, 30 | p = NA, 31 | Method = "Distance", 32 | stringsAsFactors = FALSE 33 | ) 34 | } 35 | 36 | rez 37 | } 38 | 39 | 40 | # Basis ------------------------------------------------------------------- 41 | 42 | 43 | #' @keywords internal 44 | .cor_test_distance_corrected <- function(x, y, ci = 0.95) { 45 | x <- as.matrix(stats::dist(x)) 46 | y <- as.matrix(stats::dist(y)) 47 | n <- nrow(x) 48 | 49 | A <- .A_star(x) 50 | B <- .A_star(y) 51 | 52 | XY <- (sum(A * B) - (n / (n - 2)) * sum(diag(A * B))) / n^2 53 | XX <- (sum(A * A) - (n / (n - 2)) * sum(diag(A * A))) / n^2 54 | YY <- (sum(B * B) - (n / (n - 2)) * sum(diag(B * B))) / n^2 55 | 56 | r <- XY / sqrt(XX * YY) 57 | 58 | M <- n * (n - 3) / 2 59 | dof <- M - 1 60 | 61 | tstat <- sqrt(M - 1) * r / sqrt(1 - r^2) 62 | p <- 1 - stats::pt(tstat, df = dof) 63 | 64 | ci_vals <- cor_to_ci(r, n = n, ci = ci) 65 | 66 | list( 67 | r = r, 68 | t = tstat, 69 | df_error = dof, 70 | p = p, 71 | CI_low = ci_vals$CI_low, 72 | CI_high = ci_vals$CI_high 73 | ) 74 | } 75 | 76 | 77 | #' @keywords internal 78 | .cor_test_distance_raw <- function(x, y, index = 1) { 79 | if (index < 0 || index > 2) { 80 | insight::format_error("`index` must be between 0 and 2.") 81 | index <- 1.0 82 | } 83 | 84 | x <- as.matrix(stats::dist(x)) 85 | y <- as.matrix(stats::dist(y)) 86 | 87 | A <- .A_kl(x, index) 88 | B <- .A_kl(y, index) 89 | 90 | cov_ab <- sqrt(mean(A * B)) 91 | dVarX <- sqrt(mean(A * A)) 92 | dVarY <- sqrt(mean(B * B)) 93 | V <- sqrt(dVarX * dVarY) 94 | if (V > 0) { 95 | r <- cov_ab / V 96 | } else { 97 | r <- 0 98 | } 99 | list(r = r, cov = cov_ab) 100 | } 101 | 102 | 103 | # Utils ------------------------------------------------------------------- 104 | 105 | 106 | #' @keywords internal 107 | .A_kl <- function(x, index) { 108 | d <- as.matrix(x)^index 109 | m <- rowMeans(d) 110 | M <- mean(d) 111 | a <- sweep(d, 1, m) 112 | b <- sweep(a, 2, m) 113 | (b + M) 114 | } 115 | 116 | 117 | #' @keywords internal 118 | .A_star <- function(d) { 119 | ## d is a distance matrix or distance object 120 | ## modified or corrected doubly centered distance matrices 121 | ## denoted A* (or B*) in JMVA t-test paper (2013) 122 | d <- as.matrix(d) 123 | n <- nrow(d) 124 | if (n != ncol(d)) stop("Argument d should be distance", call. = FALSE) 125 | m <- rowMeans(d) 126 | M <- mean(d) 127 | a <- sweep(d, 1, m) 128 | b <- sweep(a, 2, m) 129 | A <- b + M # same as plain A 130 | # correction to get A^* 131 | A <- A - d / n 132 | diag(A) <- m - M 133 | (n / (n - 1)) * A 134 | } 135 | -------------------------------------------------------------------------------- /man/visualisation_recipe.easycormatrix.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/visualisation_recipe.cor_test.R, 3 | % R/visualisation_recipe.easycormatrix.R, 4 | % R/visualisation_recipe.easycorrelation.R 5 | \name{visualisation_recipe.easycor_test} 6 | \alias{visualisation_recipe.easycor_test} 7 | \alias{visualisation_recipe.easycormatrix} 8 | \alias{visualisation_recipe.easycorrelation} 9 | \title{Visualisation Recipe for 'correlation' Objects} 10 | \usage{ 11 | \method{visualisation_recipe}{easycor_test}( 12 | x, 13 | show_data = "point", 14 | show_text = "subtitle", 15 | smooth = NULL, 16 | point = NULL, 17 | text = NULL, 18 | labs = NULL, 19 | ... 20 | ) 21 | 22 | \method{visualisation_recipe}{easycormatrix}( 23 | x, 24 | show_data = "tile", 25 | show_text = "text", 26 | show_legend = TRUE, 27 | tile = NULL, 28 | point = NULL, 29 | text = NULL, 30 | scale = NULL, 31 | scale_fill = NULL, 32 | labs = NULL, 33 | type = show_data, 34 | ... 35 | ) 36 | 37 | \method{visualisation_recipe}{easycorrelation}(x, ...) 38 | } 39 | \arguments{ 40 | \item{x}{A correlation object.} 41 | 42 | \item{show_data}{Show data. For correlation matrices, can be \code{"tile"} 43 | (default) or \code{"point"}.} 44 | 45 | \item{show_text}{Show labels with matrix values.} 46 | 47 | \item{...}{Other arguments passed to other functions.} 48 | 49 | \item{show_legend}{Show legend. Can be set to \code{FALSE} to remove the legend.} 50 | 51 | \item{tile, point, text, scale, scale_fill, smooth, labs}{Additional aesthetics and 52 | parameters for the geoms (see customization example).} 53 | 54 | \item{type}{Alias for \code{show_data}, for backwards compatibility.} 55 | } 56 | \description{ 57 | Objects from the \code{correlation} package can be easily visualized. You can 58 | simply run \code{plot()} on them, which will internally call the \code{visualisation_recipe()} 59 | method to produce a basic \code{ggplot}. You can customize this plot ad-hoc or via 60 | the arguments described below. 61 | See examples \href{https://easystats.github.io/correlation/reference/visualisation_recipe.easycormatrix.html#ref-examples}{\strong{here}}. 62 | } 63 | \examples{ 64 | \dontshow{if (require("see")) withAutoprint(\{ # examplesIf} 65 | \donttest{ 66 | rez <- cor_test(mtcars, "mpg", "wt") 67 | 68 | layers <- visualisation_recipe(rez, labs = list(x = "Miles per Gallon (mpg)")) 69 | layers 70 | plot(layers) 71 | 72 | plot(rez, 73 | show_text = "label", 74 | point = list(color = "#f44336"), 75 | text = list(fontface = "bold"), 76 | show_statistic = FALSE, show_ci = FALSE, stars = TRUE 77 | ) 78 | } 79 | \dontshow{\}) # examplesIf} 80 | \dontshow{if (require("see")) withAutoprint(\{ # examplesIf} 81 | \donttest{ 82 | rez <- correlation(mtcars) 83 | 84 | x <- cor_sort(as.matrix(rez)) 85 | layers <- visualisation_recipe(x) 86 | layers 87 | plot(layers) 88 | 89 | #' Get more details using `summary()` 90 | x <- summary(rez, redundant = TRUE, digits = 3) 91 | plot(visualisation_recipe(x)) 92 | 93 | # Customize 94 | x <- summary(rez) 95 | layers <- visualisation_recipe(x, 96 | show_data = "points", 97 | scale = list(range = c(10, 20)), 98 | scale_fill = list( 99 | high = "#FF5722", 100 | low = "#673AB7", 101 | name = "r" 102 | ), 103 | text = list(color = "white"), 104 | labs = list(title = "My Plot") 105 | ) 106 | plot(layers) + theme_modern() 107 | } 108 | \dontshow{\}) # examplesIf} 109 | \dontshow{if (require("see") && require("tidygraph") && require("ggraph")) withAutoprint(\{ # examplesIf} 110 | \donttest{ 111 | rez <- correlation(iris) 112 | 113 | layers <- visualisation_recipe(rez) 114 | layers 115 | plot(layers) 116 | } 117 | \dontshow{\}) # examplesIf} 118 | } 119 | -------------------------------------------------------------------------------- /paper/make_figures.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | library(correlation) 3 | library(see) 4 | 5 | 6 | 7 | # Figure 1 ---------------------------------------------------------------- 8 | 9 | # Generate data 10 | set.seed(333) 11 | data <- bayestestR::simulate_correlation(n = 200, r = 0.05) 12 | data$V2 <- data$V2 + datawizard::data_rescale(data$V1, to = c(0, 2))^3 13 | 14 | data <- arrange(data, V2) 15 | 16 | # Outliers 17 | data$V2[c(150, 185)] <- c(max(data$V2) * 1, max(data$V2) * 1) 18 | data$V2[c(1, 5, 10)] <- c(min(data$V2) * 2, max(data$V2) * 1, min(data$V2) * 1.5) 19 | 20 | # Rescale to match coef 21 | data$V2 <- datawizard::data_rescale(data$V2, to = c(0, 1)) 22 | 23 | 24 | # Correlation results 25 | rez <- rbind( 26 | select(cor_test(data, "V1", "V2", method = "Pearson"), r, CI_low, CI_high, Method), 27 | select(cor_test(data, "V1", "V2", method = "Spearman"), r = rho, CI_low, CI_high, Method), 28 | select(cor_test(data, "V1", "V2", method = "Kendall"), r = tau, CI_low, CI_high, Method), 29 | select(cor_test(data, "V1", "V2", method = "biweight"), r, CI_low, CI_high, Method), 30 | select(cor_test(data, "V1", "V2", method = "percentage"), r, CI_low, CI_high, Method), 31 | select(cor_test(data, "V1", "V2", method = "distance", corrected = FALSE), r, CI_low, CI_high, Method), 32 | select(cor_test(data, "V1", "V2", method = "shepherd"), r = rho, CI_low, CI_high, Method), 33 | mutate(select(cor_test(data, "V1", "V2", method = "Pearson", bayesian = TRUE), r = rho, CI_low, CI_high), Method = "Bayesian") 34 | ) 35 | 36 | # Format correlation to match data input from scatter 37 | rez <- rez %>% 38 | arrange(r) %>% 39 | mutate( 40 | Method = forcats::fct_reorder(as.factor(Method), r), 41 | V2 = r, 42 | x = stringr::str_remove_all(levels(ggplot2::cut_interval(data$V1, n = n())), "[\\(\\[\\]]") 43 | ) %>% 44 | separate(x, into = c("low", "high"), sep = ",") %>% 45 | mutate(V1 = (as.numeric(high) + as.numeric(low)) / 2) 46 | 47 | # Fill empty CIs 48 | # rez[rez$Method=="Spearman", c("CI_low", "CI_high")] <- rep(rez[rez$Method=="Spearman", "r"], 2) 49 | # rez[rez$Method=="Kendall", c("CI_low", "CI_high")] <- rep(rez[rez$Method=="Kendall", "r"], 2) 50 | 51 | 52 | # Initialize plot 53 | fig1 <- ggplot(data, aes(x = V1, y = V2)) + 54 | see::theme_modern() + 55 | theme( 56 | axis.title.x = element_blank(), 57 | axis.text.x = element_blank() 58 | ) + 59 | ylab("Correlation Coefficient") + 60 | scale_colour_material_d("rainbow") + 61 | 62 | # rez plot 63 | geom_segment(data = rez, aes(xend = V1, yend = -Inf, colour = Method), size = 20, alpha = 0.6, key_glyph = "point") + 64 | # geom_bar(data=rez, aes(fill=Method), stat = "identity") 65 | geom_errorbar( 66 | data = rez, 67 | aes(ymin = CI_low, ymax = CI_high, colour = Method), 68 | size = 1.5, 69 | width = 0.15, 70 | alpha = 0.8, 71 | key_glyph = "point" 72 | ) + 73 | # geom_point(data=rez, aes(colour=Method), size=5, key_glyph = "point") + 74 | 75 | # Scatter 76 | geom_point2(size = 3, alpha = 0.7) + 77 | geom_smooth(method = "lm", colour = "black", alpha = 0.1, se = FALSE) + 78 | guides(color = guide_legend(override.aes = list(size = 5))) 79 | fig1 80 | 81 | ggsave("figure1.png", fig1, height = 6, width = see::golden_ratio(6), dpi = 300) 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | # Figure 2 ---------------------------------------------------------------- 93 | 94 | fig2 <- correlation(iris) %>% 95 | as.table() %>% 96 | plot() 97 | 98 | ggsave("figure2.png", fig2, height = 5, width = see::golden_ratio(5), dpi = 300) 99 | 100 | 101 | # Figure 3 ---------------------------------------------------------------- 102 | 103 | library(ggraph) # needs to be loaded 104 | 105 | fig3 <- mtcars %>% 106 | correlation(partial = TRUE) %>% 107 | plot() 108 | 109 | ggsave("figure3.png", fig3, height = 8, width = see::golden_ratio(8), dpi = 300) 110 | -------------------------------------------------------------------------------- /vignettes/multilevel.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Multilevel Correlations" 3 | output: 4 | rmarkdown::html_vignette: 5 | toc: true 6 | fig_width: 10.08 7 | fig_height: 6 8 | tags: [r, correlation, types] 9 | vignette: > 10 | %\VignetteIndexEntry{Multilevel Correlations} 11 | \usepackage[utf8]{inputenc} 12 | %\VignetteEngine{knitr::rmarkdown} 13 | editor_options: 14 | chunk_output_type: console 15 | bibliography: bibliography.bib 16 | --- 17 | 18 | --- 19 | 20 | This vignette can be cited as: 21 | 22 | ```{r cite} 23 | citation("correlation") 24 | ``` 25 | 26 | --- 27 | 28 | ```{r, include=FALSE} 29 | library(knitr) 30 | options( 31 | knitr.kable.NA = "", 32 | digits = 2, 33 | out.width = "100%", 34 | message = FALSE, 35 | warning = FALSE, 36 | dpi = 450 37 | ) 38 | 39 | if (!requireNamespace("ggplot2", quietly = TRUE) || 40 | !requireNamespace("BayesFactor", quietly = TRUE) || 41 | !requireNamespace("lme4", quietly = TRUE)) { 42 | knitr::opts_chunk$set(eval = FALSE) 43 | } 44 | ``` 45 | 46 | ## Data 47 | 48 | Imagine we have an experiment in which **10 individuals** completed a task with 49 | **100 trials**. For each of the 1000 trials (10 * 100) in total, 50 | we measured two things, **V1** and **V2**, and we are interested in 51 | **investigating the link between these two variables**. 52 | 53 | We will generate data using the 54 | [`simulate_simpson()`](https://easystats.github.io/bayestestR/reference/simulate_simpson.html) 55 | function from this package and look at its summary: 56 | 57 | ```{r} 58 | library(correlation) 59 | 60 | data <- simulate_simpson(n = 100, groups = 10) 61 | 62 | summary(data) 63 | ``` 64 | 65 | Now let's visualize the two variables: 66 | 67 | ```{r} 68 | library(ggplot2) 69 | 70 | ggplot(data, aes(x = V1, y = V2)) + 71 | geom_point() + 72 | geom_smooth(colour = "black", method = "lm", se = FALSE) + 73 | theme_classic() 74 | ``` 75 | 76 | That seems pretty straightforward! It seems like there is a **negative 77 | correlation** between V1 and V2. Let's test this. 78 | 79 | ## Simple correlation 80 | 81 | ```{r} 82 | correlation(data) 83 | ``` 84 | 85 | Indeed, there is a **strong, negative and significant correlation** between V1 86 | and V2. 87 | 88 | Great, can we go ahead and **publish these results in _PNAS_**? 89 | 90 | ## The Simpson's Paradox 91 | 92 | Not so fast! Ever heard of the [**Simpson's Paradox**](https://en.wikipedia.org/wiki/Simpson%27s_paradox)? 93 | 94 | Let's colour our datapoints by group (by individuals): 95 | 96 | ```{r} 97 | library(ggplot2) 98 | 99 | ggplot(data, aes(x = V1, y = V2)) + 100 | geom_point(aes(colour = Group)) + 101 | geom_smooth(aes(colour = Group), method = "lm", se = FALSE) + 102 | geom_smooth(colour = "black", method = "lm", se = FALSE) + 103 | theme_classic() 104 | ``` 105 | 106 | Mmh, interesting. It seems like, for each subject, the relationship is 107 | different. The (global) negative trend seems to be an artifact of **differences between the groups** and could be spurious! 108 | 109 | **Multilevel *(as in multi-group)* ** correlations allow us to account for 110 | **differences between groups**. It is based on a partialization of the group, 111 | entered as a random effect in a mixed linear regression. 112 | 113 | You can compute them with the 114 | [**correlations**](https://github.com/easystats/correlation) package by setting 115 | the `multilevel` argument to `TRUE`. 116 | 117 | ```{r} 118 | correlation(data, multilevel = TRUE) 119 | ``` 120 | 121 | For completeness, let's also see if its Bayesian cousin agrees with it: 122 | 123 | ```{r} 124 | correlation(data, multilevel = TRUE, bayesian = TRUE) 125 | ``` 126 | 127 | **Dayum!** 128 | We were too hasty in our conclusions! Taking the group into account 129 | seems to be super important. 130 | 131 | _Note_: In this simple case where only two variables are of interest, it would be 132 | of course best to directly proceed using a mixed regression model instead of 133 | correlations. That being said, the latter can be useful for exploratory 134 | analysis, when multiple variables are of interest, or in combination with a 135 | network or structural approach. 136 | -------------------------------------------------------------------------------- /R/cor_test_bayes.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | .cor_test_bayes <- function(data, 3 | x, 4 | y, 5 | ci = 0.95, 6 | method = "pearson", 7 | bayesian_prior = "medium", 8 | bayesian_ci_method = "hdi", 9 | bayesian_test = c("pd", "rope", "bf"), 10 | ...) { 11 | insight::check_if_installed("BayesFactor") 12 | 13 | var_x <- .complete_variable_x(data, x, y) 14 | var_y <- .complete_variable_y(data, x, y) 15 | 16 | if (tolower(method) %in% c("spearman", "spear", "s")) { 17 | var_x <- datawizard::ranktransform(var_x, sign = TRUE, method = "average") 18 | var_y <- datawizard::ranktransform(var_y, sign = TRUE, method = "average") 19 | method <- "Bayesian Spearman" 20 | } else if (tolower(method) == "gaussian") { 21 | var_x <- stats::qnorm(rank(var_x) / (length(var_x) + 1)) 22 | var_y <- stats::qnorm(rank(var_y) / (length(var_y) + 1)) 23 | method <- "Bayesian Gaussian rank" 24 | } else { 25 | method <- "Bayesian Pearson" 26 | } 27 | 28 | out <- .cor_test_bayes_base( 29 | x, 30 | y, 31 | var_x, 32 | var_y, 33 | ci = ci, 34 | bayesian_prior = bayesian_prior, 35 | bayesian_ci_method = bayesian_ci_method, 36 | bayesian_test = bayesian_test, 37 | ... 38 | ) 39 | 40 | # Add method 41 | out$Method <- method 42 | out 43 | } 44 | 45 | 46 | #' @keywords internal 47 | .cor_test_bayes_base <- function(x, 48 | y, 49 | var_x, 50 | var_y, 51 | ci = 0.95, 52 | bayesian_prior = "medium", 53 | bayesian_ci_method = "hdi", 54 | bayesian_test = c("pd", "rope", "bf"), 55 | method = "pearson", 56 | ...) { 57 | insight::check_if_installed("BayesFactor") 58 | 59 | if (x == y) { 60 | # Avoid error in the case of perfect correlation 61 | rez <- suppressWarnings(BayesFactor::correlationBF( 62 | stats::rnorm(1000), 63 | stats::rnorm(1000), 64 | rscale = bayesian_prior 65 | )) 66 | params <- parameters::model_parameters( 67 | rez, 68 | dispersion = FALSE, 69 | ci_method = bayesian_ci_method, 70 | test = bayesian_test, 71 | rope_range = c(-0.1, 0.1), 72 | rope_ci = 1, 73 | ... 74 | ) 75 | if ("Median" %in% names(params)) params$Median <- 1 76 | if ("Mean" %in% names(params)) params$Mean <- 1 77 | if ("MAP" %in% names(params)) params$MAP <- 1 78 | if ("SD" %in% names(params)) params$SD <- 0 79 | if ("MAD" %in% names(params)) params$MAD <- 0 80 | if ("CI_low" %in% names(params)) params$CI_low <- 1 81 | if ("CI_high" %in% names(params)) params$CI_high <- 1 82 | if ("pd" %in% names(params)) params$pd <- 1 83 | if ("ROPE_Percentage" %in% names(params)) params$ROPE_Percentage <- 0 84 | if ("BF" %in% names(params)) params$BF <- Inf 85 | } else { 86 | rez <- suppressWarnings(BayesFactor::correlationBF( 87 | var_x, 88 | var_y, 89 | rscale = bayesian_prior 90 | )) 91 | params <- parameters::model_parameters( 92 | rez, 93 | dispersion = FALSE, 94 | ci_method = bayesian_ci_method, 95 | test = bayesian_test, 96 | rope_range = c(-0.1, 0.1), 97 | rope_ci = 1, 98 | ... 99 | ) 100 | # validation check: do we have a BF column? 101 | if (is.null(params$BF)) { 102 | params$BF <- NA 103 | } 104 | } 105 | 106 | # Rename coef 107 | if (sum(names(params) %in% c("Median", "Mean", "MAP")) == 1) { 108 | names(params)[names(params) %in% c("Median", "Mean", "MAP")] <- "rho" 109 | } 110 | 111 | # Remove useless columns 112 | params[names(params) %in% c("Effects", "Component")] <- NULL 113 | 114 | # Prepare output 115 | params <- params[names(params) != "Parameter"] 116 | params$Parameter1 <- x 117 | params$Parameter2 <- y 118 | params[unique(c("Parameter1", "Parameter2", names(params)))] 119 | } 120 | -------------------------------------------------------------------------------- /revdep/problems.md: -------------------------------------------------------------------------------- 1 | # effectsize 2 | 3 |
4 | 5 | * Version: 0.7.0 6 | * GitHub: https://github.com/easystats/effectsize 7 | * Source code: https://github.com/cran/effectsize 8 | * Date/Publication: 2022-05-26 13:20:02 UTC 9 | * Number of recursive dependencies: 234 10 | 11 | Run `revdep_details(, "effectsize")` for more info 12 | 13 |
14 | 15 | ## Newly broken 16 | 17 | * checking tests ... 18 | ``` 19 | Running ‘spelling.R’ 20 | Running ‘testthat.R’ 21 | ERROR 22 | Running the tests in ‘tests/testthat.R’ failed. 23 | Last 13 lines of output: 24 | 7. └─effectsize (local) FUN(newX[, i], ...) 25 | 8. └─datawizard::ranktransform(x, method = "average", ..., verbose = FALSE) 26 | ── Error (test-rankES.R:76:5): kendalls_w ────────────────────────────────────── 27 | Error in `UseMethod("ranktransform")`: no applicable method for 'ranktransform' applied to an object of class "character" 28 | Backtrace: 29 | ... 30 | ▆ 31 | 1. └─effectsize::kendalls_w(M1) at test-rankES.R:76:4 32 | 2. └─effectsize:::.kendalls_w(data, verbose = verbose) 33 | 3. └─base::apply(data, 1, .safe_ranktransform, verbose = verbose) 34 | 4. └─effectsize (local) FUN(newX[, i], ...) 35 | 5. └─datawizard::ranktransform(x, method = "average", ..., verbose = FALSE) 36 | 37 | [ FAIL 3 | WARN 3 | SKIP 11 | PASS 494 ] 38 | Error: Test failures 39 | Execution halted 40 | ``` 41 | 42 | # see 43 | 44 |
45 | 46 | * Version: 0.7.1 47 | * GitHub: https://github.com/easystats/see 48 | * Source code: https://github.com/cran/see 49 | * Date/Publication: 2022-06-20 14:20:02 UTC 50 | * Number of recursive dependencies: 210 51 | 52 | Run `revdep_details(, "see")` for more info 53 | 54 |
55 | 56 | ## Newly broken 57 | 58 | * checking examples ... ERROR 59 | ``` 60 | Running examples in ‘see-Ex.R’ failed 61 | The error most likely occurred in: 62 | 63 | > ### Name: coord_radar 64 | > ### Title: Radar coordinate system 65 | > ### Aliases: coord_radar 66 | > 67 | > ### ** Examples 68 | > 69 | > # Create a radar/spider chart with ggplot: 70 | ... 71 | Attaching package: ‘poorman’ 72 | 73 | The following objects are masked from ‘package:stats’: 74 | 75 | filter, lag 76 | 77 | Loading required package: ggplot2 78 | Error in FUN(X[[i]], ...) : object 'Name' not found 79 | Calls: ... -> f -> scales_add_defaults -> lapply -> FUN 80 | Execution halted 81 | ``` 82 | 83 | * checking dependencies in R code ... WARNING 84 | ``` 85 | Missing or unexported object: ‘datawizard::data_rescale’ 86 | ``` 87 | 88 | # statsExpressions 89 | 90 |
91 | 92 | * Version: 1.3.2 93 | * GitHub: https://github.com/IndrajeetPatil/statsExpressions 94 | * Source code: https://github.com/cran/statsExpressions 95 | * Date/Publication: 2022-05-20 19:50:02 UTC 96 | * Number of recursive dependencies: 158 97 | 98 | Run `revdep_details(, "statsExpressions")` for more info 99 | 100 |
101 | 102 | ## Newly broken 103 | 104 | * checking tests ... 105 | ``` 106 | Running ‘spelling.R’ 107 | Running ‘testthat.R’ 108 | ERROR 109 | Running the tests in ‘tests/testthat.R’ failed. 110 | Last 13 lines of output: 111 | 5. │ └─effectsize:::.kendalls_w(data, verbose = verbose) 112 | 6. │ └─base::apply(data, 1, .safe_ranktransform, verbose = verbose) 113 | 7. │ └─effectsize (local) FUN(newX[, i], ...) 114 | 8. │ └─datawizard::ranktransform(x, method = "average", ..., verbose = FALSE) 115 | 9. ├─statsExpressions:::tidy_model_effectsize(.) 116 | ... 117 | 10. │ ├─dplyr::bind_cols(...) 118 | 11. │ │ └─rlang::list2(...) 119 | 12. │ └─... %>% select(-contains("term")) 120 | 13. ├─dplyr::select(., -contains("term")) 121 | 14. ├─insight::standardize_names(., style = "broom") 122 | 15. └─dplyr::mutate(., effectsize = stats::na.omit(effectsize::get_effectsize_label(colnames(.)))) 123 | 124 | [ FAIL 2 | WARN 2 | SKIP 52 | PASS 33 ] 125 | Error: Test failures 126 | Execution halted 127 | ``` 128 | 129 | -------------------------------------------------------------------------------- /R/cor_smooth.R: -------------------------------------------------------------------------------- 1 | #' Smooth a non-positive definite correlation matrix to make it positive definite 2 | #' 3 | #' Make correlations positive definite using `psych::cor.smooth`. If smoothing 4 | #' is done, inferential statistics (*p*-values, confidence intervals, etc.) are 5 | #' removed, as they are no longer valid. 6 | #' 7 | #' @param x A correlation matrix. 8 | #' @param method Smoothing method. Can be `psych` (will use 9 | #' `psych::cor.smooth()`), `hj` (Jorjani et al., 2003) or `lrs` (Schaeffer, 10 | #' 2014). For the two last, will use `mbend::bend()` (check its documentation 11 | #' for details). 12 | #' @param verbose Set to `FALSE` to silence the function. 13 | #' @param tol The minimum eigenvalue to be considered as acceptable. 14 | #' @param ... Other arguments to be passed to or from other functions. 15 | #' 16 | #' @examplesIf requireNamespace("psych", quietly = TRUE) 17 | #' set.seed(123) 18 | #' data <- as.matrix(mtcars) 19 | #' # Make missing data so pairwise correlation matrix is non-positive definite 20 | #' data[sample(seq_len(352), size = 60)] <- NA 21 | #' data <- as.data.frame(data) 22 | #' x <- correlation(data) 23 | #' is.positive_definite(x) 24 | #' 25 | #' smoothed <- cor_smooth(x) 26 | #' @export 27 | cor_smooth <- function(x, method = "psych", verbose = TRUE, ...) { 28 | UseMethod("cor_smooth") 29 | } 30 | 31 | 32 | #' @export 33 | cor_smooth.easycorrelation <- function(x, 34 | method = "psych", 35 | verbose = TRUE, 36 | tol = 10^-12, 37 | ...) { 38 | m <- cor_smooth(as.matrix(x), method = method, verbose = verbose, tol = tol, ...) 39 | 40 | if (isTRUE(attributes(m)$smoothed)) { 41 | estim <- names(x)[names(x) %in% c("r", "rho", "tau", "D")][1] 42 | 43 | for (param1 in row.names(m)) { 44 | for (param2 in colnames(m)) { 45 | if (nrow(x[x$Parameter1 == param1 & x$Parameter2 == param2, ]) == 0) next 46 | # Print changes 47 | if (verbose) { 48 | val1 <- x[x$Parameter1 == param1 & x$Parameter2 == param2, estim] 49 | val2 <- m[param1, param2] 50 | if (round(val1 - val2, digits = 2) == 0) { 51 | insight::print_color(paste0( 52 | param1, 53 | " - ", 54 | param2, 55 | ": no change (", 56 | insight::format_value(val1), 57 | ")\n" 58 | ), "green") 59 | } else { 60 | insight::print_color(paste0( 61 | param1, 62 | " - ", 63 | param2, 64 | ": ", 65 | insight::format_value(val1), 66 | " -> ", 67 | insight::format_value(val2), 68 | "\n" 69 | ), "red") 70 | } 71 | cat("\n") 72 | } 73 | x[x$Parameter1 == param1 & x$Parameter2 == param2, estim] <- m[param1, param2] 74 | } 75 | } 76 | 77 | atts <- attributes(x) 78 | x <- x[, c("Parameter1", "Parameter2", "r", "Method", "n_Obs")] 79 | atts$names <- names(x) 80 | atts$smoothed <- TRUE 81 | attributes(x) <- atts 82 | x 83 | } else { 84 | x 85 | } 86 | } 87 | 88 | 89 | #' @export 90 | cor_smooth.matrix <- function(x, 91 | method = "psych", 92 | verbose = TRUE, 93 | tol = 10^-12, 94 | ...) { 95 | method <- match.arg(method, choices = c("psych", "hj", "lrs")) 96 | 97 | # Already positive definite 98 | if (is.positive_definite(x, tol = tol, ...)) { 99 | if (verbose) message("Matrix is positive definite, smoothing was not needed.") 100 | return(x) 101 | } 102 | 103 | if (method == "psych") { 104 | insight::check_if_installed("psych") 105 | x <- suppressWarnings(psych::cor.smooth(x, eig.tol = tol, ...)) 106 | } else { 107 | out <- try(suppressMessages(mbend::bend(x, method = method, ...)), silent = TRUE) 108 | if (inherits(out, "try-error")) { 109 | return(x) 110 | } 111 | x <- out$bent 112 | } 113 | 114 | attr(x, "smoothed") <- TRUE 115 | x 116 | } 117 | 118 | 119 | # Utils ------------------------------------------------------------------- 120 | 121 | #' @rdname cor_smooth 122 | #' @export 123 | is.positive_definite <- function(x, tol = 10^-12, ...) { 124 | UseMethod("is.positive_definite") 125 | } 126 | 127 | #' @rdname cor_smooth 128 | #' @export 129 | is_positive_definite <- is.positive_definite 130 | 131 | #' @export 132 | is.positive_definite.matrix <- function(x, tol = 10^-12, ...) { 133 | eigens <- try(eigen(x), silent = TRUE) 134 | 135 | # validation checks 136 | if (inherits(eigens, "try-error")) { 137 | stop(insight::format_message( 138 | "There is something seriously wrong with the correlation matrix, as some of the eigen values are NA." 139 | ), call. = FALSE) 140 | } 141 | 142 | # Find out 143 | if (min(eigens$values) >= tol) { 144 | out <- TRUE 145 | } else { 146 | out <- FALSE 147 | } 148 | 149 | out 150 | } 151 | 152 | #' @export 153 | is.positive_definite.easycorrelation <- function(x, ...) { 154 | is.positive_definite(as.matrix(x, ...), ...) 155 | } 156 | -------------------------------------------------------------------------------- /R/methods_print.R: -------------------------------------------------------------------------------- 1 | # Console ----------------------------------------------------------------- 2 | 3 | 4 | #' @export 5 | print.easycorrelation <- function(x, ...) { 6 | cat(insight::export_table(format(x, ...), ...)) 7 | invisible(x) 8 | } 9 | 10 | #' @export 11 | print.easycormatrix <- function(x, ...) { 12 | formatted <- format(x, ...) 13 | # If real matrix, print as matrix 14 | if (colnames(formatted)[1] == "Variables") { 15 | formatted$Variables <- NULL 16 | print(as.matrix(formatted), ...) 17 | } else { 18 | cat(insight::export_table(format(x, ...), ...)) 19 | } 20 | invisible(x) 21 | } 22 | 23 | 24 | #' @export 25 | print.easymatrixlist <- function(x, cols = "auto", ...) { 26 | if (cols == "auto") { 27 | cols <- c(names(x)[1], "n_Obs", "p") 28 | } 29 | 30 | cols <- cols[cols %in% names(x)] 31 | 32 | for (i in cols) { 33 | cat(" ", i, " ", "\n", rep("-", nchar(i) + 2), "\n", sep = "") 34 | print(x[[i]], ...) 35 | cat("\n") 36 | } 37 | } 38 | 39 | #' @export 40 | print.grouped_easymatrixlist <- function(x, cols = "auto", ...) { 41 | for (i in names(x)) { 42 | cat(rep("=", nchar(i) + 2), "\n ", i, " ", "\n", rep("=", nchar(i) + 2), "\n\n", sep = "") 43 | print(x[[i]], ...) 44 | cat("\n") 45 | } 46 | } 47 | 48 | # MD and HTML -------------------------------------------------------------- 49 | 50 | .print_md_html_easycorrelation <- function(x, 51 | digits = NULL, 52 | p_digits = NULL, 53 | stars = NULL, 54 | format = "markdown", 55 | ...) { 56 | formatted_table <- format( 57 | x, 58 | digits = digits, 59 | p_digits = p_digits, 60 | stars = stars, 61 | ci_width = NULL, 62 | ci_brackets = c("(", ")"), 63 | format = format, 64 | ... 65 | ) 66 | 67 | insight::export_table( 68 | formatted_table, 69 | format = format, 70 | align = "firstleft", 71 | ... 72 | ) 73 | } 74 | 75 | 76 | #' @rdname display.easycormatrix 77 | #' @export 78 | print_md.easycorrelation <- function(x, 79 | digits = NULL, 80 | p_digits = NULL, 81 | stars = NULL, 82 | ...) { 83 | .print_md_html_easycorrelation( 84 | x, 85 | digits = digits, 86 | p_digits = p_digits, 87 | stars = stars, 88 | format = "markdown", 89 | ... 90 | ) 91 | } 92 | 93 | 94 | #' @rdname display.easycormatrix 95 | #' @export 96 | print_html.easycorrelation <- function(x, 97 | digits = NULL, 98 | p_digits = NULL, 99 | stars = NULL, 100 | ...) { 101 | .print_md_html_easycorrelation( 102 | x, 103 | digits = digits, 104 | p_digits = p_digits, 105 | stars = stars, 106 | format = "html", 107 | ... 108 | ) 109 | } 110 | 111 | 112 | .print_md_html_easycormatrix <- function(x, 113 | digits = NULL, 114 | p_digits = NULL, 115 | stars = NULL, 116 | include_significance = NULL, 117 | format = "markdown", 118 | ...) { 119 | formatted_table <- format( 120 | x, 121 | digits = digits, 122 | p_digits = p_digits, 123 | stars = stars, 124 | include_significance = include_significance, 125 | ci_width = NULL, 126 | ci_brackets = c("(", ")"), 127 | format = format, 128 | ... 129 | ) 130 | 131 | insight::export_table( 132 | formatted_table, 133 | format = format, 134 | align = "firstleft", 135 | ... 136 | ) 137 | } 138 | 139 | 140 | #' @rdname display.easycormatrix 141 | #' @export 142 | print_md.easycormatrix <- function(x, 143 | digits = NULL, 144 | p_digits = NULL, 145 | stars = NULL, 146 | include_significance = NULL, 147 | ...) { 148 | .print_md_html_easycormatrix( 149 | x, 150 | digits = digits, 151 | p_digits = p_digits, 152 | stars = stars, 153 | include_significance = include_significance, 154 | format = "markdown", 155 | ... 156 | ) 157 | } 158 | 159 | 160 | #' @rdname display.easycormatrix 161 | #' @export 162 | print_html.easycormatrix <- function(x, 163 | digits = NULL, 164 | p_digits = NULL, 165 | stars = NULL, 166 | include_significance = NULL, 167 | ...) { 168 | .print_md_html_easycormatrix( 169 | x, 170 | digits = digits, 171 | p_digits = p_digits, 172 | stars = stars, 173 | include_significance = include_significance, 174 | format = "html", 175 | ... 176 | ) 177 | } 178 | -------------------------------------------------------------------------------- /R/visualisation_recipe.cor_test.R: -------------------------------------------------------------------------------- 1 | #' @rdname visualisation_recipe.easycormatrix 2 | #' 3 | #' @examplesIf require("see") 4 | #' \donttest{ 5 | #' rez <- cor_test(mtcars, "mpg", "wt") 6 | #' 7 | #' layers <- visualisation_recipe(rez, labs = list(x = "Miles per Gallon (mpg)")) 8 | #' layers 9 | #' plot(layers) 10 | #' 11 | #' plot(rez, 12 | #' show_text = "label", 13 | #' point = list(color = "#f44336"), 14 | #' text = list(fontface = "bold"), 15 | #' show_statistic = FALSE, show_ci = FALSE, stars = TRUE 16 | #' ) 17 | #' } 18 | #' @export 19 | visualisation_recipe.easycor_test <- function(x, 20 | show_data = "point", 21 | show_text = "subtitle", 22 | smooth = NULL, 23 | point = NULL, 24 | text = NULL, 25 | labs = NULL, 26 | ...) { 27 | data <- attributes(x)$data 28 | 29 | # Text 30 | subtitle <- NULL 31 | title <- NULL 32 | if (!is.null(show_text) && show_text == "subtitle") subtitle <- cor_text(x, ...) 33 | if (!is.null(show_text) && show_text == "title") title <- cor_text(x, ...) 34 | 35 | 36 | # Get scatter plot 37 | layers <- .see_scatter(data, 38 | cor_results = x, 39 | x = x$Parameter1, 40 | y = x$Parameter2, 41 | show_data = show_data, 42 | show_text = show_text, 43 | smooth = smooth, 44 | point = point, 45 | text = text, 46 | labs = labs, 47 | title = title, 48 | subtitle = subtitle, 49 | ... 50 | ) 51 | 52 | # Text 53 | if (!is.null(show_text) && isTRUE(show_text) && show_text %in% c("text", "label")) { 54 | # Add text 55 | x$label <- cor_text(x, ...) 56 | x$label_x <- max(data[[x$Parameter1]], na.rm = TRUE) 57 | x$label_y <- max(data[[x$Parameter2]], na.rm = TRUE) + 0.05 * diff(range(data[[x$Parameter2]], na.rm = TRUE)) 58 | 59 | l <- paste0("l", length(layers) + 1) 60 | layers[[l]] <- list( 61 | geom = show_text, 62 | data = x, 63 | hjust = 1, 64 | aes = list( 65 | label = "label", 66 | x = "label_x", 67 | y = "label_y" 68 | ) 69 | ) 70 | if (!is.null(text)) layers[[l]] <- utils::modifyList(layers[[l]], text) 71 | } 72 | 73 | # Out 74 | class(layers) <- c("visualisation_recipe", "see_visualisation_recipe", class(layers)) 75 | attr(layers, "data") <- data 76 | layers 77 | } 78 | 79 | 80 | # see_scatter ------------------------------------------------------------- 81 | 82 | 83 | .see_scatter <- function(data, 84 | cor_results, 85 | x, 86 | y, 87 | show_data = "point", 88 | show_text = "text", 89 | smooth = NULL, 90 | point = NULL, 91 | text = NULL, 92 | labs = NULL, 93 | title = NULL, 94 | subtitle = NULL, 95 | type = show_data, 96 | ...) { 97 | # Keep only relevant variables (lighter) and complete cases 98 | data <- data[stats::complete.cases(data[c(x, y)]), ] 99 | 100 | # Initialize layers list 101 | layers <- list() 102 | 103 | # handle alias 104 | if (!missing(type)) { 105 | show_data <- type 106 | } 107 | 108 | # Layers ----------------------- 109 | l <- 1 110 | 111 | # Smooth 112 | layers[[paste0("l", l)]] <- list( 113 | geom = "smooth", 114 | data = data, 115 | method = "lm", 116 | aes = list( 117 | x = x, 118 | y = y 119 | ) 120 | ) 121 | if (!is.null(smooth)) { 122 | layers[[paste0("l", l)]] <- utils::modifyList(layers[[paste0("l", l)]], smooth) 123 | } 124 | l <- l + 1 125 | 126 | # Point 127 | layers[[paste0("l", l)]] <- list( 128 | geom = show_data, 129 | data = data, 130 | aes = list( 131 | x = x, 132 | y = y 133 | ) 134 | ) 135 | if (!is.null(point)) { 136 | layers[[paste0("l", l)]] <- utils::modifyList(layers[[paste0("l", l)]], point) 137 | } 138 | l <- l + 1 139 | 140 | # Side density 141 | # TODO: wait 'til https://github.com/jtlandis/ggside/issues/31 is fixed 142 | # insight::check_if_installed("ggside") 143 | # layers[[paste0("l", l)]] <- list(geom = "ggside::geom_xsidedensity", 144 | # data = data, 145 | # aes = list(x = x) 146 | # ) 147 | # l <- l + 1 148 | # layers[[paste0("l", l)]] <- list(geom = "ggside::geom_ysidedensity", 149 | # data = data, 150 | # aes = list(x = x) 151 | # ) 152 | # l <- l + 1 153 | # 154 | # layers[[paste0("l", l)]] <- list(geom = "ggside::scale_xsidey_continuous", breaks = NULL) 155 | # l <- l + 1 156 | # layers[[paste0("l", l)]] <- list(geom = "ggside::scale_ysidex_continuous", breaks = NULL) 157 | # l <- l + 1 158 | 159 | # Labs 160 | layers[[paste0("l", l)]] <- list(geom = "labs", subtitle = subtitle, title = title) 161 | if (!is.null(labs)) { 162 | layers[[paste0("l", l)]] <- utils::modifyList(layers[[paste0("l", l)]], labs) 163 | } 164 | 165 | layers 166 | } 167 | -------------------------------------------------------------------------------- /.github/CODE_OF_CONDUCT.md: -------------------------------------------------------------------------------- 1 | # Contributor Covenant Code of Conduct 2 | 3 | ## Our Pledge 4 | 5 | We as members, contributors, and leaders pledge to make participation in our 6 | community a harassment-free experience for everyone, regardless of age, body 7 | size, visible or invisible disability, ethnicity, sex characteristics, gender 8 | identity and expression, level of experience, education, socio-economic status, 9 | nationality, personal appearance, race, caste, color, religion, or sexual 10 | identity and orientation. 11 | 12 | We pledge to act and interact in ways that contribute to an open, welcoming, 13 | diverse, inclusive, and healthy community. 14 | 15 | ## Our Standards 16 | 17 | Examples of behavior that contributes to a positive environment for our 18 | community include: 19 | 20 | * Demonstrating empathy and kindness toward other people 21 | * Being respectful of differing opinions, viewpoints, and experiences 22 | * Giving and gracefully accepting constructive feedback 23 | * Accepting responsibility and apologizing to those affected by our mistakes, 24 | and learning from the experience 25 | * Focusing on what is best not just for us as individuals, but for the overall 26 | community 27 | 28 | Examples of unacceptable behavior include: 29 | 30 | * The use of sexualized language or imagery, and sexual attention or advances of 31 | any kind 32 | * Trolling, insulting or derogatory comments, and personal or political attacks 33 | * Public or private harassment 34 | * Publishing others' private information, such as a physical or email address, 35 | without their explicit permission 36 | * Other conduct which could reasonably be considered inappropriate in a 37 | professional setting 38 | 39 | ## Enforcement Responsibilities 40 | 41 | Community leaders are responsible for clarifying and enforcing our standards of 42 | acceptable behavior and will take appropriate and fair corrective action in 43 | response to any behavior that they deem inappropriate, threatening, offensive, 44 | or harmful. 45 | 46 | Community leaders have the right and responsibility to remove, edit, or reject 47 | comments, commits, code, wiki edits, issues, and other contributions that are 48 | not aligned to this Code of Conduct, and will communicate reasons for moderation 49 | decisions when appropriate. 50 | 51 | ## Scope 52 | 53 | This Code of Conduct applies within all community spaces, and also applies when 54 | an individual is officially representing the community in public spaces. 55 | Examples of representing our community include using an official e-mail address, 56 | posting via an official social media account, or acting as an appointed 57 | representative at an online or offline event. 58 | 59 | ## Enforcement 60 | 61 | Instances of abusive, harassing, or otherwise unacceptable behavior may be 62 | reported to the community leaders responsible for enforcement at brenton@wiernik.org. 63 | All complaints will be reviewed and investigated promptly and fairly. 64 | 65 | All community leaders are obligated to respect the privacy and security of the 66 | reporter of any incident. 67 | 68 | ## Enforcement Guidelines 69 | 70 | Community leaders will follow these Community Impact Guidelines in determining 71 | the consequences for any action they deem in violation of this Code of Conduct: 72 | 73 | ### 1. Correction 74 | 75 | **Community Impact**: Use of inappropriate language or other behavior deemed 76 | unprofessional or unwelcome in the community. 77 | 78 | **Consequence**: A private, written warning from community leaders, providing 79 | clarity around the nature of the violation and an explanation of why the 80 | behavior was inappropriate. A public apology may be requested. 81 | 82 | ### 2. Warning 83 | 84 | **Community Impact**: A violation through a single incident or series of 85 | actions. 86 | 87 | **Consequence**: A warning with consequences for continued behavior. No 88 | interaction with the people involved, including unsolicited interaction with 89 | those enforcing the Code of Conduct, for a specified period of time. This 90 | includes avoiding interactions in community spaces as well as external channels 91 | like social media. Violating these terms may lead to a temporary or permanent 92 | ban. 93 | 94 | ### 3. Temporary Ban 95 | 96 | **Community Impact**: A serious violation of community standards, including 97 | sustained inappropriate behavior. 98 | 99 | **Consequence**: A temporary ban from any sort of interaction or public 100 | communication with the community for a specified period of time. No public or 101 | private interaction with the people involved, including unsolicited interaction 102 | with those enforcing the Code of Conduct, is allowed during this period. 103 | Violating these terms may lead to a permanent ban. 104 | 105 | ### 4. Permanent Ban 106 | 107 | **Community Impact**: Demonstrating a pattern of violation of community 108 | standards, including sustained inappropriate behavior, harassment of an 109 | individual, or aggression toward or disparagement of classes of individuals. 110 | 111 | **Consequence**: A permanent ban from any sort of public interaction within the 112 | community. 113 | 114 | ## Attribution 115 | 116 | This Code of Conduct is adapted from the [Contributor Covenant][homepage], 117 | version 2.1, available at 118 | . 119 | 120 | Community Impact Guidelines were inspired by 121 | [Mozilla's code of conduct enforcement ladder][https://github.com/mozilla/inclusion]. 122 | 123 | For answers to common questions about this code of conduct, see the FAQ at 124 | . Translations are available at . 125 | 126 | [homepage]: https://www.contributor-covenant.org 127 | -------------------------------------------------------------------------------- /tests/testthat/test-cor_test_na_present.R: -------------------------------------------------------------------------------- 1 | test_that("cor_test frequentist", { 2 | skip_if_not_or_load_if_installed("ggplot2") 3 | 4 | expect_error(cor_test(ggplot2::msleep, brainwt, sleep_rem)) 5 | 6 | out <- cor_test(ggplot2::msleep, "brainwt", "sleep_rem") 7 | expect_equal(out$r, -0.2213348, tolerance = 0.01) 8 | }) 9 | 10 | test_that("cor_test kendall", { 11 | skip_if_not_or_load_if_installed("ggplot2") 12 | 13 | out <- cor_test(ggplot2::msleep, "brainwt", "sleep_rem", method = "kendall") 14 | out2 <- suppressWarnings(stats::cor.test( 15 | ggplot2::msleep$brainwt, 16 | ggplot2::msleep$sleep_rem, 17 | method = "kendall" 18 | )) 19 | 20 | expect_equal(out$tau, out2$estimate[[1]], tolerance = 0.001) 21 | expect_equal(out$p, out2$p.value[[1]], tolerance = 0.001) 22 | }) 23 | 24 | test_that("cor_test bayesian", { 25 | skip_if_not_or_load_if_installed("BayesFactor") 26 | 27 | set.seed(123) 28 | out <- cor_test(ggplot2::msleep, "brainwt", "sleep_rem", bayesian = TRUE) 29 | expect_equal(out$rho, -0.1947696, tolerance = 0.01) 30 | }) 31 | 32 | test_that("cor_test tetrachoric", { 33 | skip_if_not_or_load_if_installed("psych") 34 | skip_if_not_or_load_if_installed("polycor") 35 | skip_if_not_or_load_if_installed("ggplot2") 36 | 37 | data <- ggplot2::msleep 38 | data$brainwt_binary <- as.numeric(data$brainwt > 3) 39 | data$sleep_rem_binary <- as.numeric(data$sleep_rem > 1.2) 40 | 41 | # With Factors / Binary 42 | expect_warning(expect_error(cor_test( 43 | data, 44 | "brainwt_binary", 45 | "sleep_rem_binary", 46 | method = "tetrachoric" 47 | ))) 48 | 49 | data$sleep_rem_ordinal <- as.factor(round(data$sleep_rem)) 50 | data$brainwt_ordinal <- as.factor(round(data$brainwt)) 51 | 52 | out <- suppressWarnings(cor_test( 53 | data, 54 | "brainwt", 55 | "brainwt_ordinal", 56 | method = "polychoric" 57 | )) 58 | expect_equal(out$rho, 0.9999, tolerance = 0.01) 59 | 60 | # Biserial 61 | expect_error(cor_test( 62 | data, 63 | "brainwt", 64 | "sleep_rem_binary", 65 | method = "pointbiserial" 66 | )) 67 | 68 | expect_error(cor_test( 69 | data, 70 | "brainwt", 71 | "sleep_rem_binary", 72 | method = "biserial" 73 | )) 74 | }) 75 | 76 | 77 | test_that("cor_test robust", { 78 | skip_if_not_or_load_if_installed("ggplot2") 79 | 80 | out1 <- cor_test( 81 | ggplot2::msleep, 82 | "brainwt", 83 | "sleep_rem", 84 | method = "pearson", 85 | ranktransform = TRUE 86 | ) 87 | out2 <- cor_test( 88 | ggplot2::msleep, 89 | "brainwt", 90 | "sleep_rem", 91 | method = "spearman", 92 | ranktransform = FALSE 93 | ) 94 | expect_equal(out1$r, out2$rho, tolerance = 0.01) 95 | }) 96 | 97 | 98 | test_that("cor_test distance", { 99 | skip_if_not_or_load_if_installed("ggplot2") 100 | skip_if_not_or_load_if_installed("energy") 101 | skip_if_not_or_load_if_installed("poorman") 102 | 103 | out <- cor_test(ggplot2::msleep, "brainwt", "sleep_rem", method = "distance") 104 | df <- poorman::filter(ggplot2::msleep, !is.na(brainwt), !is.na(sleep_rem)) 105 | comparison <- energy::dcorT.test(df$brainwt, df$sleep_rem) 106 | expect_equal(out$r, as.numeric(comparison$estimate), tolerance = 0.01) 107 | }) 108 | 109 | 110 | test_that("cor_test percentage", { 111 | skip_if_not_or_load_if_installed("ggplot2") 112 | skip_if_not_or_load_if_installed("WRS2") 113 | 114 | out <- cor_test( 115 | ggplot2::msleep, 116 | "brainwt", 117 | "sleep_rem", 118 | method = "percentage" 119 | ) 120 | comparison <- WRS2::pbcor(ggplot2::msleep$brainwt, ggplot2::msleep$sleep_rem) 121 | expect_equal(out$r, as.numeric(comparison$cor), tolerance = 0.01) 122 | }) 123 | 124 | 125 | test_that("cor_test shepherd", { 126 | skip_if_not_or_load_if_installed("ggplot2") 127 | 128 | set.seed(333) 129 | expect_error(cor_test( 130 | ggplot2::msleep, 131 | "brainwt", 132 | "sleep_rem", 133 | method = "shepherd" 134 | )) 135 | }) 136 | 137 | 138 | test_that("cor_test blomqvist", { 139 | skip_if_not_or_load_if_installed("wdm") 140 | 141 | set.seed(333) 142 | out <- cor_test(ggplot2::msleep, "brainwt", "sleep_rem", method = "blomqvist") 143 | expect_equal(out$r, -0.4583333, tolerance = 0.01) 144 | }) 145 | 146 | test_that("cor_test hoeffding", { 147 | skip_if_not_or_load_if_installed("Hmisc") 148 | 149 | set.seed(333) 150 | out <- cor_test(ggplot2::msleep, "brainwt", "sleep_rem", method = "hoeffding") 151 | expect_equal(out$r, 0.04427718, tolerance = 0.01) 152 | }) 153 | 154 | test_that("cor_test gamma", { 155 | skip_if_not_or_load_if_installed("ggplot2") 156 | 157 | set.seed(333) 158 | out <- cor_test(ggplot2::msleep, "brainwt", "sleep_rem", method = "gamma") 159 | expect_equal(out$r, -0.2675799, tolerance = 0.01) 160 | }) 161 | 162 | test_that("cor_test gaussian", { 163 | skip_if_not_or_load_if_installed("ggplot2") 164 | 165 | set.seed(333) 166 | out <- cor_test(ggplot2::msleep, "brainwt", "sleep_rem", method = "gaussian") 167 | expect_equal(out$r, -0.3679795, tolerance = 0.01) 168 | 169 | skip_if_not_or_load_if_installed("BayesFactor") 170 | out <- cor_test( 171 | ggplot2::msleep, 172 | "brainwt", 173 | "sleep_rem", 174 | method = "gaussian", 175 | bayesian = TRUE 176 | ) 177 | expect_equal(out$rho, -0.3269572, tolerance = 0.01) 178 | }) 179 | 180 | 181 | # Additional arguments ---------------------------------------------------- 182 | 183 | test_that("cor_test one-sided p value", { 184 | skip_if_not_or_load_if_installed("ggplot2") 185 | 186 | baseline <- cor.test( 187 | ggplot2::msleep$brainwt, 188 | ggplot2::msleep$sleep_rem, 189 | alternative = "greater" 190 | ) 191 | 192 | out <- cor_test( 193 | ggplot2::msleep, 194 | "brainwt", 195 | "sleep_rem", 196 | alternative = "greater" 197 | ) 198 | expect_equal(out$p, baseline$p.value, tolerance = 0.000001) 199 | }) 200 | -------------------------------------------------------------------------------- /paper/paper.bib: -------------------------------------------------------------------------------- 1 | @Manual{Rteam, 2 | title = {R: A Language and Environment for Statistical Computing}, 3 | author = {{R Core Team}}, 4 | organization = {R Foundation for Statistical Computing}, 5 | address = {Vienna, Austria}, 6 | year = {2019}, 7 | url = {https://www.R-project.org/}, 8 | } 9 | 10 | @article{shan2020correlation, 11 | doi = {10.1155/2020/7398324}, 12 | url = {https://doi.org/10.1155%2F2020%2F7398324}, 13 | year = 2020, 14 | month = {mar}, 15 | publisher = {Hindawi Limited}, 16 | volume = {2020}, 17 | pages = {1--11}, 18 | author = {Guogen Shan and Hua Zhang and Tao Jiang}, 19 | title = {Correlation Coefficients for a Study with Repeated Measures}, 20 | journal = {Computational and Mathematical Methods in Medicine} 21 | } 22 | 23 | @Manual{ludecke2019see, 24 | title = {see: Visualisation Toolbox for 'easystats' and Extra Geoms, Themes and Color Palettes for 'ggplot2'}, 25 | author = {Daniel Lüdecke and Philip Waggoner and Mattan S. Ben-Shachar and Dominique Makowski}, 26 | year = {2019}, 27 | note = {R package version 0.2.0.9000}, 28 | url = {https://easystats.github.io/see/}, 29 | } 30 | 31 | @article{ludecke2019insight, 32 | journal = {Journal of Open Source Software}, 33 | doi = {10.21105/joss.01412}, 34 | issn = {2475-9066}, 35 | number = {38}, 36 | publisher = {The Open Journal}, 37 | title = {insight: A Unified Interface to Access Information from Model Objects in R}, 38 | url = {http://dx.doi.org/10.21105/joss.01412}, 39 | volume = {4}, 40 | author = {Lüdecke, Daniel and Waggoner, Philip and Makowski, Dominique}, 41 | pages = {1412}, 42 | date = {2019-06-25}, 43 | year = {2019}, 44 | month = {6}, 45 | day = {25}, 46 | } 47 | 48 | @article{Bhushan_2019, 49 | doi = {10.3389/fpsyg.2019.01050}, 50 | url = {https://doi.org/10.3389%2Ffpsyg.2019.01050}, 51 | year = 2019, 52 | month = {may}, 53 | publisher = {Frontiers Media {SA}}, 54 | volume = {10}, 55 | author = {Nitin Bhushan and Florian Mohnert and Daniel Sloot and Lise Jans and Casper Albers and Linda Steg}, 56 | title = {Using a Gaussian Graphical Model to Explore Relationships Between Items and Variables in Environmental Psychology Research}, 57 | journal = {Frontiers in Psychology} 58 | } 59 | 60 | 61 | @article{makowski2019bayestestr, 62 | title = {{bayestestR}: {Describing} {Effects} and their {Uncertainty}, {Existence} and {Significance} within the {Bayesian} {Framework}}, 63 | volume = {4}, 64 | issn = {2475-9066}, 65 | shorttitle = {{bayestestR}}, 66 | url = {https://joss.theoj.org/papers/10.21105/joss.01541}, 67 | doi = {10.21105/joss.01541}, 68 | number = {40}, 69 | urldate = {2019-08-13}, 70 | journal = {Journal of Open Source Software}, 71 | author = {Makowski, Dominique and Ben-Shachar, Mattan and Lüdecke, Daniel}, 72 | month = aug, 73 | year = {2019}, 74 | pages = {1541} 75 | } 76 | 77 | @article{Wickham_2019, 78 | doi = {10.21105/joss.01686}, 79 | url = {https://doi.org/10.21105%2Fjoss.01686}, 80 | year = 2019, 81 | month = {nov}, 82 | publisher = {The Open Journal}, 83 | volume = {4}, 84 | number = {43}, 85 | pages = {1686}, 86 | author = {Hadley Wickham and Mara Averick and Jennifer Bryan and Winston Chang and Lucy McGowan and Romain Fran{\c{c}}ois and Garrett Grolemund and Alex Hayes and Lionel Henry and Jim Hester and Max Kuhn and Thomas Pedersen and Evan Miller and Stephan Bache and Kirill Müller and Jeroen Ooms and David Robinson and Dana Seidel and Vitalie Spinu and Kohske Takahashi and Davis Vaughan and Claus Wilke and Kara Woo and Hiroaki Yutani}, 87 | title = {Welcome to the Tidyverse}, 88 | journal = {Journal of Open Source Software} 89 | } 90 | 91 | @article{epskamp2018estimating, 92 | doi = {10.3758/s13428-017-0862-1}, 93 | url = {https://doi.org/10.3758%2Fs13428-017-0862-1}, 94 | year = 2018, 95 | month = {feb}, 96 | publisher = {Springer Science and Business Media {LLC}}, 97 | volume = {50}, 98 | number = {1}, 99 | pages = {195--212}, 100 | author = {Sacha Epskamp and Denny Borsboom and Eiko I. Fried}, 101 | title = {Estimating psychological networks and their accuracy: A tutorial paper}, 102 | journal = {Behavior Research Methods} 103 | } 104 | 105 | @article{bakdash2017repeated, 106 | doi = {10.3389/fpsyg.2017.00456}, 107 | url = {https://doi.org/10.3389%2Ffpsyg.2017.00456}, 108 | year = 2017, 109 | month = {apr}, 110 | publisher = {Frontiers Media {SA}}, 111 | volume = {8}, 112 | author = {Jonathan Z. Bakdash and Laura R. Marusich}, 113 | title = {Repeated Measures Correlation}, 114 | journal = {Frontiers in Psychology} 115 | } 116 | 117 | @article{bishara2017confidence, 118 | title={Confidence intervals for correlations when data are not normal}, 119 | author={Bishara, Anthony J and Hittner, James B}, 120 | journal={Behavior research methods}, 121 | volume={49}, 122 | number={1}, 123 | pages={294--309}, 124 | year={2017}, 125 | publisher={Springer}, 126 | doi={10.3758/s13428-016-0702-8} 127 | } 128 | 129 | @article{langfelder2012fast, 130 | title={Fast {R} functions for robust correlations and hierarchical clustering}, 131 | author={Langfelder, Peter and Horvath, Steve}, 132 | journal={Journal of statistical software}, 133 | volume={46}, 134 | number={11}, 135 | year={2012}, 136 | publisher={NIH Public Access}, 137 | url={https://www.jstatsoft.org/v46/i11/}, 138 | doi={10.18637/jss.v046.i11} 139 | } 140 | 141 | 142 | @article{fieller1957tests, 143 | title={Tests for rank correlation coefficients. I}, 144 | author={Fieller, Edgar C and Hartley, Herman O and Pearson, Egon S}, 145 | journal={Biometrika}, 146 | volume={44}, 147 | number={3/4}, 148 | pages={470--481}, 149 | year={1957}, 150 | publisher={JSTOR}, 151 | doi={10.1093/biomet/48.1-2.29} 152 | } 153 | 154 | @Manual{BayesFactor, 155 | title = {BayesFactor: Computation of Bayes Factors for Common Designs}, 156 | author = {Richard D. Morey and Jeffrey N. Rouder}, 157 | year = {2018}, 158 | note = {R package version 0.9.12-4.2}, 159 | url = {https://CRAN.R-project.org/package=BayesFactor}, 160 | } -------------------------------------------------------------------------------- /R/cor_sort.R: -------------------------------------------------------------------------------- 1 | #' Sort a correlation matrix to improve readability of groups and clusters 2 | #' 3 | #' Sort a correlation matrix based on [`hclust()`]. 4 | #' 5 | #' @param x A correlation matrix. 6 | #' @param distance How the distance between each variable should be calculated. 7 | #' If `correlation` (default; suited for correlation matrices), the matrix 8 | #' will be rescaled to 0-1 (`distance = 0` indicating correlation of `1`; 9 | #' `distance = 1` indicating correlation of `-1`). If `raw`, then the matrix 10 | #' will be used as a distance matrix as-is. Can be others (`euclidean`, 11 | #' `manhattan`, ...), in which case it will be passed to [`dist()`] (see the 12 | #' arguments for it). 13 | #' @param hclust_method Argument passed down into the `method` argument of [`hclust()`]. 14 | #' @param ... Other arguments to be passed to or from other functions. 15 | #' 16 | #' @examples 17 | #' x <- correlation(mtcars) 18 | #' 19 | #' cor_sort(as.matrix(x)) 20 | #' cor_sort(x, hclust_method = "ward.D2") # It can also reorder the long form output 21 | #' cor_sort(summary(x, redundant = TRUE)) # As well as from the summary 22 | #' @export 23 | cor_sort <- function(x, distance = "correlation", hclust_method = "complete", ...) { 24 | UseMethod("cor_sort") 25 | } 26 | 27 | #' @export 28 | cor_sort.easycorrelation <- function(x, distance = "correlation", hclust_method = "complete", ...) { 29 | m <- cor_sort(as.matrix(x), distance = distance, hclust_method = hclust_method, ...) 30 | x$Parameter1 <- factor(x$Parameter1, levels = rownames(m)) 31 | x$Parameter2 <- factor(x$Parameter2, levels = colnames(m)) 32 | reordered <- x[order(x$Parameter1, x$Parameter2), ] 33 | 34 | # Restore class and attributes 35 | attributes(reordered) <- utils::modifyList( 36 | attributes(x)[!names(attributes(x)) %in% c("names", "row.names")], 37 | attributes(reordered) 38 | ) 39 | 40 | # Make sure Parameter columns are character 41 | # Was added to fix a test, but makes the function not work 42 | # (See https://github.com/easystats/correlation/issues/259) 43 | # reordered$Parameter1 <- as.character(reordered$Parameter1) 44 | # reordered$Parameter2 <- as.character(reordered$Parameter2) 45 | 46 | reordered 47 | } 48 | 49 | 50 | #' @export 51 | cor_sort.easycormatrix <- function(x, distance = "correlation", hclust_method = "complete", ...) { 52 | if (!"Parameter" %in% colnames(x)) { 53 | return(NextMethod()) 54 | } 55 | 56 | # Get matrix 57 | m <- x 58 | row.names(m) <- x$Parameter 59 | m <- as.matrix(m[names(m)[names(m) != "Parameter"]]) 60 | 61 | # If non-redundant matrix, fail (## TODO: fix that) 62 | if (anyNA(m)) { 63 | insight::format_error("Non-redundant matrices are not supported yet. Try again by setting summary(..., redundant = TRUE)") 64 | } 65 | 66 | # Get sorted matrix 67 | m <- cor_sort(m, distance = distance, hclust_method = hclust_method, ...) 68 | 69 | # Reorder 70 | x$Parameter <- factor(x$Parameter, levels = row.names(m)) 71 | reordered <- x[order(x$Parameter), c("Parameter", colnames(m))] 72 | 73 | # Restore class and attributes 74 | attributes(reordered) <- utils::modifyList( 75 | attributes(x)[!names(attributes(x)) %in% c("names", "row.names")], 76 | attributes(reordered) 77 | ) 78 | 79 | # Reorder attributes (p-values) etc. 80 | for (id in c("p", "CI", "CI_low", "CI_high", "BF", "Method", "n_Obs", "df_error", "t")) { 81 | if (id %in% names(attributes(reordered))) { 82 | attributes(reordered)[[id]] <- attributes(reordered)[[id]][order(x$Parameter), names(reordered)] 83 | } 84 | } 85 | 86 | # make sure Parameter columns are character 87 | reordered$Parameter <- as.character(reordered$Parameter) 88 | 89 | reordered 90 | } 91 | 92 | 93 | #' @export 94 | cor_sort.matrix <- function(x, distance = "correlation", hclust_method = "complete", ...) { 95 | if (isSquare(x) && all(colnames(x) %in% rownames(x))) { 96 | i <- .cor_sort_square(x, distance = distance, hclust_method = hclust_method, ...) 97 | } else { 98 | i <- .cor_sort_nonsquare(x, distance = "euclidean", ...) 99 | } 100 | 101 | reordered <- x[i$row_order, i$col_order] 102 | 103 | # Restore class and attributes 104 | attributes(reordered) <- utils::modifyList( 105 | attributes(x)[names(attributes(x)) != "dimnames"], 106 | attributes(reordered) 107 | ) 108 | 109 | reordered 110 | } 111 | 112 | # Utils ------------------------------------------------------------------- 113 | 114 | 115 | .cor_sort_square <- function(m, distance = "correlation", hclust_method = "complete", ...) { 116 | if (distance == "correlation") { 117 | d <- stats::as.dist((1 - m) / 2) # r = -1 -> d = 1; r = 1 -> d = 0 118 | } else if (distance == "raw") { 119 | d <- stats::as.dist(m) 120 | } else { 121 | d <- stats::dist(m, method = distance, diag = TRUE, upper = TRUE) 122 | } 123 | 124 | hc <- stats::hclust(d, method = hclust_method) 125 | row_order <- row.names(m)[hc$order] 126 | list(row_order = row_order, col_order = row_order) 127 | } 128 | 129 | 130 | .cor_sort_nonsquare <- function(m, distance = "euclidean", ...) { 131 | # Step 1: Perform clustering on rows and columns independently 132 | row_dist <- stats::dist(m, method = distance) # Distance between rows 133 | col_dist <- stats::dist(t(m), method = distance) # Distance between columns 134 | 135 | row_hclust <- stats::hclust(row_dist, method = "average") 136 | col_hclust <- stats::hclust(col_dist, method = "average") 137 | 138 | # Obtain clustering orders 139 | row_order <- row_hclust$order 140 | col_order <- col_hclust$order 141 | 142 | # Reorder matrix based on clustering 143 | clustered_matrix <- m[row_order, col_order] 144 | 145 | # Step 2: Refine alignment to emphasize strong correlations along the diagonal 146 | n_rows <- nrow(clustered_matrix) 147 | n_cols <- ncol(clustered_matrix) 148 | 149 | used_rows <- logical(n_rows) 150 | refined_row_order <- integer(0) 151 | 152 | for (col in seq_len(n_cols)) { 153 | max_value <- -Inf 154 | best_row <- NA 155 | 156 | for (row in seq_len(n_rows)[!used_rows]) { 157 | if (abs(clustered_matrix[row, col]) > max_value) { 158 | max_value <- abs(clustered_matrix[row, col]) 159 | best_row <- row 160 | } 161 | } 162 | 163 | if (!is.na(best_row)) { 164 | refined_row_order <- c(refined_row_order, best_row) 165 | used_rows[best_row] <- TRUE 166 | } 167 | } 168 | 169 | # Append any unused rows at the end 170 | refined_row_order <- c(refined_row_order, which(!used_rows)) 171 | 172 | # Apply 173 | m <- clustered_matrix[refined_row_order, ] 174 | list(row_order = rownames(m), col_order = colnames(m)) 175 | } 176 | -------------------------------------------------------------------------------- /vignettes/bibliography.bib: -------------------------------------------------------------------------------- 1 | @Manual{Rteam, 2 | title = {R: A Language and Environment for Statistical Computing}, 3 | author = {{R Core Team}}, 4 | organization = {R Foundation for Statistical Computing}, 5 | address = {Vienna, Austria}, 6 | year = {2019}, 7 | url = {https://www.R-project.org/}, 8 | } 9 | 10 | @article{shan2020correlation, 11 | doi = {10.1155/2020/7398324}, 12 | url = {https://doi.org/10.1155%2F2020%2F7398324}, 13 | year = 2020, 14 | month = {mar}, 15 | publisher = {Hindawi Limited}, 16 | volume = {2020}, 17 | pages = {1--11}, 18 | author = {Guogen Shan and Hua Zhang and Tao Jiang}, 19 | title = {Correlation Coefficients for a Study with Repeated Measures}, 20 | journal = {Computational and Mathematical Methods in Medicine} 21 | } 22 | 23 | @Manual{ludecke2019see, 24 | title = {see: Visualisation Toolbox for 'easystats' and Extra Geoms, Themes and Color Palettes for 'ggplot2'}, 25 | author = {Daniel Lüdecke and Philip Waggoner and Mattan S. Ben-Shachar and Dominique Makowski}, 26 | year = {2019}, 27 | note = {R package version 0.2.0.9000}, 28 | url = {https://easystats.github.io/see/}, 29 | } 30 | 31 | @article{ludecke2019insight, 32 | journal = {Journal of Open Source Software}, 33 | doi = {10.21105/joss.01412}, 34 | issn = {2475-9066}, 35 | number = {38}, 36 | publisher = {The Open Journal}, 37 | title = {insight: A Unified Interface to Access Information from Model Objects in R}, 38 | url = {http://dx.doi.org/10.21105/joss.01412}, 39 | volume = {4}, 40 | author = {Lüdecke, Daniel and Waggoner, Philip and Makowski, Dominique}, 41 | pages = {1412}, 42 | date = {2019-06-25}, 43 | year = {2019}, 44 | month = {6}, 45 | day = {25}, 46 | } 47 | 48 | @article{Bhushan_2019, 49 | doi = {10.3389/fpsyg.2019.01050}, 50 | url = {https://doi.org/10.3389%2Ffpsyg.2019.01050}, 51 | year = 2019, 52 | month = {may}, 53 | publisher = {Frontiers Media {SA}}, 54 | volume = {10}, 55 | author = {Nitin Bhushan and Florian Mohnert and Daniel Sloot and Lise Jans and Casper Albers and Linda Steg}, 56 | title = {Using a Gaussian Graphical Model to Explore Relationships Between Items and Variables in Environmental Psychology Research}, 57 | journal = {Frontiers in Psychology} 58 | } 59 | 60 | 61 | @article{makowski2019bayestestr, 62 | title = {{bayestestR}: {Describing} {Effects} and their {Uncertainty}, {Existence} and {Significance} within the {Bayesian} {Framework}}, 63 | volume = {4}, 64 | issn = {2475-9066}, 65 | shorttitle = {{bayestestR}}, 66 | url = {https://joss.theoj.org/papers/10.21105/joss.01541}, 67 | doi = {10.21105/joss.01541}, 68 | number = {40}, 69 | urldate = {2019-08-13}, 70 | journal = {Journal of Open Source Software}, 71 | author = {Makowski, Dominique and Ben-Shachar, Mattan and Lüdecke, Daniel}, 72 | month = aug, 73 | year = {2019}, 74 | pages = {1541} 75 | } 76 | 77 | @article{Wickham_2019, 78 | doi = {10.21105/joss.01686}, 79 | url = {https://doi.org/10.21105%2Fjoss.01686}, 80 | year = 2019, 81 | month = {nov}, 82 | publisher = {The Open Journal}, 83 | volume = {4}, 84 | number = {43}, 85 | pages = {1686}, 86 | author = {Hadley Wickham and Mara Averick and Jennifer Bryan and Winston Chang and Lucy McGowan and Romain Fran{\c{c}}ois and Garrett Grolemund and Alex Hayes and Lionel Henry and Jim Hester and Max Kuhn and Thomas Pedersen and Evan Miller and Stephan Bache and Kirill Müller and Jeroen Ooms and David Robinson and Dana Seidel and Vitalie Spinu and Kohske Takahashi and Davis Vaughan and Claus Wilke and Kara Woo and Hiroaki Yutani}, 87 | title = {Welcome to the Tidyverse}, 88 | journal = {Journal of Open Source Software} 89 | } 90 | 91 | @article{epskamp2018estimating, 92 | doi = {10.3758/s13428-017-0862-1}, 93 | url = {https://doi.org/10.3758%2Fs13428-017-0862-1}, 94 | year = 2018, 95 | month = {feb}, 96 | publisher = {Springer Science and Business Media {LLC}}, 97 | volume = {50}, 98 | number = {1}, 99 | pages = {195--212}, 100 | author = {Sacha Epskamp and Denny Borsboom and Eiko I. Fried}, 101 | title = {Estimating psychological networks and their accuracy: A tutorial paper}, 102 | journal = {Behavior Research Methods} 103 | } 104 | 105 | @article{bakdash2017repeated, 106 | doi = {10.3389/fpsyg.2017.00456}, 107 | url = {https://doi.org/10.3389%2Ffpsyg.2017.00456}, 108 | year = 2017, 109 | month = {apr}, 110 | publisher = {Frontiers Media {SA}}, 111 | volume = {8}, 112 | author = {Jonathan Z. Bakdash and Laura R. Marusich}, 113 | title = {Repeated Measures Correlation}, 114 | journal = {Frontiers in Psychology} 115 | } 116 | 117 | @article{bishara2017confidence, 118 | title={Confidence intervals for correlations when data are not normal}, 119 | author={Bishara, Anthony J and Hittner, James B}, 120 | journal={Behavior research methods}, 121 | volume={49}, 122 | number={1}, 123 | pages={294--309}, 124 | year={2017}, 125 | publisher={Springer}, 126 | doi={10.3758/s13428-016-0702-8} 127 | } 128 | 129 | @article{langfelder2012fast, 130 | title={Fast R functions for robust correlations and hierarchical clustering}, 131 | author={Langfelder, Peter and Horvath, Steve}, 132 | journal={Journal of statistical software}, 133 | volume={46}, 134 | number={11}, 135 | year={2012}, 136 | publisher={NIH Public Access}, 137 | url={https://www.jstatsoft.org/v46/i11/} 138 | } 139 | 140 | 141 | @article{fieller1957tests, 142 | title={Tests for rank correlation coefficients. I}, 143 | author={Fieller, Edgar C and Hartley, Herman O and Pearson, Egon S}, 144 | journal={Biometrika}, 145 | volume={44}, 146 | number={3/4}, 147 | pages={470--481}, 148 | year={1957}, 149 | publisher={JSTOR}, 150 | doi={10.1093/biomet/48.1-2.29} 151 | } 152 | 153 | @Manual{BayesFactor, 154 | title = {BayesFactor: Computation of Bayes Factors for Common Designs}, 155 | author = {Richard D. Morey and Jeffrey N. Rouder}, 156 | year = {2018}, 157 | note = {R package version 0.9.12-4.2}, 158 | url = {https://CRAN.R-project.org/package=BayesFactor}, 159 | } 160 | 161 | @article{szekely2009brownian, 162 | title={Brownian distance covariance}, 163 | author={Sz{\'e}kely, G{\'a}bor J and Rizzo, Maria L}, 164 | journal={The annals of applied statistics}, 165 | volume={3}, 166 | number={4}, 167 | pages={1236--1265}, 168 | year={2009}, 169 | publisher={Institute of Mathematical Statistics} 170 | } 171 | 172 | @article{szekely2007measuring, 173 | title={Measuring and testing dependence by correlation of distances}, 174 | author={Sz{\'e}kely, G{\'a}bor J and Rizzo, Maria L and Bakirov, Nail K}, 175 | journal={The annals of statistics}, 176 | volume={35}, 177 | number={6}, 178 | pages={2769--2794}, 179 | year={2007}, 180 | publisher={Institute of Mathematical Statistics} 181 | } 182 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # correlation 0.8.9 2 | 3 | ## Bug Fixes 4 | 5 | - `cormatrix_to_excel()` now works correctly with openxlsx2 v1.16+. Fixed 6 | conditional formatting rule ordering to accommodate openxlsx2's new waterfall 7 | strategy (#361). 8 | 9 | # correlation 0.8.8 10 | 11 | - `correlation()` gains a `missing=` argument, similar to `stats::cor(use=)`, for controlling how missing data is handled. 12 | 13 | - `correlation()` converts numeric input variables automatically into factors when `method = "polychoric"`. 14 | 15 | # correlation 0.8.7 16 | 17 | - The `format()` method for objects of class `easycormatrix` gets a `zap_small` 18 | argument, to round very small numbers. 19 | 20 | - `cor_sort()` can now deal with non-square matrices. 21 | 22 | - Updated required R version to >= 4.1.0 (released May 2021) to pass CRAN checks 23 | on documentation 24 | 25 | # correlation 0.8.6 26 | 27 | - Fix CRAN check issues. 28 | 29 | # correlation 0.8.5 30 | 31 | - New `cormatrix_to_excel()` function for exporting correlation matrices to Excel with color formatting. 32 | - This release changes the licensing model of `{correlation}` to an MIT license. 33 | 34 | # correlation 0.8.4 35 | 36 | - Minor improvements and code revisions due to changes in other packages. 37 | 38 | - Default color scheme for correlation matrices switched to use red for negative 39 | values and blue for positive values. 40 | 41 | # correlation 0.8.3 42 | 43 | ## Breaking Changes 44 | 45 | - `distance_mahalanobis()` is deprecated. Use `performance::check_outliers(method = "mahalanobis_robust")` instead. 46 | 47 | - The minimum needed R version has been bumped to `3.6`. 48 | 49 | ## Minor Changes 50 | 51 | - Fixes breakages caused by updates to *parameters* package (#269). 52 | 53 | - The visualization recipe (plots) for redundant correlation matrices was 54 | improved, so self-correlations will no longer be labelled and get a neutral 55 | color. 56 | 57 | - The `print()` method redundant correlation matrices no longer shows the 58 | diagonal with self-correlations. 59 | 60 | # correlation 0.8.2 61 | 62 | - Maintenance release for *datawizard* package update. 63 | 64 | # correlation 0.8.1 65 | 66 | - Maintenance release for *datawizard* package update. 67 | 68 | # correlation 0.8.0 69 | 70 | ## Breaking Changes 71 | 72 | - `robust` argument, which was deprecated in favour of `ranktransform` in 73 | `0.6.1` release, has now been removed. 74 | 75 | # correlation 0.7.1 76 | 77 | ## Bug Fixes 78 | 79 | - Bug fix in `plot()` methods 80 | 81 | # correlation 0.7.0 82 | 83 | ## Breaking Changes 84 | 85 | - Removes `winsorize()` function, which now lives in `datawizard` package. 86 | 87 | ## New Features 88 | 89 | - New `cor_smooth()` function for smoothing non-positive definite matrices. 90 | 91 | ## Bug Fixes 92 | 93 | - When `data2` was specified `correlation()` was over-correcting for all of the 94 | combinations of variables in the full x and y tables, rather than in just the 95 | ones specified (#195). 96 | 97 | ## Minor Changes 98 | 99 | - `correlation()` gains a new argument `rename` to rename variables. 100 | 101 | - `simualte_simpson()` function is now re-exported from `bayestestR` package. 102 | 103 | - `plot()` for `"easycor_test"` objects now produces an annotated scatter plot. 104 | 105 | # correlation 0.6.1 106 | 107 | ## Breaking Changes 108 | 109 | - `simualte_simpson()`: The groups are now named after the pattern `"G_"` (can 110 | be altered with the `group_prefix` argument). 111 | 112 | - `robust` argument deprecated in favour of `ranktransform`. 113 | 114 | ## New Features 115 | 116 | - `correlation` gains two new arguments: `select` and `select2` to select 117 | specific variables from dataframes to compare (#146). 118 | 119 | - `as.matrix` method works for grouped correlations (#148). 120 | 121 | - New `as.list` method returns a list of various matrices related to correlation 122 | analysis (correlation, number of observations, *p*-values, etc.). 123 | 124 | ## Bug Fixes 125 | 126 | - The `0.6.0` release introduced a bug in Winsorized Pearson correlation where 127 | the missing values were removed from the entire data, instead for each pair 128 | (#151). This is now fixed. 129 | 130 | # correlation 0.6.0 131 | 132 | ## New Features 133 | 134 | - Added `verbose` arguments to some functions, to toggle warnings on/off. 135 | 136 | - `cor_test()` (and hence, `correlation()`) now default the `winsorize` argument 137 | to `.1` when it's set to `TRUE`. 138 | 139 | - The `Method` column in output dataframe is now more explicit about the 140 | correlation method used. 141 | 142 | ## Bug Fixes 143 | 144 | - Winsorization doesn't fail when `NA`s are present (#130). 145 | 146 | ## Minor Changes 147 | 148 | - Fixed CRAN check issues due to changes in dependent packages. 149 | 150 | # correlation 0.5.0 151 | 152 | ## Changes 153 | 154 | - Added `winsorize()` function. 155 | 156 | - Added `winsorize` argument for Winsorized correlations. 157 | 158 | - Added `method = "somers"` to `correlation()`, to compute Somers's Dxy rank 159 | correlation for binary outcomes. 160 | 161 | - New function `display()`, to print output into different formats. Currently, 162 | only markdown is supported. `print_md()` is an alias for `display(format = 163 | "markdown")`. 164 | 165 | ## Bug fixes 166 | 167 | - Fix bug in `cor_to_p()` that gave slightly different test statistics. 168 | 169 | # correlation 0.4.0 170 | 171 | ## Changes 172 | 173 | - Don't error if less than 3 valid observations 174 | ([#100](https://github.com/easystats/correlation/issues/100)). 175 | 176 | - Add "gaussian" rank method. 177 | 178 | - Add "gamma" method. 179 | 180 | - Add "hoeffding" method. 181 | 182 | - Add "blomqvist" method. 183 | 184 | ## Bug fixes 185 | 186 | - Added `Method` column to Bayesian correlations. 187 | 188 | - Fix bug when `robust=TRUE` 189 | ([#87](https://github.com/easystats/effectsize/issues/87)). 190 | 191 | # correlation 0.3.0 192 | 193 | ## Changes 194 | 195 | ## Bug fixes 196 | 197 | # correlation 0.2.1 198 | 199 | ## Changes 200 | 201 | - Added confidence intervals CI support for Spearman and Kendall (#80) 202 | 203 | - Improved documentation (#45, #63) 204 | 205 | ## Bug fixes 206 | 207 | - Removed CI threshold column from `distance_mahalanobis()` 208 | 209 | - Fixed bug (#76) 210 | 211 | # correlation 0.2.0 212 | 213 | ## Changes 214 | 215 | - Some changes were made. 216 | 217 | ## Bug fixes 218 | 219 | - Some bugs were fixed. 220 | 221 | # correlation 0.1.0 222 | 223 | ## Changes 224 | 225 | - Initial CRAN release. 226 | 227 | - Add `plot()`-method for `summary()`. 228 | 229 | ## Bug fixes 230 | 231 | - Fixed issue in `correlation()` for some edge cases when `include_factors = 232 | TRUE`. 233 | 234 | - Fixed issue in `correlation()` for correlation coefficients with less than 235 | four complete pairs of observations (in such cases, `cor_test()` now returns 236 | `NA` for the confidence intervals). 237 | --------------------------------------------------------------------------------