Friends don’t let friends copy-paste

class: inverse, middle, center

class: left, middle, inverse

### Friends don't let friends copy-paste

![:pull right, 35%](

)

# Extending `apa_print()`

#### Frederik Aust & Marius Barth

---
exclude: true

---
layout: true
name: footer

<div class="my-footer">
  <div style="float: left;"><span>Frederik Aust & Marius Barth</span></div>
  <div style="text-align: right;"><span>Friends don't let friends copy-paste</span></div>
  <div style="float: center;"><span>21.04.2023</span></div>
</div>

---

const zoomDefault = mediumZoom('#zoom-default')
const zoomMargin = mediumZoom('#zoom-margin', { margin: 45 })
</script>

---
layout: true
template: footer
name: results

# papaja

### Reporting statistical analyses

---

Objects of different S3/S4 classes are treated differently

- `methods(apa_print)` provides a list of supported classes

```r
class(cor_res) # Result from cor.test()
```

```
## [1] "htest"
```

---
exclude: true

---
exclude: true

```
## $estimate
## [1] "$r = .42$, 95\\% CI $[.32, .52]$"
## 
## $statistic
## [1] "$t(274) = 7.76$, $p < .001$"
## 
## $full_result
## [1] "$r = .42$, 95\\% CI $[.32, .52]$, $t(274) = 7.76$, $p < .001$"
## 
## $table
## A data.frame with 5 labelled columns:
## 
##   estimate   conf.int statistic  df p.value
## 1      .42 [.32, .52]      7.76 274  < .001
## 
## estimate : $r$ 
## conf.int : 95\\% CI 
## statistic: $t$ 
## df       : $\\mathit{df}$ 
## p.value  : $p$ 
## attr(,"class")
## [1] "apa_results" "list"
```

---
exclude: true

---
exclude: true

Tables produced by `apa_print()` have variable labels

```r
cor_res_apa$table
```

```
## A data.frame with 5 labelled columns:
## 
##   estimate   conf.int statistic  df p.value
## 1      .42 [.32, .52]      7.76 274  < .001
## 
## estimate : $r$ 
## conf.int : 95\\% CI 
## statistic: $t$ 
## df       : $\\mathit{df}$ 
## p.value  : $p$
```

---
exclude: true

```r
variable_labels(cor_res_apa$table)
```

```
## $estimate
## [1] "$r$"
## 
## $conf.int
## [1] "95\\% CI"
## 
## $statistic
## [1] "$t$"
## 
## $df
## [1] "$\\mathit{df}$"
## 
## $p.value
## [1] "$p$"
```

---
layout: false
template: footer

# papaja

<small>

<table>
 <thead>
  <tr>
   <th style="text-align:left;"> A-B </th>
   <th style="text-align:left;"> D-L </th>
   <th style="text-align:left;"> L-S </th>
   <th style="text-align:left;"> S-Z </th>
  </tr>
 </thead>
