Skip to content

Commit

Permalink
v0.1.4 release!
Browse files Browse the repository at this point in the history
  • Loading branch information
Matías Castillo Aguilar authored and Matías Castillo Aguilar committed Apr 3, 2021
1 parent 66a57d6 commit 564ff6e
Show file tree
Hide file tree
Showing 9 changed files with 1,303 additions and 1,421 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
Package: writR
Title: Inferential statistics and reporting in APA style
Version: 0.1.3
Version: 0.1.4
Date: 2021-03-05
Authors@R:
person(given = "Matías",
Expand Down
19 changes: 12 additions & 7 deletions R/aov.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,7 @@
#' @param id Quoted or unquoted variable (of length 1) indicating the subject identifier column in data.
#' @param type The type of sums of squares for the ANOVA. Possible values are "II", "III", 2, or 3 (default).
#' @param es The effect size used to estimate the effects of the factors on the response variable. Possible values are 'omega' or 'eta' (default).
#' @param generalized If TRUE (default), returns generalized Eta Squared, assuming all variables are manipulated (used only when `es = 'eta'`).
#' @param sphericity If `"none"`, then sphericity assumption is assumed to be met for within-subject(s) factor(s). "GG": applies Greenhouse-Geisser correction. "HF": applies Hyunh-Feldt correction. 'auto' (Default) choose the appropiate correction based on Mauchly test of sphericity (p-value > 0.05)
#' @param markdown Whether you want the output formated for inline R Markdown or as plain text.
#' @keywords aov_r
Expand All @@ -22,6 +23,7 @@ aov_r <- function(data
, id
, type = 3
, es = 'eta' # 'omega' (default) or 'eta'
, generalized = TRUE
, sphericity = 'auto' # 'auto' (default), 'GG', 'HF' or 'none'
, markdown = TRUE # FALSE for plain text
) {
Expand Down Expand Up @@ -53,16 +55,16 @@ aov_r <- function(data
sphericity <- if(sphericity == 'auto') {
# Comprobación de esfericidad ----
if( purrr::is_empty(spher.test) || all(spher.test[,2] > 0.05) ) {
'none' } else { ges <- any(model$anova_table$ges <= 0.75)
if(ges) { 'GG' } else { 'HF' } }
} else if(purrr::is_empty(spher.test)) { 'none' } else { sphericity }
'none' } else { ges <- all(summary(model)[['pval.adjustments']][,c('GG eps','HF eps')] > 0.75)
if(ges) { 'HF' } else { 'GG' } }
} else if(purrr::is_empty(spher.test)) { 'none' } else { sphericity }
} else { sphericity <- NULL }

