You signed in with another tab or window. Reload to refresh your session.You signed out in another tab or window. Reload to refresh your session.You switched accounts on another tab or window. Reload to refresh your session.Dismiss alert
#' Perform nominal/ordinal analysis on 1 dimensional table for goodnes-of-fit chi-squared, and two dimensional data for Pearson chi-squared, Fisher exact test or (if paired), McNemar test reporting their corresponding stats and effect sizes in APA Style.
4
+
#' @param data Data frame containing the variables `x` and `y`.
5
+
#' @param x Factor variable, quoted or unquoted.
6
+
#' @param y Factor. If `NULL`, a goodness-of-fit is carried, otherwise a two-way analysis is performed.
7
+
#' @param paired Logical. If `TRUE` McNemar's Chi-squared test is carried on.
8
+
#' @param exact Logical. If `TRUE` then Fisher's Exact Test is carried on, but only when `paired = FALSE` (default). If is a 2 x 2 design, Odds Ratio (OR) is returned as effect size, otherwise it will only return the formated p-value.
9
+
#' @param markdown Whether you want the output formated for inline R Markdown or as plain text.
10
+
#' @param ... Currently not used.
11
+
#' @keywords contingency
12
+
#' @return A list of length 3 or 2 with statistical test and `$method` used.
13
+
#' @export
14
+
15
+
contingency<-function(data
16
+
, x
17
+
, y=NULL
18
+
, paired=FALSE
19
+
, exact=FALSE
20
+
, markdown=TRUE
21
+
, ...) {
22
+
.arg<- match.call()
23
+
24
+
x.var<-data[[.arg$x]]
25
+
if(is.null(.arg$y)) {
26
+
way<-"One"
27
+
} else {
28
+
y.var<-data[[.arg$y]]
29
+
way<-"Two"
30
+
}
31
+
32
+
result<-list()
33
+
test<-if(isTRUE(paired)) "Mcnemar"else
34
+
if(isTRUE(exact)) "Exact"else
35
+
"Chi"
36
+
37
+
if(test=="Chi") {
38
+
tab<-if(way=="One")
39
+
list(table(x.var),
40
+
"gof",
41
+
"Chi-squared test for given probabilities") else
42
+
list(table(x.var, y.var),
43
+
"Pearson",
44
+
"Pearson's Chi-squared test")
45
+
test<-stats::chisq.test(
46
+
x=tab[[1]],
47
+
correct=FALSE)
48
+
es<-effectsize::cramers_v(
49
+
x=tab[[1]],
50
+
adjust=FALSE)
51
+
expr<-if(isTRUE(markdown))
52
+
list(a= paste0("$\\chi^2_{~", tab[[2]], "}$ ("),
53
+
b=", $p$ ",
54
+
c="$V_{~Cramer}$ = ",
55
+
d=', CI~95%~[') else
56
+
list(a="X^2 (",
57
+
b=", p ",
58
+
c="V = ",
59
+
d=', CI95% [')
60
+
result[['full']] <- paste0(
61
+
result[['stats']] <- paste0(
62
+
expr$a,
63
+
test$parameter,
64
+
") = ",
65
+
round(test$statistic,2),
66
+
expr$b,
67
+
ifelse(
68
+
test$p.value<0.001,
69
+
'< 0.001',
70
+
paste(
71
+
'=',
72
+
round(test$p.value, 3)
73
+
)
74
+
)
75
+
), ', ',
76
+
result[['es']] <- paste0(
77
+
expr$c,
78
+
round(es$Cramers_v,2),
79
+
expr$d,
80
+
round(es$CI_low,2),
81
+
', ',
82
+
round(es$CI_high,2),
83
+
']')
84
+
)
85
+
result[['method']] <-tab[[3]]
86
+
return(result)
87
+
88
+
} else {
89
+
if(test=="Exact") {
90
+
tab<- table(x.var, y.var)
91
+
test<-stats::fisher.test(
92
+
x=tab)
93
+
error<- class(
94
+
try(
95
+
expr= {
96
+
(es<-effectsize::oddsratio(
97
+
x=x.var,
98
+
y=y.var) )
99
+
},
100
+
silent=TRUE)
101
+
) =="try-error"
102
+
if(isTRUE(error)) {
103
+
expr<-if(isTRUE(markdown))
104
+
list(a="$p_{~FET}$ ") else
105
+
list(a="FET, p ")
106
+
result[['full']] <- paste0(
107
+
result[['stats']] <- paste0(
108
+
expr$a,
109
+
ifelse(
110
+
test=test$p.value<0.001,
111
+
yes='< 0.001',
112
+
no= paste(
113
+
'=',
114
+
round(test$p.value, 3)
115
+
)
116
+
)
117
+
)
118
+
)
119
+
result[['es']] <-"Not available"
120
+
result[['method']] <-"Fisher's Exact Test for Count Data"
121
+
return(result)
122
+
} else {
123
+
expr<-if(isTRUE(markdown))
124
+
list(a="$p_{~FET}$ ",
125
+
b="$OR$ = ",
126
+
c=', CI~95%~[') else
127
+
list(a="FET: p ",
128
+
b="OR = ",
129
+
c=', CI95% [')
130
+
result[['full']] <- paste0(
131
+
result[['stats']] <- paste0(
132
+
expr$a,
133
+
ifelse(
134
+
test=test$p.value<0.001,
135
+
yes='< 0.001',
136
+
no= paste(
137
+
'=',
138
+
round(test$p.value, 3)
139
+
)
140
+
)
141
+
)
142
+
, ', ',
143
+
result[['es']] <- paste0(
144
+
expr$b,
145
+
round(es$Odds_ratio,2),
146
+
expr$c,
147
+
round(es$CI_low,2),
148
+
', ',
149
+
round(es$CI_high,2),
150
+
']')
151
+
)
152
+
result[['method']] <-"Fisher's Exact Test for Count Data"
0 commit comments