<tbody>
  <tr>
   <td style="text-align:left;"> afex_aov </td>
   <td style="text-align:left;"> default </td>
   <td style="text-align:left;"> lsmobj </td>
   <td style="text-align:left;"> summary.aovlist </td>
  </tr>
  <tr>
   <td style="text-align:left;"> anova </td>
   <td style="text-align:left;"> emmGrid </td>
   <td style="text-align:left;"> manova </td>
   <td style="text-align:left;"> summary.glht </td>
  </tr>
  <tr>
   <td style="text-align:left;"> anova.lme </td>
   <td style="text-align:left;"> glht </td>
   <td style="text-align:left;"> merMod </td>
   <td style="text-align:left;"> summary.glm </td>
  </tr>
  <tr>
   <td style="text-align:left;"> Anova.mlm </td>
   <td style="text-align:left;"> glm </td>
   <td style="text-align:left;"> mixed </td>
   <td style="text-align:left;"> summary.lm </td>
  </tr>
  <tr>
   <td style="text-align:left;"> aov </td>
   <td style="text-align:left;"> htest </td>
   <td style="text-align:left;"> papaja_wsci </td>
   <td style="text-align:left;"> summary.manova </td>
  </tr>
  <tr>
   <td style="text-align:left;"> aovlist </td>
   <td style="text-align:left;"> list </td>
   <td style="text-align:left;"> summary_emm </td>
   <td style="text-align:left;"> summary.ref.grid </td>
  </tr>
  <tr>
   <td style="text-align:left;"> BFBayesFactor </td>
   <td style="text-align:left;"> lm </td>
   <td style="text-align:left;"> summary.Anova.mlm </td>
   <td style="text-align:left;">  </td>
  </tr>
  <tr>
   <td style="text-align:left;"> BFBayesFactorTop </td>
   <td style="text-align:left;"> lme </td>
   <td style="text-align:left;"> summary.aov </td>
   <td style="text-align:left;">  </td>
  </tr>
</tbody>
</table>

</small>

---
template: results

But what if your analysis is not supported?

**Build your own `apa_print()`**

- `broom`
- `apa_num()`
- `glue_apa_results()`

