Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Replace stats::cor with psych:corr to allow for p-correction (and some other formatting issues) #877

Open
wants to merge 17 commits into
base: master
Choose a base branch
from
Open

Replace stats::cor with psych:corr to allow for p-correction (and some other formatting issues) #877

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
17 commits
Select commit Hold shift + click to select a range
8178278
Change p.zero to function argument
cschwarz007 Jan 30, 2023
9a25027
Add new value.zero parameter to toggle leading zeros for values on / off
cschwarz007 Jan 30, 2023
5e7a971
Correction to value_zero
cschwarz007 Jan 30, 2023
afca812
Update tab_corr.R
cschwarz007 Jan 30, 2023
304ee89
Update DESCRIPTION
cschwarz007 Jan 30, 2023
ea6d4fa
Update tab_corr.R
cschwarz007 Jan 30, 2023
4eb21a6
Replace stats with psych for corr
cschwarz007 Jan 30, 2023
c405cde
Update DESCRIPTION
cschwarz007 Jan 30, 2023
a950fc3
Update tab_corr.R
cschwarz007 Jan 30, 2023
9bfaef8
Update tab_corr.R
cschwarz007 Jan 30, 2023
15ed556
Update tab_corr.R
cschwarz007 Jan 30, 2023
4304861
Update tab_corr.R
cschwarz007 Jan 30, 2023
afb5b76
Update tab_corr.R
cschwarz007 Jan 30, 2023
303c014
Update tab_corr.R
cschwarz007 Jan 30, 2023
7a018ad
Update tab_corr.R
cschwarz007 Jan 30, 2023
2395bbd
Merge branch 'master' into master
strengejacke Mar 31, 2023
3fff963
Merge branch 'master' into master
strengejacke Oct 4, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 3 additions & 3 deletions DESCRIPTION
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,7 @@ Package: sjPlot
Type: Package
Encoding: UTF-8
Title: Data Visualization for Statistics in Social Science
Version: 2.8.16.1
Version: 2.8.16.2
Authors@R: c(
person("Daniel", "Lüdecke", email = "d.luedecke@uke.de", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-8895-3206")),
person("Alexander", "Bartel", role = "ctb", comment = c(ORCID = "0000-0002-1280-6138")),
Expand Down Expand Up @@ -38,6 +38,7 @@ Imports:
parameters,
performance,
purrr,
psych,
rlang,
scales,
sjlabelled (>= 1.1.2),
Expand All @@ -60,8 +61,7 @@ Suggests:
httr,
lme4,
nFactors,
pscl,
psych,
pscl,
rmarkdown,
rstanarm,
sandwich,
Expand Down
109 changes: 52 additions & 57 deletions R/tab_corr.R
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,15 +1,16 @@
#' @title Summary of correlations as HTML table
#' @title Summary of correlations as HTML table (adjusted)
#' @name tab_corr
#'
#' @description Shows the results of a computed correlation as HTML table. Requires either
#' a \code{\link{data.frame}} or a matrix with correlation coefficients
#' as returned by the \code{\link{cor}}-function.
#' as returned by the \code{\link{psych::corr}}-function.
#' Note: The adjusted p-values will be shown in the lower triangle only.
#'
#' @param data Matrix with correlation coefficients as returned by the
#' \code{\link{cor}}-function, or a \code{data.frame} of variables where
#' correlations between columns should be computed.
#' @param na.deletion Indicates how missing values are treated. May be either
#' \code{"listwise"} (default) or \code{"pairwise"}. May be
#' \code{"pairwise"} (default) or \code{"complete"}. May be
#' abbreviated.
#' @param corr.method Indicates the correlation computation method. May be one of
#' \code{"pearson"} (default), \code{"spearman"} or \code{"kendall"}.
Expand All @@ -33,6 +34,13 @@
#' correlated items) that can be used to display content in the diagonal cells
#' where row and column item are identical (i.e. the "self-correlation"). By defauilt,
#' this argument is \code{NULL} and the diagnal cells are empty.
#' @param value.zero Logical, if \code{TRUE}, the values are printed with leading zero,
#' otherwise not.
#' @param p.zero Logical, if \code{TRUE}, the p-values are printed with leading zero,
#' otherwise not.
#' @param adjust.p Indicates the adjustment for multiple tests to be used. May be one of
#' \code{"holm"} (default), \code{"hochberg"}, \code{"hommel"}, \code{"bonferroni"},
#' \code{"BH"}, \code{"BY"}, \code{"fdr"} or \code{"none"}, May be abbreviated.
#'
#' @inheritParams tab_model
#' @inheritParams tab_xtab
Expand Down Expand Up @@ -88,10 +96,11 @@
#' tab_corr(efc[, c(start:end)], triangle = "lower",val.rm = 0.3,
#' CSS = list(css.valueremove = 'color:blue;'))
#' }}
#' @importFrom stats na.omit cor cor.test
#' @importFrom stats cor
#' @importFrom psych corr.test
#' @export
tab_corr <- function(data,
na.deletion = c("listwise", "pairwise"),
na.deletion = c("pairwise", "listwise"),
corr.method = c("pearson", "spearman", "kendall"),
title = NULL,
var.labels = NULL,
Expand All @@ -107,21 +116,35 @@ tab_corr <- function(data,
encoding = NULL,
file = NULL,
use.viewer = TRUE,
remove.spaces = TRUE) {
remove.spaces = TRUE,
value.zero = FALSE,
p.zero = FALSE,
adjust.p = c("holm", "hochberg", "hommel", "bonferroni", "BH", "BY", "fdr", "none")) {
# --------------------------------------------------------
# check p-value-style option
# check p- / value-style option
# --------------------------------------------------------
opt <- getOption("p_zero")
if (is.null(opt) || opt == FALSE) {
p_zero <- ""
if (value.zero) {
value_zero <- "0"
} else {
p_zero <- "0"
value_zero <- ""
}

if (p.zero) {
p_zero <- "0"
} else {
p_zero <- ""
}
# --------------------------------------------------------
# check args
# --------------------------------------------------------
na.deletion <- match.arg(na.deletion)
if (na.deletion == "listwise") {
na_deletion = "complete"
} else {
na_deletion = "pairwise"
}
corr.method <- match.arg(corr.method)
adjust.p <- match.arg(adjust.p)
# --------------------------------------------------------
# check encoding
# --------------------------------------------------------
Expand Down Expand Up @@ -156,43 +179,8 @@ tab_corr <- function(data,
corr <- data
cpvalues <- NULL
} else {
# missing deletion corresponds to
# SPSS listwise
if (na.deletion == "listwise") {
data <- stats::na.omit(data)
corr <- stats::cor(data, method = corr.method)
} else {
# missing deletion corresponds to
# SPSS pairwise
corr <- stats::cor(data,
method = corr.method,
use = "pairwise.complete.obs")
}
#---------------------------------------
# if we have a data frame as argument,
# compute p-values of significances
#---------------------------------------
computePValues <- function(df) {
cp <- c()
for (i in 1:ncol(df)) {
pv <- c()
for (j in 1:ncol(df)) {
test <- suppressWarnings(
stats::cor.test(
df[[i]],
df[[j]],
alternative = "two.sided",
method = corr.method
)
)

pv <- cbind(pv, round(test$p.value, 5))
}
cp <- rbind(cp, pv)
}
return(cp)
}
cpvalues <- computePValues(data)
corr <- psych::corr.test(data, method = corr.method, use = na_deletion, adjust = adjust.p)
cpvalues <- t(corr$p)
}
# --------------------------------------------------------
# save original p-values
Expand Down Expand Up @@ -241,7 +229,7 @@ tab_corr <- function(data,
# if not, use variable names from data frame
# ----------------------------
if (is.null(var.labels)) {
var.labels <- row.names(corr)
var.labels <- row.names(corr$r)
}
# check length of x-axis-labels and split longer strings at into new lines
var.labels <- sjmisc::word_wrap(var.labels, wrap.labels, "<br>")
Expand Down Expand Up @@ -323,7 +311,7 @@ tab_corr <- function(data,
# first column
page.content <- paste0(page.content, " <th class=\"thead\">&nbsp;</th>\n")
# iterate columns
for (i in 1:ncol(corr)) {
for (i in 1:ncol(corr$r)) {
page.content <- paste0(page.content, sprintf(" <th class=\"thead\">%s</th>\n", var.labels[i]))
}
# close table row
Expand All @@ -332,20 +320,20 @@ tab_corr <- function(data,
# data rows
# -------------------------------------
# iterate all rows of df
for (i in 1:nrow(corr)) {
for (i in 1:nrow(corr$r)) {
# write tr-tag
page.content <- paste0(page.content, " <tr>\n")
# print first table cell
page.content <- paste0(page.content, sprintf(" <td class=\"firsttablecol\">%s</td>\n", var.labels[i]))
# --------------------------------------------------------
# iterate all columns
# --------------------------------------------------------
for (j in 1:ncol(corr)) {
for (j in 1:ncol(corr$r)) {
# --------------------------------------------------------
# leave out self-correlations
# --------------------------------------------------------
if (j == i) {
if (is.null(string.diag) || length(string.diag) > ncol(corr)) {
if (is.null(string.diag) || length(string.diag) > ncol(corr$r)) {
page.content <- paste0(page.content, " <td class=\"tdata centeralign\">&nbsp;</td>\n")
} else {
page.content <- paste0(page.content, sprintf(" <td class=\"tdata centeralign\">%s</td>\n",
Expand All @@ -360,7 +348,8 @@ tab_corr <- function(data,
# --------------------------------------------------------
# print table-cell-data (cor-value)
# --------------------------------------------------------
cellval <- sprintf("%.*f", digits, corr[i, j])
# cellval <- sprintf("%.*f", digits, corr[i, j])
cellval <- sub("0", value_zero, sprintf("%.*f", digits, corr$r[i, j]))
# --------------------------------------------------------
# check whether we want to show P-Values
# --------------------------------------------------------
Expand Down Expand Up @@ -397,7 +386,7 @@ tab_corr <- function(data,
# check whether correlation value is too small and should
# be omitted
# --------------------------------------------------------
if (!is.null(val.rm) && abs(corr[i, j]) < abs(val.rm)) {
if (!is.null(val.rm) && abs(corr$r[i, j]) < abs(val.rm)) {
value.remove <- " valueremove"
}
page.content <- paste0(page.content, sprintf(" <td class=\"tdata centeralign%s%s\">%s</td>\n",
Expand All @@ -416,8 +405,14 @@ tab_corr <- function(data,
# feedback...
# -------------------------------------
page.content <- paste0(page.content, " <tr>\n")
page.content <- paste0(page.content, sprintf(" <td colspan=\"%i\" class=\"summary\">", ncol(corr) + 1))
page.content <- paste0(page.content, sprintf("Computed correlation used %s-method with %s-deletion.", corr.method, na.deletion))
page.content <- paste0(page.content, sprintf(" <td colspan=\"%i\" class=\"summary\">", ncol(corr$r) + 1))
if(triangle == "both") {
page.content <- paste0(page.content, sprintf("Computed correlation used %s-method with %s-deletion and %s p-adjustment shown in lower triangle.", corr.method, na.deletion, adjust.p))
} else if(triangle == "lower") {
page.content <- paste0(page.content, sprintf("Computed correlation used %s-method with %s-deletion and %s p-adjustment.", corr.method, na.deletion, adjust.p))
} else {
page.content <- paste0(page.content, sprintf("Computed correlation used %s-method with %s-deletion and without p-adjustment.", corr.method, na.deletion))
}
page.content <- paste0(page.content, "</td>\n </tr>\n")
# -------------------------------------
# finish table
Expand Down
Loading