-
-
Notifications
You must be signed in to change notification settings - Fork 22
/
Copy pathsummary.R
101 lines (81 loc) · 2.99 KB
/
summary.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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
#' @export
summary.estimate_slopes <- function(object, verbose = TRUE, ...) {
out <- as.data.frame(object)
by <- attributes(object)$by
if (verbose && nrow(out) < 50) {
insight::format_alert("There might be too few data to accurately determine intervals. Consider setting `length = 100` (or larger) in your call to `estimate_slopes()`.") # nolint
}
# Add "Confidence" col based on the sig index present in the data
out$Confidence <- .estimate_slopes_significance(out, ...)
out$Direction <- .estimate_slopes_direction(out, ...)
# if we have more than one variable in `by`, group result table and
# add group name as separate column
if (length(by) > 1) {
parts <- split(out, out[[by[2]]])
out <- do.call(rbind, lapply(parts, .estimate_slope_parts, by = by[1]))
out <- datawizard::rownames_as_column(out, "Group")
out$Group <- gsub("\\.\\d+$", "", out$Group)
} else {
out <- .estimate_slope_parts(out, by)
}
attributes(out) <- utils::modifyList(attributes(object), attributes(out))
class(out) <- c("summary_estimate_slopes", "data.frame")
attr(out, "table_title") <- c("Johnson-Neymann Intervals", "blue")
out
}
#' @export
summary.reshape_grouplevel <- function(object, ...) {
x <- object[!duplicated(object), ]
row.names(x) <- NULL
x
}
# Utilities ===============================================================
.estimate_slope_parts <- function(out, by) {
# mark all "changes" from negative to positive and vice versa
index <- 1
out$switch <- index
index <- index + 1
for (i in 2:nrow(out)) {
if (out$Direction[i] != out$Direction[i - 1] || out$Confidence[i] != out$Confidence[i - 1]) {
out$switch[i:nrow(out)] <- index # styler: off
index <- index + 1
}
}
# split into "switches"
parts <- split(out, out$switch)
do.call(rbind, lapply(parts, function(i) {
data.frame(
Start = i[[by]][1],
End = i[[by]][nrow(i)],
Direction = i$Direction[1],
Confidence = i$Confidence[1]
)
}))
}
.estimate_slopes_direction <- function(data, ...) {
centrality_columns <- datawizard::extract_column_names(
data,
c("Coefficient", "Slope", "Median", "Mean", "MAP_Estimate"),
verbose = FALSE
)
ifelse(data[[centrality_columns]] < 0, "negative", "positive")
}
.estimate_slopes_significance <- function(x, confidence = "auto", ...) {
insight::check_if_installed("effectsize")
if (confidence == "auto") {
# TODO: make sure all of these work
if ("BF" %in% names(x)) confidence <- "BF"
if ("p" %in% names(x)) confidence <- "p"
if ("pd" %in% names(x)) confidence <- "pd"
}
switch(confidence,
p = tools::toTitleCase(effectsize::interpret_p(x$p, ...)),
BF = tools::toTitleCase(effectsize::interpret_bf(x$BF, ...)),
pd = tools::toTitleCase(effectsize::interpret_pd(x$pd, ...)),
{
# Based on CI
out <- ifelse((x$CI_high < 0 & x$CI_low < 0) | (x$CI_high > 0 & x$CI_low > 0), "Significant", "Uncertain")
factor(out, levels = c("Uncertain", "Significant"))
}
)
}