efs <- if(es == 'eta') { effectsize::eta_squared(model, ci = 0.95)
efs <- if(es == 'eta') { effectsize::eta_squared(model, ci = 0.95, generalized = generalized)
} else if(es == 'omega') { effectsize::omega_squared(model, ci = 0.95)
} else stop('You have to choose between "eta" or "omega"')

model <- anova(object = model, correction = sphericity)
model <- stats::anova(object = model, correction = sphericity)
at <- attributes(model)
class(model) <- 'data.frame'
model <- within(model, {
Expand All @@ -75,15 +77,18 @@ aov_r <- function(data

efs[,-1] <- round(efs[,-1],2)
if(at$correction == 'none' || is.null(at$correction)) { at$correction <- 'Fisher' }
et <- if(markdown) paste0('$\\',es,'$^2^ = ') else paste0(es,'^2 = ')
et <- if(markdown) paste0('$\\',es,'^2', if(es == 'eta') {
if(generalized) {
'_G'} else {'_p'}
} else {''},'$ = ') else paste0(es,'^2 = ')

if(markdown) {
# Formato en Markdown para R Markdown ----
for(i in row.names(model)) {
rt <- model[i,]
j <- if (grepl(pattern = ':', i)) gsub(':', '_', i) else i
result[['full']][[j]] <- paste0(
stats <- paste0("*F* ~", at$correction
stats <- paste0("*F* ~", if(!is.null(within) && any(grepl(within, i))) at$correction else "Fisher"
, "~ (", rt$`num Df`
,", ",rt$`den Df`
,') = ',rt$F
Expand Down
103 changes: 40 additions & 63 deletions R/bipair.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -45,37 +45,29 @@ bipair <- function(data
test <- stats::t.test(stats::as.formula(paste(variable, by, sep = '~')), data, paired = T)
d <- effectsize::effectsize(test, verbose = F)

desc <- if(markdown) {
list(m = '*M* = ', i = ', *SD* = ', t = '*t* ~Student~ (', p = ', *p* '
, d = "*d* ~Cohen's~ = ", ci = ', CI~95%~[') } else {
list(m = 'M = ', i = ', SD = ', t = 't(', p = ', p '
, d = "d = ", ci = ', CI95% [') }


for(j in levels(data[[by]])) {
result[['desc']][j] <- list(paste0(
'M = '
, round(mean(data[data[[by]] == j,][[variable]], na.rm = T),2), ', SD = '
, round(sd(data[data[[by]] == j,][[variable]], na.rm = T),2) ) ) }
desc$m
, round(base::mean(data[data[[by]] == j,][[variable]], na.rm = T) ), desc$i
, round(stats::sd(data[data[[by]] == j,][[variable]], na.rm = T),2) ) ) }

if(markdown) {
result[['full']] <- paste0(
stats <- paste0('*t* ~Student~ (',round(test$parameter,1)
stats <- paste0(desc$t,round(test$parameter,1)
, ') = ', round(test$statistic,2)
, ', *p* ', ifelse(test$p.value < 0.001, '< 0.001', paste(
, desc$p, ifelse(test$p.value < 0.001, '< 0.001', paste(
'=',round(test$p.value,3) ) ) ),', '
, es <- paste0("*d* ~Cohen's~ = ", round(d$d,2)
, ', CI~95%~[', round(d$CI_low,2)
, es <- paste0(desc$d, round(d$d,2)
, desc$ci, round(d$CI_low,2)
, ', ', round(d$CI_high, 2), ']') )

result[["stats"]] <- stats
result[["es"]] <- es
} else {
result[['full']] <- paste0(
stats <- paste0('t(', round(test$parameter,1)
, ') = ', round(test$statistic,2)
, ', p ', ifelse(test$p.value < 0.001, '< 0.001',paste(
'=', round(test$p.value,3) ) ) ),', '
, es <- paste0("d = ",round(d$d,2)
, ', CI95% [', round(d$CI_low,2)
, ', ', round(d$CI_high, 2), ']') )

result[["stats"]] <- stats
result[["es"]] <- es
}

result[['method']] <- "Student's t-test for dependent samples"
result
Expand All @@ -91,37 +83,29 @@ bipair <- function(data
, tr = trim
, nboot = nboot)['AKP',]

desc <- if(markdown) {
list(m = '*M* = ', i = ', *SD* = ', t = '*t* ~Yuen~ (', p = ', *p* '
, d = '$\\delta_R^{AKP}$ = ', ci = ', CI~95%~[') } else {
list(m = 'M = ', i = ', SD = ', t = 't(', p = ', p '
, d = "delta = ", ci = ', CI95% [') }

for(j in levels(data[[by]])) {
result[['desc']][j] <- list(paste0(
'M = '
, round(mean(data[data[[by]] == j,][[variable]], na.rm = T, trim = trim),2), ', SD = '
, round(sd(data[data[[by]] == j,][[variable]], na.rm = T),2) ) ) }
desc$m
, round(base::mean(data[data[[by]] == j,][[variable]], na.rm = T, trim = trim),2), desc$i
, round(stats::sd(data[data[[by]] == j,][[variable]], na.rm = T),2) ) ) }

if(markdown) {
result[['full']] <- paste0(
stats <- paste0('*t* ~Yuen~ (', round(test$df, 1)
stats <- paste0(desc$t, round(test$df, 1)
, ') = ', round(test$test,2)
, ', *p* ', ifelse(test$p.value < 0.001, '< 0.001',paste(
, desc$p, ifelse(test$p.value < 0.001, '< 0.001',paste(
'=', round(test$p.value,3) ) ) ),', '
, es <- paste0('$\\delta_R^{AKP}$ = ', round(r[['Est']],2)
, ', CI~95%~[', round(r[['ci.low']],2)
, es <- paste0(desc$d, round(r[['Est']],2)
, desc$ci, round(r[['ci.low']],2)
, ', ', round(r[['ci.up']], 2), ']') )

result[["stats"]] <- stats
result[["es"]] <- es
} else {
result[['full']] <- paste0(
stats <- paste0('t(', round(test$df, 1)
, ') = ', round(test$test,2)
, ', p ', ifelse(test$p.value < 0.001, '< 0.001',paste(
'=', round(test$p.value,3) ) ) ),', '
, es <- paste0('delta = ', round(r[['Est']],2)
, ', CI95% [', round(r[['ci.low']],2)
, ', ', round(r[['ci.up']], 2), ']') )

result[["stats"]] <- stats
result[["es"]] <- es
}
result[['method']] <- "Yuen's test for trimmed means for dependent samples"
result
} else {
Expand All @@ -130,35 +114,28 @@ bipair <- function(data
r <- effectsize::rank_biserial(data[[variable]] ~ data[[by]], data = data,
paired = TRUE, verbose = FALSE)

desc <- if(markdown) {
list(m = '*Mdn* = ', i = ', *IQR* = ', v = '*V* = ', p = ', *p* '
, r = '*r* ~biserial~ = ', ci = ', CI~95%~[') } else {
list(m = 'Mdn = ', i = ', IQR = ', v = 'V = ', p = ', p '
, r = 'r = ', ci = ', CI95% [') }

for(j in levels(data[[by]])) {
result[['desc']][j] <- list(paste0(
'Mdn = '
, round(median(data[data[[by]] == j,][[variable]], na.rm = T),2), ', IQR = '
, round(IQR(data[data[[by]] == j,][[variable]], na.rm = T),2) ) ) }
desc$m
, round(stats::median(data[data[[by]] == j,][[variable]], na.rm = T),2), desc$i
, round(stats::IQR(data[data[[by]] == j,][[variable]], na.rm = T),2) ) ) }

if(markdown) {
result[['full']] <- paste0(
stats <- paste0('*V* = ', round(test$statistic,2)
, ', *p* ', ifelse(test$p.value < 0.001, '< 0.001',paste(
stats <- paste0(desc$v, round(test$statistic,2)
, desc$p, ifelse(test$p.value < 0.001, '< 0.001',paste(
'=', round(test$p.value,3) ) ) ),', '
, es <- paste0('*r* ~biserial~ = ', round(r$r_rank_biserial,2)
, ', CI~95%~[', round(r$CI_low,2)
, es <- paste0(desc$r, round(r$r_rank_biserial,2)
, desc$ci, round(r$CI_low,2)
, ', ', round(r$CI_high, 2), ']') )

result[["stats"]] <- stats
result[["es"]] <- es
} else {
result[['full']] <- paste0(
stats <- paste0('V = ', round(test$statistic,2)
, ', p ', ifelse(test$p.value < 0.001, '< 0.001',paste(
'=', round(test$p.value,3) ) ) ),', '
, es <- paste0('r = ', round(r$r_rank_biserial, 2)
, ', CI95% [', round(r$CI_low,2)
, ', ', round(r$CI_high, 2), ']') )

result[["stats"]] <- stats
result[["es"]] <- es
}

result[['method']] <- 'Wilcoxon signed-rank test for dependent samples'
result
Expand Down
Loading

0 comments on commit 564ff6e

Please sign in to comment.