Skip to content

Commit 2613d76

Browse files
M-ColleyM-Colley
authored
Update r_functionality.R
1 parent 4d5a1f4 commit 2613d76

1 file changed

Lines changed: 98 additions & 97 deletions

File tree

‎r_functionality.R‎

Lines changed: 98 additions & 97 deletions
Original file line numberDiff line numberDiff line change
@@ -41,16 +41,16 @@ load_or_install_package <- function(pkg) {
4141
FALSE
4242
}
4343

44-
rcode_packages <- c(
45-
"httr", "easystats", "tidyverse", "Cairo", "rstatix", "afex", "Hmisc", "FSA",
46-
"PMCMRplus", "psych", "pals", "wesanderson", "ggstatsplot", "ARTool",
47-
"pastecs", "rstantools", "styler", "assertthat", "reporttools", "stargazer",
48-
"writexl", "cli", "DT", "flexdashboard", "sjPlot", "emmeans", "stringr",
49-
"ggpmisc", "ggtext", "marginaleffects", "scales", "conflicted", "curl",
50-
"clipr", "car", "dunn.test", "xtable", "readxl", "BayesFactor", "bayestestR",
51-
"foreign", "see", "marginaleffects", "effectsize", "ggsignif", "emoa",
52-
"RColorBrewer"
53-
)
44+
rcode_packages <- c(
45+
"httr", "easystats", "tidyverse", "Cairo", "rstatix", "afex", "Hmisc", "FSA",
46+
"PMCMRplus", "psych", "pals", "wesanderson", "ggstatsplot", "ARTool",
47+
"pastecs", "rstantools", "styler", "assertthat", "reporttools", "stargazer",
48+
"writexl", "cli", "DT", "flexdashboard", "sjPlot", "emmeans", "stringr",
49+
"ggpmisc", "ggtext", "marginaleffects", "scales", "conflicted", "curl",
50+
"clipr", "car", "dunn.test", "xtable", "readxl", "BayesFactor", "bayestestR",
51+
"foreign", "see", "marginaleffects", "effectsize", "ggsignif", "emoa",
52+
"RColorBrewer"
53+
)
5454

5555
invisible(lapply(unique(rcode_packages), load_or_install_package))
5656

@@ -66,24 +66,24 @@ try(easystats::easystats_update(ask = FALSE), silent = TRUE)
6666

6767
# afex: necessary for ggstatsplot
6868
# Hmisc: necessary for mean_cl_normal --> 95% confidence intervals
69-
library(tidyverse)
70-
71-
72-
# Provide a lightweight fallback for the `not_empty` helper so that
73-
# tests can run even when the package is unavailable.
74-
not_empty <- local({
75-
if (requireNamespace("assertthat", quietly = TRUE)) {
76-
getExportedValue("assertthat", "not_empty")
77-
} else {
78-
function(x, msg = "Input must not be empty.") {
79-
if (is.null(x) || length(x) == 0 || (is.atomic(x) && all(is.na(x)))) {
80-
stop(msg, call. = FALSE)
81-
}
82-
invisible(TRUE)
83-
}
84-
}
85-
})
86-
69+
library(tidyverse)
70+
71+
72+
# Provide a lightweight fallback for the `not_empty` helper so that
73+
# tests can run even when the package is unavailable.
74+
not_empty <- local({
75+
if (requireNamespace("assertthat", quietly = TRUE)) {
76+
getExportedValue("assertthat", "not_empty")
77+
} else {
78+
function(x, msg = "Input must not be empty.") {
79+
if (is.null(x) || length(x) == 0 || (is.atomic(x) && all(is.na(x)))) {
80+
stop(msg, call. = FALSE)
81+
}
82+
invisible(TRUE)
83+
}
84+
}
85+
})
86+
8787

8888
# JANUARY 2025: no longer available
8989
# source_url("http://www.uni-koeln.de/~luepsen/R/np.anova.R")
@@ -911,10 +911,10 @@ checkAssumptionsForAnova <- function(data, y, factors) {
911911
return("You must take the non-parametric ANOVA as Levene’s test is significant (p < 0.05).")
912912
}
913913