For more background see the [vignette](https://cran.r-project.org/web/packages/papaja/vignettes/extending_apa_print.html)

---
template: footer

# papaja

### Build your own `apa_print()`

`glue_apa_results()` turns *tidy* `data.frame` into `apa_print()`-style list

<small>

| Sublist | Content |
|:--------|:--------|
| `estimate` | (List of Un)standardized effect size estimate |
| `statistic` | (List of) inferential test statistic |
| `full_result` | (List of) Effect size and test statistic |
| `table` | All results in a `data.frame` |

</small>

---
layout: true
template: footer

# papaja
### Tidy data

---

1. Each row is one observation (long format)
2. Each column is a variable

---
`broom::tidy()` automatically "tidies" many classes

```r
lm_fit <- lm(Post_QoL ~ Base_QoL + BDI, data = cosmetic_surgery)

library("broom")
tidy_lm_fit <- tidy(lm_fit, conf.int = TRUE)
tidy_lm_fit
```

```
## # A tibble: 3 × 7
##   term        estimate std.error statistic  p.value conf.low conf.high
##   <chr>          <dbl>     <dbl>     <dbl>    <dbl>    <dbl>     <dbl>
## 1 (Intercept)   18.5      2.75        6.74 9.63e-11   13.1      23.9  
## 2 Base_QoL       0.586    0.0443     13.2  3.20e-31    0.499     0.673
## 3 BDI            0.167    0.0274      6.08 4.00e- 9    0.113     0.221
```

---
`broom::glance()` returns a tidy model summary

```r
glance_lm_fit <- glance(lm_fit)
glance_lm_fit
```

```
## # A tibble: 1 × 12
##   r.squared adj.r.squa…¹ sigma stati…²  p.value    df logLik   AIC   BIC devia…³
##       <dbl>        <dbl> <dbl>   <dbl>    <dbl> <dbl>  <dbl> <dbl> <dbl>   <dbl>
## 1     0.501        0.497  6.60    137. 7.06e-42     2  -911. 1830. 1844.  11876.
## # … with 2 more variables: df.residual <int>, nobs <int>, and abbreviated
## #   variable names ¹adj.r.squared, ²statistic, ³deviance
```

---
layout: true
template: footer

# papaja

### Build your own `apa_print()`

---

Typeset numbers

- `apa_num()`
- `apa_p()`
- `apa_df()`
- `apa_interval()`

---

```r
apa_num(c(143234.34557, Inf))
```

```
## [1] "143,234.35" "$\\infty$"
```

```r
apa_p(c(1, 0.0008, 0))
```

```
## [1] "> .999" "< .001" "< .001"
```

```r
apa_interval(rnorm(2))
```

```
## [1] "[0.64, 0.55]"
```

---

```r
tidy_lm_fit$p.value <- apa_p(tidy_lm_fit$p.value)
tidy_lm_fit$conf.int <- unlist(apa_interval(tidy_lm_fit[, c("conf.low", "conf.high")]))
str(tidy_lm_fit)
```

```
## tibble [3 × 8] (S3: tbl_df/tbl/data.frame)
##  $ term     : chr [1:3] "(Intercept)" "Base_QoL" "BDI"
##  $ estimate : num [1:3] 18.504 0.586 0.167
##  $ std.error: num [1:3] 2.7471 0.0443 0.0274
##  $ statistic: num [1:3] 6.74 13.23 6.08
*##  $ p.value  : chr [1:3] "< .001" "< .001" "< .001"
##  $ conf.low : num [1:3] 13.096 0.499 0.113
##  $ conf.high: num [1:3] 23.912 0.673 0.221
*##  $ conf.int : chr [1:3] "[13.10, 23.91]" "[0.50, 0.67]" "[0.11, 0.22]"
```

---

```r
tidy_lm_fit <- apa_num(tidy_lm_fit)
str(tidy_lm_fit)
```

```
## 'data.frame':	3 obs. of  8 variables:
##  $ term     : chr  "(Intercept)" "Base_QoL" "BDI"
*##  $ estimate : chr  "18.50" "0.59" "0.17"
*##  $ std.error: chr  "2.75" "0.04" "0.03"
*##  $ statistic: chr  "6.74" "13.23" "6.08"
##  $ p.value  : chr  "< .001" "< .001" "< .001"
*##  $ conf.low : chr  "13.10" "0.50" "0.11"
*##  $ conf.high: chr  "23.91" "0.67" "0.22"
##  $ conf.int : chr  "[13.10, 23.91]" "[0.50, 0.67]" "[0.11, 0.22]"
```

---

```r
glance_lm_fit$r.squared <- apa_num(glance_lm_fit$r.squared, digits = 3, gt1 = FALSE)
glance_lm_fit$adj.r.squared <- apa_num(glance_lm_fit$adj.r.squared, digits = 3, gt1 = FALSE)
glance_lm_fit$p.value <- apa_p(glance_lm_fit$p.value)

str(glance_lm_fit)
```

```
## tibble [1 × 12] (S3: tbl_df/tbl/data.frame)
*##  $ r.squared    : chr ".501"
*##  $ adj.r.squared: chr ".497"
##  $ sigma        : num 6.6
##  $ statistic    : Named num 137
##   ..- attr(*, "names")= chr "value"
*##  $ p.value      : chr "< .001"
##  $ df           : Named num 2
##   ..- attr(*, "names")= chr "numdf"
##  $ logLik       : num -911
##  $ AIC          : num 1830
##  $ BIC          : num 1844
##  $ deviance     : num 11876
##  $ df.residual  : int 273
##  $ nobs         : int 276
```

---

```r
glance_lm_fit$df <- apa_df(glance_lm_fit$df)
glance_lm_fit <- apa_num(glance_lm_fit)

str(glance_lm_fit)
```

```
## 'data.frame':	1 obs. of  12 variables:
##  $ r.squared    : chr ".501"
##  $ adj.r.squared: chr ".497"
##  $ sigma        : chr "6.60"
##  $ statistic    : chr "136.78"
##  $ p.value      : chr "< .001"
##  $ df           : chr "2"
##  $ logLik       : chr "-910.77"
##  $ AIC          : chr "1,829.53"
##  $ BIC          : chr "1,844.02"
##  $ deviance     : chr "11,876.12"
##  $ df.residual  : chr "273"
##  $ nobs         : chr "276"
```

---
name: glue

To construct text for reporting use `glue::glue()`

```r
library("glue")

x <- 1
glue("1 + {x}")
```

```
## 1 + 1
```

---
template: glue

`glue_apa_results()` uses `glue::glue()`

```r
glue(
  "$R^{2}_{adj} = <<glance_lm_fit$adj.r.squared>>$"
  , .open = "<<", .close = ">>"
)
```

```
## $R^{2}_{adj} = .497$
```

---

When reporting `$p$` values, use `add_equals()`

```r
glue("$p = {glance_lm_fit$p.value}$")
```

```
## $p = < .001$
```

```r
glue("$p {add_equals(glance_lm_fit$p.value)}$")
```

```
## $p < .001$
```

---

That's it. Let's put it together.

```r
lm_res <- glue_apa_results(
  tidy_lm_fit
  , est_glue = "$b = <<estimate>>$, $SE = <<std.error>>$"
  , stat_glue = "$t = <<statistic>>$, $p <<add_equals(p.value)>>$"
)
```

---

```
## List of 4
*##  $ estimate   :List of 3
##   ..$ : chr "$b = 18.50$, $SE = 2.75$"
##   ..$ : chr "$b = 0.59$, $SE = 0.04$"
##   ..$ : chr "$b = 0.17$, $SE = 0.03$"
*##  $ statistic  :List of 3
##   ..$ : chr "$t = 6.74$, $p < .001$"
##   ..$ : chr "$t = 13.23$, $p < .001$"
##   ..$ : chr "$t = 6.08$, $p < .001$"
*##  $ full_result:List of 3
##   ..$ : chr "$b = 18.50$, $SE = 2.75$, $t = 6.74$, $p < .001$"
##   ..$ : chr "$b = 0.59$, $SE = 0.04$, $t = 13.23$, $p < .001$"
##   ..$ : chr "$b = 0.17$, $SE = 0.03$, $t = 6.08$, $p < .001$"
*##  $ table      :'data.frame':	3 obs. of  8 variables:
*##   ..$ term     : chr [1:3] "Intercept" "Base QoL" "BDI"
##   ..$ estimate : chr [1:3] "18.50" "0.59" "0.17"
##   ..$ std.error: chr [1:3] "2.75" "0.04" "0.03"
##   ..$ statistic: chr [1:3] "6.74" "13.23" "6.08"
##   ..$ p.value  : chr [1:3] "< .001" "< .001" "< .001"
##   ..$ conf.low : chr [1:3] "13.10" "0.50" "0.11"
##   ..$ conf.high: chr [1:3] "23.91" "0.67" "0.22"
##   ..$ conf.int : chr [1:3] "[13.10, 23.91]" "[0.50, 0.67]" "[0.11, 0.22]"
##  - attr(*, "class")= chr [1:2] "apa_results" "list"
```

---

```
## $estimate
*## $estimate[[1]]
## [1] "$b = 18.50$, $SE = 2.75$"
## 
*## $estimate[[2]]
## [1] "$b = 0.59$, $SE = 0.04$"
## 
*## $estimate[[3]]
## [1] "$b = 0.17$, $SE = 0.03$"
## 
## 
## $statistic
## $statistic[[1]]
## [1] "$t = 6.74$, $p < .001$"
## 
## $statistic[[2]]
## [1] "$t = 13.23$, $p < .001$"
## 
## $statistic[[3]]
## [1] "$t = 6.08$, $p < .001$"
## 
## 
## $full_result
## $full_result[[1]]
## [1] "$b = 18.50$, $SE = 2.75$, $t = 6.74$, $p < .001$"
## 
## $full_result[[2]]
## [1] "$b = 0.59$, $SE = 0.04$, $t = 13.23$, $p < .001$"
## 
## $full_result[[3]]
## [1] "$b = 0.17$, $SE = 0.03$, $t = 6.08$, $p < .001$"
## 
## 
## $table
##        term estimate std.error statistic p.value conf.low conf.high
## 1 Intercept    18.50      2.75      6.74  < .001    13.10     23.91
## 2  Base QoL     0.59      0.04     13.23  < .001     0.50      0.67
## 3       BDI     0.17      0.03      6.08  < .001     0.11      0.22
##         conf.int
## 1 [13.10, 23.91]
## 2   [0.50, 0.67]
## 3   [0.11, 0.22]
## 
## attr(,"class")
## [1] "apa_results" "list"
```

---

Pass additional variables and customize sublist names

```r
lm_res <- glue_apa_results(
  tidy_lm_fit
* , df = glance_lm_fit$df.residual
  , est_glue = "$b = <<estimate>>$ 95% CI $<<conf.int>>$"
  , stat_glue = "$t(<<df>>) = <<statistic>>$, $p <<add_equals(p.value)>>$"
* , term_names = sanitize_terms(tidy_lm_fit$term)
)
```

---

```
## $estimate
*## $estimate$Intercept
## [1] "$b = 18.50$ 95% CI $[13.10, 23.91]$"
## 
*## $estimate$Base_QoL
## [1] "$b = 0.59$ 95% CI $[0.50, 0.67]$"
## 
*## $estimate$BDI
## [1] "$b = 0.17$ 95% CI $[0.11, 0.22]$"
## 
## 
## $statistic
## $statistic$Intercept
*## [1] "$t(273) = 6.74$, $p < .001$"
## 
## $statistic$Base_QoL
*## [1] "$t(273) = 13.23$, $p < .001$"
## 
## $statistic$BDI
## [1] "$t(273) = 6.08$, $p < .001$"
## 
## 
## $full_result
## $full_result$Intercept
## [1] "$b = 18.50$ 95% CI $[13.10, 23.91]$, $t(273) = 6.74$, $p < .001$"
## 
## $full_result$Base_QoL
## [1] "$b = 0.59$ 95% CI $[0.50, 0.67]$, $t(273) = 13.23$, $p < .001$"
## 
## $full_result$BDI
## [1] "$b = 0.17$ 95% CI $[0.11, 0.22]$, $t(273) = 6.08$, $p < .001$"
## 
## 
## $table
##        term estimate std.error statistic p.value conf.low conf.high
## 1 Intercept    18.50      2.75      6.74  < .001    13.10     23.91
## 2  Base QoL     0.59      0.04     13.23  < .001     0.50      0.67
## 3       BDI     0.17      0.03      6.08  < .001     0.11      0.22
##         conf.int
## 1 [13.10, 23.91]
## 2   [0.50, 0.67]
## 3   [0.11, 0.22]
## 
## attr(,"class")
## [1] "apa_results" "list"
```

---

Use the output for reporting as usual.

~~~
Wow, such significance, `r lm_res$statistic$Intercept`!
~~~

> Wow, such significance, `$t(273) = 6.74$`, `$p < .001$`!

---

To add, for example, modelfit information `add_glue_to_apa_results()`

```r
lm_res <- add_glue_to_apa_results(
    .x = glance_lm_fit
    , container = lm_res
    , sublist = "modelfit"
    , est_glue = c(
        r2 = "$R^2 = <<r.squared>>$"
        , aic = ""
    )
    , stat_glue = c(
        r2 = "$F(<<df>>, <<df.residual>>) = <<statistic>>$, $p <<add_equals(p.value)>>$"
        , aic = "$\\mathrm{AIC} = <<AIC>>$"
    )
)
```

---

```r
lm_res$estimate$modelfit
```

```
##             r2 
## "$R^2 = .501$"
```

```r
lm_res$full_result$modelfit
```

```
## $r2
## [1] "$R^2 = .501$, $F(2, 273) = 136.78$, $p < .001$"
## 
## $aic
## [1] "$\\mathrm{AIC} = 1,829.53$"
```

---
template: footer
class: middle, center

# [Let's get some exercise](http://frederikaust.com/papaja-workshop/exercises/14_extending_apa_print_question.html)!