Skip to content

Commit 0800021

Browse files
authored
air
1 parent a4b572d commit 0800021

File tree

83 files changed

+4048
-1599
lines changed

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

83 files changed

+4048
-1599
lines changed

.Rbuildignore

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -53,3 +53,5 @@ hextools
5353
# ^vignettes/(?!additional).*
5454
^vignettes/additional
5555
^LICENSE\.md$
56+
^\.vscode$
57+
^[.]?air[.]toml$

.vscode/extensions.json

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,5 @@
1+
{
2+
"recommendations": [
3+
"Posit.air-vscode"
4+
]
5+
}

.vscode/settings.json

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,10 @@
1+
{
2+
"[r]": {
3+
"editor.formatOnSave": true,
4+
"editor.defaultFormatter": "Posit.air-vscode"
5+
},
6+
"[quarto]": {
7+
"editor.formatOnSave": true,
8+
"editor.defaultFormatter": "quarto.quarto"
9+
}
10+
}

R/cohens_d.R

Lines changed: 112 additions & 41 deletions
Original file line numberDiff line numberDiff line change
@@ -136,34 +136,57 @@
136136
#' Correcting error and bias in research findings. Sage.
137137
#'
138138
#' @export
139-
cohens_d <- function(x, y = NULL, data = NULL,
140-
pooled_sd = TRUE, mu = 0, paired = FALSE,
141-
reference = NULL,
142-
adjust = FALSE,
143-
ci = 0.95, alternative = "two.sided",
144-
verbose = TRUE, ...) {
139+
cohens_d <- function(
140+
x,
141+
y = NULL,
142+
data = NULL,
143+
pooled_sd = TRUE,
144+
mu = 0,
145+
paired = FALSE,
146+
reference = NULL,
147+
adjust = FALSE,
148+
ci = 0.95,
149+
alternative = "two.sided",
150+
verbose = TRUE,
151+
...
152+
) {
145153
var.equal <- eval.parent(match.call()[["var.equal"]])
146-
if (!is.null(var.equal)) pooled_sd <- var.equal
154+
if (!is.null(var.equal)) {
155+
pooled_sd <- var.equal
156+
}
147157

148158
.effect_size_difference(
149159
x,
150-
y = y, data = data,
151-
type = "d", adjust = adjust,
152-
pooled_sd = pooled_sd, mu = mu, paired = paired,
160+
y = y,
161+
data = data,
162+
type = "d",
163+
adjust = adjust,
164+
pooled_sd = pooled_sd,
165+
mu = mu,
166+
paired = paired,
153167
reference = reference,
154-
ci = ci, alternative = alternative,
168+
ci = ci,
169+
alternative = alternative,
155170
verbose = verbose,
156171
...
157172
)
158173
}
159174

160175
#' @rdname cohens_d
161176
#' @export
162-
hedges_g <- function(x, y = NULL, data = NULL,
163-
pooled_sd = TRUE, mu = 0, paired = FALSE,
164-
reference = NULL,
165-
ci = 0.95, alternative = "two.sided",
166-
verbose = TRUE, ...) {
177+
hedges_g <- function(
178+
x,
179+
y = NULL,
180+
data = NULL,
181+
pooled_sd = TRUE,
182+
mu = 0,
183+
paired = FALSE,
184+
reference = NULL,
185+
ci = 0.95,
186+
alternative = "two.sided",
187+
verbose = TRUE,
188+
...
189+
) {
167190
cl <- match.call()
168191
cl[[1]] <- quote(effectsize::cohens_d)
169192
cl$adjust <- TRUE
@@ -172,47 +195,77 @@ hedges_g <- function(x, y = NULL, data = NULL,
172195

173196
#' @rdname cohens_d
174197
#' @export
175-
glass_delta <- function(x, y = NULL, data = NULL,
176-
mu = 0, adjust = TRUE,
177-
reference = NULL,
178-
ci = 0.95, alternative = "two.sided",
179-
verbose = TRUE, ...) {
198+
glass_delta <- function(
199+
x,
200+
y = NULL,
201+
data = NULL,
202+
mu = 0,
203+
adjust = TRUE,
204+
reference = NULL,
205+
ci = 0.95,
206+
alternative = "two.sided",
207+
verbose = TRUE,
208+
...
209+
) {
180210
.effect_size_difference(
181211
x,
182-
y = y, data = data,
212+
y = y,
213+
data = data,
183214
type = "delta",
184-
mu = mu, adjust = adjust,
215+
mu = mu,
216+
adjust = adjust,
185217
reference = reference,
186-
ci = ci, alternative = alternative,
218+
ci = ci,
219+
alternative = alternative,
187220
verbose = verbose,
188-
pooled_sd = NULL, paired = FALSE,
221+
pooled_sd = NULL,
222+
paired = FALSE,
189223
...
190224
)
191225
}
192226

193227

194-
195228
#' @keywords internal
196-
.effect_size_difference <- function(x, y = NULL, data = NULL,
197-
type = "d", adjust = FALSE,
198-
mu = 0, pooled_sd = TRUE, paired = FALSE,
199-
reference = NULL,
200-
ci = 0.95, alternative = "two.sided",
201-
verbose = TRUE, ...) {
202-
if (type == "d" && adjust) type <- "g"
229+
.effect_size_difference <- function(
230+
x,
231+
y = NULL,
232+
data = NULL,
233+
type = "d",
234+
adjust = FALSE,
235+
mu = 0,
236+
pooled_sd = TRUE,
237+
paired = FALSE,
238+
reference = NULL,
239+
ci = 0.95,
240+
alternative = "two.sided",
241+
verbose = TRUE,
242+
...
243+
) {
244+
if (type == "d" && adjust) {
245+
type <- "g"
246+
}
203247

204248
# TODO: Check if we can do anything with `reference` for these classes
205249
if (type != "delta") {
206250
if (.is_htest_of_type(x, "t-test")) {
207251
return(effectsize(x, type = type, verbose = verbose, data = data, ...))
208-
} else if (.is_BF_of_type(x, c("BFoneSample", "BFindepSample"), "t-squared")) {
252+
} else if (
253+
.is_BF_of_type(x, c("BFoneSample", "BFindepSample"), "t-squared")
254+
) {
209255
return(effectsize(x, ci = ci, verbose = verbose, ...))
210256
}
211257
}
212258

213-
214259
alternative <- .match.alt(alternative)
215-
out <- .get_data_2_samples(x, y, data, paired = paired, reference = reference, verbose = verbose, ...)
260+
out <- .get_data_2_samples(
261+
x,
262+
y,
263+
data,
264+
paired = paired,
265+
reference = reference,
266+
verbose = verbose,
267+
...
268+
)
216269
x <- out[["x"]]
217270
y <- out[["y"]]
218271
paired <- out[["paired"]]
@@ -225,7 +278,9 @@ glass_delta <- function(x, y = NULL, data = NULL,
225278

226279
if (is.null(y)) {
227280
if (type == "delta") {
228-
insight::format_error("For Glass' Delta, please provide data from two samples.")
281+
insight::format_error(
282+
"For Glass' Delta, please provide data from two samples."
283+
)
229284
}
230285
y <- 0
231286
is_paired_or_onesample <- TRUE
@@ -236,7 +291,9 @@ glass_delta <- function(x, y = NULL, data = NULL,
236291
# Compute index
237292
if (is_paired_or_onesample) {
238293
if (type == "delta") {
239-
insight::format_error("This effect size is only applicable for two independent samples.")
294+
insight::format_error(
295+
"This effect size is only applicable for two independent samples."
296+
)
240297
}
241298

242299
d <- mean(x - y)
@@ -304,17 +361,31 @@ glass_delta <- function(x, y = NULL, data = NULL,
304361

305362
if (adjust) {
306363
J <- .J(df1)
307-
col_to_adjust <- intersect(colnames(out), c(types[type], "CI_low", "CI_high"))
364+
col_to_adjust <- intersect(
365+
colnames(out),
366+
c(types[type], "CI_low", "CI_high")
367+
)
308368
out[, col_to_adjust] <- out[, col_to_adjust] * J
309369

310370
if (type == "delta") {
311371
colnames(out)[1] <- "Glass_delta_adjusted"
312372
}
313373
}
314374

315-
class(out) <- c("effectsize_difference", "effectsize_table", "see_effectsize_table", class(out))
375+
class(out) <- c(
376+
"effectsize_difference",
377+
"effectsize_table",
378+
"see_effectsize_table",
379+
class(out)
380+
)
316381
.someattributes(out) <- .nlist(
317-
paired, pooled_sd, mu, ci, ci_method, alternative, adjust,
382+
paired,
383+
pooled_sd,
384+
mu,
385+
ci,
386+
ci_method,
387+
alternative,
388+
adjust,
318389
approximate = FALSE
319390
)
320391
out

R/cohens_g.R

Lines changed: 10 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -52,16 +52,13 @@
5252
#' # Test 2 gives a negative result more than test 1!
5353
#'
5454
#' @export
55-
cohens_g <- function(x, y = NULL,
56-
ci = 0.95, alternative = "two.sided",
57-
...) {
55+
cohens_g <- function(x, y = NULL, ci = 0.95, alternative = "two.sided", ...) {
5856
alternative <- .match.alt(alternative)
5957

6058
if (.is_htest_of_type(x, "McNemar")) {
6159
return(effectsize(x, ci = ci, alternative = alternative))
6260
}
6361

64-
6562
if (!is.matrix(x)) {
6663
if (is.null(y)) {
6764
insight::format_error("if 'x' is not a matrix, 'y' must be given")
@@ -73,14 +70,17 @@ cohens_g <- function(x, y = NULL,
7370
x <- as.factor(x[OK])
7471
y <- as.factor(y[OK])
7572
if ((nlevels(x) < 2) || (nlevels(y) != nlevels(x))) {
76-
insight::format_error("'x' and 'y' must have the same number of levels (minimum 2)")
73+
insight::format_error(
74+
"'x' and 'y' must have the same number of levels (minimum 2)"
75+
)
7776
}
7877
x <- table(x, y)
7978
} else if ((nrow(x) < 2) || (ncol(x) != nrow(x))) {
80-
insight::format_error("'x' must be square with at least two rows and columns")
79+
insight::format_error(
80+
"'x' must be square with at least two rows and columns"
81+
)
8182
}
8283

83-
8484
a <- x[upper.tri(x)]
8585
b <- t(x)[upper.tri(x)]
8686

@@ -95,7 +95,9 @@ cohens_g <- function(x, y = NULL,
9595
n <- sum(a) + sum(b)
9696
k <- P * n
9797

98-
res <- stats::prop.test(k, n,
98+
res <- stats::prop.test(
99+
k,
100+
n,
99101
p = 0.5,
100102
alternative = alternative,
101103
conf.level = ci,

0 commit comments

Comments
 (0)