914-
message("You may take parametric ANOVA (function anova_test). See https://www.datanovia.com/en/lessons/anova-in-r/#check-assumptions-1 for more information.")
915-
916-
invisible(NULL)
917-
}
914+
message("You may take parametric ANOVA (function anova_test). See https://www.datanovia.com/en/lessons/anova-in-r/#check-assumptions-1 for more information.")
915+
916+
invisible(NULL)
917+
}
918918

919919

920920
#' Generate the Latex-text based on the NPAV by Lüpsen (see \url{http://www.uni-koeln.de/~luepsen/R/}).
@@ -1115,46 +1115,46 @@ reportNPAVChi <- function(model, dv = "Testdependentvariable", write_to_clipboar
11151115
stringtowrite <- paste0("The NPAV found a significant main effect of \\", trimws(model$descriptions[i]), " on ", dv, " (\\chisq~(1)=", Chivalue, ", ", pValue, ")")
11161116
}
11171117

1118-
effect_size_text <- ""
1119-
if (!is.null(sample_size) && is.numeric(sample_size) && sample_size > 0) {
1120-
effect_size <- tryCatch(
1121-
effectsize::chisq_to_w(
1122-
chi = Chivalue,
1123-
n = sample_size,
1124-
ci = 0.95
1125-
),
1126-
error = function(e) NULL
1127-
)
1128-
1129-
w_value <- sqrt(Chivalue / sample_size)
1130-
ci_low <- NULL
1131-
ci_high <- NULL
1132-
1133-
if (!is.null(effect_size)) {
1134-
effect_size <- as.data.frame(effect_size)
1135-
w_value <- effect_size$Cohens_w %||% w_value
1136-
ci_low <- effect_size$CI_low
1137-
ci_high <- effect_size$CI_high
1138-
}
1139-
1140-
if (!is.null(w_value) && !is.na(w_value)) {
1141-
effect_size_text <- paste0(
1142-
", $w=",
1143-
sprintf("%.2f", w_value)
1144-
)
1145-
1146-
if (!is.null(ci_low) && !is.null(ci_high) && !any(is.na(c(ci_low, ci_high)))) {
1147-
effect_size_text <- paste0(
1148-
effect_size_text,
1149-
" [",
1150-
sprintf("%.2f", ci_low),
1151-
", ",
1152-
sprintf("%.2f", ci_high),
1153-
"]"
1154-
)
1155-
}
1156-
}
1157-
}
1118+
effect_size_text <- ""
1119+
if (!is.null(sample_size) && is.numeric(sample_size) && sample_size > 0) {
1120+
effect_size <- tryCatch(
1121+
effectsize::chisq_to_w(
1122+
chi = Chivalue,
1123+
n = sample_size,
1124+
ci = 0.95
1125+
),
1126+
error = function(e) NULL
1127+
)
1128+
1129+
w_value <- sqrt(Chivalue / sample_size)
1130+
ci_low <- NULL
1131+
ci_high <- NULL
1132+
1133+
if (!is.null(effect_size)) {
1134+
effect_size <- as.data.frame(effect_size)
1135+
w_value <- effect_size$Cohens_w %||% w_value
1136+
ci_low <- effect_size$CI_low
1137+
ci_high <- effect_size$CI_high
1138+
}
1139+
1140+
if (!is.null(w_value) && !is.na(w_value)) {
1141+
effect_size_text <- paste0(
1142+
", $w=",
1143+
sprintf("%.2f", w_value)
1144+
)
1145+
1146+
if (!is.null(ci_low) && !is.null(ci_high) && !any(is.na(c(ci_low, ci_high)))) {
1147+
effect_size_text <- paste0(
1148+
effect_size_text,
1149+
" [",
1150+
sprintf("%.2f", ci_low),
1151+
", ",
1152+
sprintf("%.2f", ci_high),
1153+
"]"
1154+
)
1155+
}
1156+
}
1157+
}
11581158

11591159
stringtowrite <- paste0(stringtowrite, effect_size_text, ". ")
11601160

