From 5bf1b213c4a2d6c600275d5d44cc6a57f1d55c2b Mon Sep 17 00:00:00 2001 From: mariusbarth Date: Wed, 24 Jan 2024 09:24:51 +0100 Subject: [PATCH 1/4] started work on apa_print method for VGAM --- R/lookup_tables.R | 6 ++++++ tests/testthat/test_apa_print_anova.R | 8 ++++++++ 2 files changed, 14 insertions(+) diff --git a/R/lookup_tables.R b/R/lookup_tables.R index f590b762..653a8068 100644 --- a/R/lookup_tables.R +++ b/R/lookup_tables.R @@ -23,6 +23,8 @@ lookup_names <- c( , "BIC" = "BIC" , "npar" = "n.parameters" , "alternative" = "alternative" + , "Deviance" = "deviance" + , "Resid..Dev" = "residual.deviance" # from broom # term , "Effect" = "term" , "Term" = "term" @@ -121,6 +123,7 @@ lookup_names <- c( , "denom.df" = "df.residual" , "den.df" = "df.residual" , "Res.Df" = "df.residual" + , "Resid..Df" = "df.residual" # p.value , "p.value" = "p.value" , "Pr..Chisq." = "p.value" @@ -148,6 +151,8 @@ lookup_labels <- c( , "BIC" = "$\\mathit{BIC}$" , "npar" = "$k$" , "alternative" = "$\\mathcal{H}_1$" + , "Deviance" = "$\\mathit{Dev}$" + , "Resid..Dev" = "$\\mathit{Dev}_{\\mathrm{res}}$" # term , "Effect" = "Effect" , "Term" = "Term" @@ -240,6 +245,7 @@ lookup_labels <- c( , "denom.df" = "$\\mathit{df}_{\\mathrm{res}}$" , "den.df" = "$\\mathit{df}_{\\mathrm{res}}$" , "Res.Df" = "$\\mathit{df}_{\\mathrm{res}}$" + , "Resid..Dev" = "$\\mathit{df}_{\\mathrm{res}}$" # p.value , "p.value" = "$p$" , "Pr...t.." = "$p$" diff --git a/tests/testthat/test_apa_print_anova.R b/tests/testthat/test_apa_print_anova.R index 0aaa02ec..e0bd7575 100644 --- a/tests/testthat/test_apa_print_anova.R +++ b/tests/testthat/test_apa_print_anova.R @@ -511,5 +511,13 @@ test_that( } ) +test_that( + "Analysis of deviance from VGAM package" + , { + fit <- VGAM::vglm( gear~ mpg, data = mtcars, family = VGAM::cumulative) + car::Anova(fit) |> class() # papaja::apa_print() + } +) + # restore previous options options(op) From c3e68346ab5485b882d2dc236fd0efe40d396b44 Mon Sep 17 00:00:00 2001 From: mariusbarth Date: Wed, 24 Jan 2024 21:41:59 +0100 Subject: [PATCH 2/4] added first support for analysis of deviance from the car package --- DESCRIPTION | 5 +++- R/apa_print_anova.R | 15 ++++++++++++ R/lookup_tables.R | 5 ++-- inst/NEWS.md | 1 + tests/testthat/test_apa_print_anova.R | 34 ++++++++++++++++++++++++--- 5 files changed, 54 insertions(+), 6 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 95bdcd58..43050e8a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -46,13 +46,16 @@ Suggests: latex2exp, lme4, lmerTest, + MASS, MBESS, multcomp, nlme, + nnet, R.rsp, skimr, spelling, - testthat + testthat, + VGAM SystemRequirements: Rendering the document template requires pandoc (>= 2.0; https://pandoc.org) and for PDFs a TeX distribution, such as TinyTeX (>= 0.12; https://yihui.org/tinytex/) diff --git a/R/apa_print_anova.R b/R/apa_print_anova.R index 0beae923..556737e8 100644 --- a/R/apa_print_anova.R +++ b/R/apa_print_anova.R @@ -415,6 +415,21 @@ apa_print.anova <- function( , simplify = TRUE ) ) + } else if(any(grepl("Deviance", object_heading))) { + x$Term <-rownames(x) + y <- canonize(x) + y <- remove_residuals_row(y) + y <- beautify(y, ...) + return( + glue_apa_results( + y + , est_glue = construct_glue(y, "estimate") + , stat_glue = construct_glue(y, "statistic") + , in_paren = in_paren + , simplify = TRUE + ) + ) + } else if(any(grepl("Satterthwaite|Kenward", object_heading))) { # lmerTest::anova.merModLmerTest ------------------------------------------- diff --git a/R/lookup_tables.R b/R/lookup_tables.R index 653a8068..c0637342 100644 --- a/R/lookup_tables.R +++ b/R/lookup_tables.R @@ -84,6 +84,7 @@ lookup_names <- c( , "F" = "statistic" , "F.ratio" = "statistic" , "LRT" = "statistic" + , "LR.Chisq" = "statistic" , "Chisq" = "statistic" , "chisq" = "statistic" , "X.squared" = "statistic" @@ -151,7 +152,7 @@ lookup_labels <- c( , "BIC" = "$\\mathit{BIC}$" , "npar" = "$k$" , "alternative" = "$\\mathcal{H}_1$" - , "Deviance" = "$\\mathit{Dev}$" + , "Deviance" = "$\\mathit{Dev}$" , "Resid..Dev" = "$\\mathit{Dev}_{\\mathrm{res}}$" # term , "Effect" = "Effect" @@ -206,6 +207,7 @@ lookup_labels <- c( , "F.ratio" = "$F$" , "approx.F" = "$F$" , "LRT" = "$\\chi^2$" + , "LR.Chisq" = "$\\chi^2$" , "chisq" = "$\\chi^2$" , "Chisq" = "$\\chi^2$" , "X.squared" = "$\\chi^2$" @@ -245,7 +247,6 @@ lookup_labels <- c( , "denom.df" = "$\\mathit{df}_{\\mathrm{res}}$" , "den.df" = "$\\mathit{df}_{\\mathrm{res}}$" , "Res.Df" = "$\\mathit{df}_{\\mathrm{res}}$" - , "Resid..Dev" = "$\\mathit{df}_{\\mathrm{res}}$" # p.value , "p.value" = "$p$" , "Pr...t.." = "$p$" diff --git a/inst/NEWS.md b/inst/NEWS.md index b9a47170..ae04a18c 100644 --- a/inst/NEWS.md +++ b/inst/NEWS.md @@ -1,6 +1,7 @@ # Upcoming release - For ANOVA methods, *MSE*s are again returned if requested by the user (reported by @Sashpta, [#562](https://github.com/crsh/papaja/issues/562)). The global default for reporting *MSE*s now depends on the [**effectsize**](https://CRAN.r-project.org/package=effectsize) package: If **effectsize** is installed, the default for reporting *MSE*s is `FALSE`, if **effectsize** is not installed, the default is `TRUE`. +- Added `apa_print()` support for analysis of deviance from the **car** package. ### Existing functions diff --git a/tests/testthat/test_apa_print_anova.R b/tests/testthat/test_apa_print_anova.R index e0bd7575..aa0d60c1 100644 --- a/tests/testthat/test_apa_print_anova.R +++ b/tests/testthat/test_apa_print_anova.R @@ -512,12 +512,40 @@ test_that( ) test_that( - "Analysis of deviance from VGAM package" + "Analysis of deviance from car" , { - fit <- VGAM::vglm( gear~ mpg, data = mtcars, family = VGAM::cumulative) - car::Anova(fit) |> class() # papaja::apa_print() + fit <- bwt.mu <- nnet::multinom(low ~ ., MASS::birthwt) + car_out <- papaja::apa_print(car::Anova(fit)) + expect_apa_results( + car_out + , labels = list( + term = "Term" + , statistic = "$\\chi^2$" + , df = "$\\mathit{df}$" + , p.value = "$p$" + ) + ) + # Example 1: a proportional odds model fitted to pneumo. + set.seed(1) + pneumo <- transform(VGAM::pneumo, let = log(exposure.time), x3 = runif(8)) + fit1 <- VGAM::vglm(cbind(normal, mild, severe) ~ let , VGAM::propodds, pneumo) + fit2 <- VGAM::vglm(cbind(normal, mild, severe) ~ let + x3, VGAM::propodds, pneumo) + fit3 <- VGAM::vglm(cbind(normal, mild, severe) ~ let + x3, VGAM::cumulative, pneumo) + car_out <- apa_print(car::Anova(fit1, type = 3)) + expect_apa_results( + car_out + , labels = list( + term = "Term" + , statistic = "$\\chi^2$" + , df = "$\\mathit{df}$" + , p.value = "$p$" + ) + ) + + } ) + # restore previous options options(op) From e667defb17ebcfa219946d7f559e2c306cbba286 Mon Sep 17 00:00:00 2001 From: mariusbarth Date: Fri, 15 Mar 2024 11:14:47 +0100 Subject: [PATCH 3/4] work on apa_print() methods --- R/apa_print_anova.R | 17 ++++++++++++----- R/lookup_tables.R | 6 ++++++ tests/testthat/test_apa_print_anova.R | 18 +++++++++++++++++- 3 files changed, 35 insertions(+), 6 deletions(-) diff --git a/R/apa_print_anova.R b/R/apa_print_anova.R index 556737e8..099631e1 100644 --- a/R/apa_print_anova.R +++ b/R/apa_print_anova.R @@ -1,9 +1,10 @@ -#' Typeset Statistical Results from ANOVA +#' Typeset Statistical Results from Analysis of Variance (or Deviance) #' -#' These methods take objects from various R functions that calculate ANOVA to -#' create formatted character strings to report the results in accordance with -#' APA manuscript guidelines. For `anova`-objects from model comparisons see -#' \code{\link{apa_print.list}}. +#' These methods take objects from various R functions that calculate analysis +#' of variance (i.e., ANOVA) or analysis of deviance. They create formatted +#' character strings to report the results in accordance with APA manuscript +#' guidelines. For `anova`-objects from model comparisons see +#' [apa_print.list()]. #' #' @param x An object containing the results from an analysis of variance ANOVA #' @param correction Character. For repeated-measures ANOVA, the type of @@ -419,6 +420,12 @@ apa_print.anova <- function( x$Term <-rownames(x) y <- canonize(x) y <- remove_residuals_row(y) + y$df.residual <- NULL + if(is.null(y$statistic)) { + y$statistic <- y$deviance + variable_label(y$statistic) <- "$\\chi^2$" + y$deviance <- NULL + } y <- beautify(y, ...) return( glue_apa_results( diff --git a/R/lookup_tables.R b/R/lookup_tables.R index c0637342..32a0ce2f 100644 --- a/R/lookup_tables.R +++ b/R/lookup_tables.R @@ -102,6 +102,8 @@ lookup_names <- c( , "logbf01" = "statistic" , "Bartlett.s.K.2" = "statistic" , "Bartlett.s.K.squared" = "statistic" + , "Rao" = "statistic" + , "Cp" = "statistic" # df, df.residual , "multivariate.df1" = "multivariate.df" , "multivariate.df2" = "multivariate.df.residual" @@ -128,6 +130,7 @@ lookup_names <- c( # p.value , "p.value" = "p.value" , "Pr..Chisq." = "p.value" + , "Pr..Chi." = "p.value" , "Pr..F." = "p.value" , "Pr..PB." = "p.value" , "Pr...t.." = "p.value" @@ -225,6 +228,8 @@ lookup_labels <- c( , "logbf01" = "$\\log \\mathrm{BF}_{\\textrm{01}}$" , "Bartlett.s.K.2" = "$K^2$" , "Bartlett.s.K.squared" = "$K^2$" + , "Rao" = "$\\mathit{RS}$" + , "Cp" = "$C_p$" # df, df.residual , "multivariate.df" = "$\\mathit{df}$" , "multivariate.df.residual" = "$\\mathit{df}_{\\mathrm{res}}$" @@ -253,6 +258,7 @@ lookup_labels <- c( , "Pr...z.." = "$p$" , "pvalues" = "$p$" , "Pr..Chisq." = "$p$" + , "Pr..Chi." = "$p$" , "Pr..F." = "$p$" , "Pr..PB." = "$p$" , "adj.p.value" = "$p_\\mathrm{adj}$" diff --git a/tests/testthat/test_apa_print_anova.R b/tests/testthat/test_apa_print_anova.R index aa0d60c1..a0b79a01 100644 --- a/tests/testthat/test_apa_print_anova.R +++ b/tests/testthat/test_apa_print_anova.R @@ -541,8 +541,24 @@ test_that( , p.value = "$p$" ) ) + } +) - +test_that( + "Analysis of deviance from the stats package" + , { + # From stats::glm() examples section: + ## Dobson (1990) Page 93: Randomized Controlled Trial : + counts <- c(18,17,15,20,10,20,25,13,12) + outcome <- gl(3,1,9) + treatment <- gl(3,3) + data.frame(treatment, outcome, counts) # showing data + glm.D93 <- glm(counts ~ outcome + treatment, family = poisson()) + apa_print(anova(glm.D93, test = "Chisq")) + apa_print(anova(glm.D93, test = "Cp")) + apa_print(anova(glm.D93, test = "LRT")) + apa_print(car::Anova(glm.D93, test.statistic = "LR")) + apa_print(anova(glm.D93, test = "Rao")) } ) From 0bff129b10b5b19b2a56a1e1401d3355832c2649 Mon Sep 17 00:00:00 2001 From: mariusbarth Date: Wed, 26 Jun 2024 14:36:00 +0200 Subject: [PATCH 4/4] tests for stats::anova.glm() and car::Anova.glm() --- R/apa_print_anova.R | 7 ++- R/lookup_tables.R | 2 + tests/testthat/test_apa_print_anova.R | 65 ++++++++++++++++++++++++--- 3 files changed, 66 insertions(+), 8 deletions(-) diff --git a/R/apa_print_anova.R b/R/apa_print_anova.R index 099631e1..8413f2c8 100644 --- a/R/apa_print_anova.R +++ b/R/apa_print_anova.R @@ -416,11 +416,14 @@ apa_print.anova <- function( , simplify = TRUE ) ) + # stats::anova.glm() and car::Anova.glm } else if(any(grepl("Deviance", object_heading))) { x$Term <-rownames(x) y <- canonize(x) y <- remove_residuals_row(y) - y$df.residual <- NULL + if(all(colnames(x) != "F values")) y$df.residual <- NULL + if(any(colnames(x) == "Cp")) y$df <- NULL + if(is.null(y$statistic)) { y$statistic <- y$deviance variable_label(y$statistic) <- "$\\chi^2$" @@ -503,7 +506,7 @@ apa_print.anova <- function( } else if(identical(object_heading[1], "ANOVA-like table for random-effects: Single term deletions")) { stop("Single-term deletions are not supported, yet.\nVisit https://github.com/crsh/papaja/issues to request support.") } - # anova::lm (single model) ---- + # anova.lm() (single model) ---- # Canonize, beautify, glue ---- y <- as.data.frame(x, stringsAsFactors = FALSE) y$Effect <- trimws(rownames(y)) diff --git a/R/lookup_tables.R b/R/lookup_tables.R index 32a0ce2f..97dd2c9a 100644 --- a/R/lookup_tables.R +++ b/R/lookup_tables.R @@ -83,6 +83,7 @@ lookup_names <- c( , "F.value" = "statistic" , "F" = "statistic" , "F.ratio" = "statistic" + , "F.values" = "statistic" , "LRT" = "statistic" , "LR.Chisq" = "statistic" , "Chisq" = "statistic" @@ -208,6 +209,7 @@ lookup_labels <- c( , "F.value" = "$F$" , "F" = "$F$" , "F.ratio" = "$F$" + , "F.values" = "$F$" , "approx.F" = "$F$" , "LRT" = "$\\chi^2$" , "LR.Chisq" = "$\\chi^2$" diff --git a/tests/testthat/test_apa_print_anova.R b/tests/testthat/test_apa_print_anova.R index a0b79a01..34c207f2 100644 --- a/tests/testthat/test_apa_print_anova.R +++ b/tests/testthat/test_apa_print_anova.R @@ -545,7 +545,7 @@ test_that( ) test_that( - "Analysis of deviance from the stats package" + "Analysis of deviance from the stats and car packages" , { # From stats::glm() examples section: ## Dobson (1990) Page 93: Randomized Controlled Trial : @@ -554,11 +554,64 @@ test_that( treatment <- gl(3,3) data.frame(treatment, outcome, counts) # showing data glm.D93 <- glm(counts ~ outcome + treatment, family = poisson()) - apa_print(anova(glm.D93, test = "Chisq")) - apa_print(anova(glm.D93, test = "Cp")) - apa_print(anova(glm.D93, test = "LRT")) - apa_print(car::Anova(glm.D93, test.statistic = "LR")) - apa_print(anova(glm.D93, test = "Rao")) + + chisq_out <- apa_print(anova(glm.D93, test = "Chisq")) + cp_out <- apa_print(anova(glm.D93, test = "Cp")) + lrt_out <- apa_print(anova(glm.D93, test = "LRT")) + rao_out <- apa_print(anova(glm.D93, test = "Rao")) + + expect_identical( + chisq_out$full_result + , list( + outcome = "$\\chi^2(2) = 5.45$, $p = .065$" + , treatment = "$\\chi^2(2) = 0.00$, $p > .999$" + ) + ) + expect_identical( + cp_out$full_result + , list( + outcome = "$C_p = 11.13$" + , treatment = "$C_p = 15.13$" + ) + ) + expect_identical( + lrt_out + , chisq_out + ) + expect_identical( + rao_out$full_result + , list( + outcome = "$\\mathit{RS}(2) = 5.56$, $p = .062$" + , treatment = "$\\mathit{RS}(2) = 0.00$, $p > .999$" + ) + ) + + car_lr_out <- apa_print(car::Anova(glm.D93, type = 3, test.statistic = "LR")) + car_wald_out <- apa_print(car::Anova(glm.D93, type = 3, test.statistic = "Wald")) + car_f_out <- apa_print(car::Anova(glm.D93, type = 3, test.statistic = "F")) + + expect_identical( + car_lr_out$full_result + , list( + outcome = "$\\chi^2(2) = 5.45$, $p = .065$" + , treatment = "$\\chi^2(2) = 0.00$, $p > .999$" + ) + ) + expect_identical( + car_wald_out$full_result + , list( + Intercept = "$\\chi^2(1) = 317.37$, $p < .001$" + , outcome = "$\\chi^2(2) = 5.49$, $p = .064$" + , treatment = "$\\chi^2(2) = 0.00$, $p > .999$" + ) + ) + expect_identical( + car_f_out$full_result + , list( + outcome = "$F(2, 4) = 2.11$, $p = .237$" + , treatment = "$F(2, 4) = 0.00$, $p > .999$" + ) + ) } )