/
cor_test_polychoric.R
51 lines (44 loc) · 1.57 KB
/
cor_test_polychoric.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
#' @importFrom stats complete.cases
#' @importFrom utils capture.output
#' @keywords internal
.cor_test_polychoric <- function(data, x, y, ci = 0.95, ...) {
if (!requireNamespace("psych", quietly = TRUE)) {
stop("Package `psych` required for tetrachoric correlations. Please install it by running `install.packages('psych').", call. = FALSE)
}
var_x <- .complete_variable_x(data, x, y)
var_y <- .complete_variable_y(data, x, y)
# Sanity check
if (!is.factor(var_x) & !is.factor(var_y)) {
stop("Polychoric correlations can only be ran on ordinal factors.")
}
if (!is.factor(var_x) | !is.factor(var_y)) {
if (!requireNamespace("polycor", quietly = TRUE)) {
stop("Package `polycor` required for polyserial correlations. Please install it by running `install.packages('polycor').", call. = FALSE)
}
r <- polycor::polyserial(
x = if (is.factor(var_x)) as.numeric(var_y) else as.numeric(var_x),
y = if (is.factor(var_x)) as.numeric(var_x) else as.numeric(var_y)
)
method <- "Polyserial"
} else {
# Reconstruct dataframe
dat <- data.frame(as.numeric(var_x), as.numeric(var_y))
names(dat) <- c(x, y)
junk <- capture.output(r <- psych::polychoric(dat)$rho[2, 1])
method <- "Polychoric"
}
p <- cor_to_p(r, n = nrow(data))
ci_vals <- cor_to_ci(r, n = nrow(data), ci = ci)
data.frame(
Parameter1 = x,
Parameter2 = y,
rho = r,
t = p$statistic,
df = length(var_x) - 2,
p = p$p,
CI_low = ci_vals$CI_low,
CI_high = ci_vals$CI_high,
Method = method,
stringsAsFactors = FALSE
)
}