@@ -1846,24 +1846,24 @@ reportDunnTestTable <- function(d = NULL, data, iv = "testiv", dv = "testdv", or
18461846
# Format effect size
18471847
table$r <- formatC(table$r, digits = 2, format = "f")
18481848

1849-
# Adjust the xtable call to handle the modified columns
1850-
if (requireNamespace("xtable", quietly = TRUE)) {
1851-
xtable_obj <- xtable::xtable(table,
1852-
digits = c(0, 0, 4, 0, 0),
1853-
caption = paste0("Post-hoc comparisons for independent variable \\", iv,
1854-
" and dependent variable \\", dv,
1855-
". Positive Z-values mean that the first-named level is sig. higher than the second-named. For negative Z-values, the opposite is true. Effect size reported as rank-biserial correlation (r)."),
1856-
label = paste0("tab:posthoc-", iv, "-", dv))
1857-
1858-
print(xtable_obj, type = "latex", size = latexSize, caption.placement = "top", include.rownames = FALSE)
1859-
} else {
1860-
cat(paste0(
1861-
"Post-hoc comparisons for independent variable \", iv,
1862-
" and dependent variable \", dv,
1863-
". Positive Z-values mean that the first-named level is sig. higher than the second-named. For negative Z-values, the opposite is true. Effect size reported as rank-biserial correlation (r).\n"
1864-
))
1865-
print(table)
1866-
}
1849+
# Adjust the xtable call to handle the modified columns
1850+
if (requireNamespace("xtable", quietly = TRUE)) {
1851+
xtable_obj <- xtable::xtable(table,
1852+
digits = c(0, 0, 4, 0, 0),
1853+
caption = paste0("Post-hoc comparisons for independent variable \\", iv,
1854+
" and dependent variable \\", dv,
1855+
". Positive Z-values mean that the first-named level is sig. higher than the second-named. For negative Z-values, the opposite is true. Effect size reported as rank-biserial correlation (r)."),
1856+
label = paste0("tab:posthoc-", iv, "-", dv))
1857+
1858+
print(xtable_obj, type = "latex", size = latexSize, caption.placement = "top", include.rownames = FALSE)
1859+
} else {
1860+
cat(paste0(
1861+
"Post-hoc comparisons for independent variable \\", iv,
1862+
" and dependent variable \", dv,
1863+
". Positive Z-values mean that the first-named level is sig. higher than the second-named. For negative Z-values, the opposite is true. Effect size reported as rank-biserial correlation (r).\n"
1864+
))
1865+
print(table)
1866+
}
18671867
}
18681868
18691869
#' Report statistical details for ggstatsplot.
@@ -1987,13 +1987,13 @@ replace_values <- function(data, to_replace, replace_with) {
19871987
#' @importFrom tidyverse select bind_rows bind_cols
19881988
#' @importFrom readxl read_excel
19891989
#' @importFrom writexl write_xlsx
1990-
reshape_data <- function(input_filepath, sheetName = "Results", marker = "videoinfo", id_col = "ID", output_filepath) {
1991-
# Read the Excel file into a data frame. If the requested sheet is missing,
1992-
# fall back to the first available sheet to keep the helper robust for
1993-
# single-sheet workbooks created on the fly (e.g., in tests).
1994-
available_sheets <- readxl::excel_sheets(input_filepath)
1995-
sheet_to_read <- if (sheetName %in% available_sheets) sheetName else available_sheets[[1]]
1996-
df <- readxl::read_excel(input_filepath, sheet = sheet_to_read)
1990+
reshape_data <- function(input_filepath, sheetName = "Results", marker = "videoinfo", id_col = "ID", output_filepath) {
1991+
# Read the Excel file into a data frame. If the requested sheet is missing,
1992+
# fall back to the first available sheet to keep the helper robust for
1993+
# single-sheet workbooks created on the fly (e.g., in tests).
1994+
available_sheets <- readxl::excel_sheets(input_filepath)
1995+
sheet_to_read <- if (sheetName %in% available_sheets) sheetName else available_sheets[[1]]
1996+
df <- readxl::read_excel(input_filepath, sheet = sheet_to_read)
19971997
19981998
# Initialize an empty data frame to store the final long-form data
19991999
long_df <- data.frame()
@@ -2756,5 +2756,6 @@ reportggstatsplotPostHoc <- function(data, p, iv = "testiv", dv = "testdv", labe
27562756
27572757
27582758
2759+
27592760
27602761

0 commit comments

Comments
 (0)