Preliminaries

You can find the solutions for this exercise as well as the following ones in the exercises folder in the workshop material. You can also navigate the workshop material online (including exercises and solutions).

You can copy code from the exercise and solution files by clicking on the small blue clipboard icon in the upper right corner of the boxes showing the code.

Exercises

In this exercise you will typeset the results of statistical analyses that may not yet be supported by apa_print() out of the box.

Exercise 1

Create tidy data.frames for the results of the following robust regression analysis.

data(coleman, package = "robustbase")
robust_lm <- lmrob(Y ~ ., data=coleman)

Clues

Use the functions broom::tidy() and broom::glance().

Solution

library("robustbase")
data(coleman, package = "robustbase")
robust_lm <- lmrob(Y ~ ., data=coleman)

library("broom")
tidy_roblm <- tidy(robust_lm, conf.int = TRUE)
glance_roblm <- glance(robust_lm)

Exercise 2

Typset the tidy data.frames of robust regression analysis.

Clues

Use, for example, the following functions

apa_num()
apa_p()
apa_df()
apa_interval()

Solution

library("papaja")
tidy_roblm$p.value <- apa_p(tidy_roblm$p.value)
tidy_roblm$conf.int <- unlist(apa_interval(tidy_roblm[, c("conf.low", "conf.high")]))
tidy_roblm <- apa_num(tidy_roblm)

glance_roblm$r.squared <- apa_num(glance_roblm$r.squared, digits = 3, gt1 = FALSE)
glance_roblm <- apa_num(glance_roblm)

Exercise 3

Put the results together using apa_glue_results() and add_glue_to_apa_results().

Clues

Use sanitize_terms() to quickly ensure valid sublist names.

Solution

roblm_res <- glue_apa_results(
  tidy_roblm
  , df = glance_roblm$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_roblm$term)
)

roblm_res <- add_glue_to_apa_results(
    .x = glance_roblm
    , container = roblm_res
    , sublist = "modelfit"
    , est_glue = c(r2 = "$R^2 = <<r.squared>>$")
    , stat_glue = c(r2 = "")
)

roblm_res

## $estimate
## $estimate$Intercept
## [1] "$b = 30.50$, 95% CI $[17.35, 43.66]$"
## 
## $estimate$salaryP
## [1] "$b = -1.67$, 95% CI $[-2.51, -0.82]$"
## 
## $estimate$fatherWc
## [1] "$b = 0.08$, 95% CI $[0.06, 0.11]$"
## 
## $estimate$sstatus
## [1] "$b = 0.67$, 95% CI $[0.60, 0.73]$"
## 
## $estimate$teacherSc
## [1] "$b = 1.17$, 95% CI $[0.95, 1.38]$"
## 
## $estimate$motherLev
## [1] "$b = -4.14$, 95% CI $[-5.94, -2.33]$"
## 
## $estimate$modelfit
##             r2 
## "$R^2 = .981$" 
## 
## 
## $statistic
## $statistic$Intercept
## [1] "$t(14) = 4.54$, $p < .001"
## 
## $statistic$salaryP
## [1] "$t(14) = -3.86$, $p = .002"
## 
## $statistic$fatherWc
## [1] "$t(14) = 5.74$, $p < .001"
## 
## $statistic$sstatus
## [1] "$t(14) = 19.73$, $p < .001"
## 
## $statistic$teacherSc
## [1] "$t(14) = 10.63$, $p < .001"
## 
## $statistic$motherLev
## [1] "$t(14) = -4.49$, $p < .001"
## 
## 
## $full_result
## $full_result$Intercept
## [1] "$b = 30.50$, 95% CI $[17.35, 43.66]$, $t(14) = 4.54$, $p < .001"
## 
## $full_result$salaryP
## [1] "$b = -1.67$, 95% CI $[-2.51, -0.82]$, $t(14) = -3.86$, $p = .002"
## 
## $full_result$fatherWc
## [1] "$b = 0.08$, 95% CI $[0.06, 0.11]$, $t(14) = 5.74$, $p < .001"
## 
## $full_result$sstatus
## [1] "$b = 0.67$, 95% CI $[0.60, 0.73]$, $t(14) = 19.73$, $p < .001"
## 
## $full_result$teacherSc
## [1] "$b = 1.17$, 95% CI $[0.95, 1.38]$, $t(14) = 10.63$, $p < .001"
## 
## $full_result$motherLev
## [1] "$b = -4.14$, 95% CI $[-5.94, -2.33]$, $t(14) = -4.49$, $p < .001"
## 
## $full_result$modelfit
##             r2 
## "$R^2 = .981$" 
## 
## 
## $table
##        term estimate std.error statistic p.value conf.low conf.high
## 1 Intercept    30.50      6.71      4.54  < .001    17.35     43.66
## 2   SalaryP    -1.67      0.43     -3.86    .002    -2.51     -0.82
## 3  FatherWc     0.08      0.01      5.74  < .001     0.06      0.11
## 4   Sstatus     0.67      0.03     19.73  < .001     0.60      0.73
## 5 TeacherSc     1.17      0.11     10.63  < .001     0.95      1.38
## 6 MotherLev    -4.14      0.92     -4.49  < .001    -5.94     -2.33
##         conf.int
## 1 [17.35, 43.66]
## 2 [-2.51, -0.82]
## 3   [0.06, 0.11]
## 4   [0.60, 0.73]
## 5   [0.95, 1.38]
## 6 [-5.94, -2.33]
## 
## attr(,"class")
## [1] "apa_results" "list"

Bonus

Bonus 1

Make the tidy data.frame, which contains the regression coefficients, more presentable.

Remove an redundant columns, and
Use the function variable_lables() to assign labels to each column.

Solution

tidy_roblm <- subset(tidy_roblm, select = -c(std.error, conf.low, conf.high))

library("glue")
variable_labels(tidy_roblm) <- c(
  term = "Predictor"
  , estimate = "$b$"
  , statistic = glue("t({glance_roblm$df.residual})")
  , p.value = "$p$"
  , conf.int = "95\\% CI"
)

variable_labels(tidy_roblm)

## $term
## [1] "Predictor"
## 
## $estimate
## [1] "$b$"
## 
## $statistic
## [1] "t(14)"
## 
## $p.value
## [1] "$p$"
## 
## $conf.int
## [1] "95\\% CI"

Bonus 2

Write a function that performs all of the above processing steps, so it can be swiftly applied to many regression results.

Solution

apa_print_roblm <- function(x) {
  tidy_roblm <- tidy(x, conf.int = TRUE)
  glance_roblm <- glance(x)
  
  tidy_roblm$p.value <- apa_p(tidy_roblm$p.value)
  tidy_roblm$conf.int <- unlist(apa_interval(tidy_roblm[, c("conf.low", "conf.high")]))
  
  tidy_roblm <- subset(tidy_roblm, select = -c(conf.low, conf.high))

  variable_labels(tidy_roblm) <- c(
    term = "Predictor"
    , estimate = "$b$"
    , std.error = "SE"
    , statistic = glue("t({glance_roblm$df.residual})")
    , p.value = "$p$"
    , conf.int = "95\\% CI"
  )
  
  glance_roblm$r.squared <- apa_num(glance_roblm$r.squared, digits = 3, gt1 = FALSE)
  glance_roblm <- apa_num(glance_roblm)
  
  roblm_res <- glue_apa_results(
    tidy_roblm
    , df = glance_roblm$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_roblm$term)
  )
  
  roblm_res <- add_glue_to_apa_results(
      .x = glance_roblm
      , container = roblm_res
      , sublist = "modelfit"
      , est_glue = c(r2 = "$R^2 = <<r.squared>>$")
      , stat_glue = c(r2 = "")
  )

  roblm_res
}

robust_lm_res <- apa_print_roblm(robust_lm)

robust_lm_res

## $estimate
## $estimate$Intercept
## [1] "$b = 30.50$, 95% CI $[17.35, 43.66]$"
## 
## $estimate$salaryP
## [1] "$b = -1.67$, 95% CI $[-2.51, -0.82]$"
## 
## $estimate$fatherWc
## [1] "$b = 0.08$, 95% CI $[0.06, 0.11]$"
## 
## $estimate$sstatus
## [1] "$b = 0.67$, 95% CI $[0.60, 0.73]$"
## 
## $estimate$teacherSc
## [1] "$b = 1.17$, 95% CI $[0.95, 1.38]$"
## 
## $estimate$motherLev
## [1] "$b = -4.14$, 95% CI $[-5.94, -2.33]$"
## 
## $estimate$modelfit
##             r2 
## "$R^2 = .981$" 
## 
## 
## $statistic
## $statistic$Intercept
## [1] "$t(14) = 4.54$, $p < .001"
## 
## $statistic$salaryP
## [1] "$t(14) = -3.86$, $p = .002"
## 
## $statistic$fatherWc
## [1] "$t(14) = 5.74$, $p < .001"
## 
## $statistic$sstatus
## [1] "$t(14) = 19.73$, $p < .001"
## 
## $statistic$teacherSc
## [1] "$t(14) = 10.63$, $p < .001"
## 
## $statistic$motherLev
## [1] "$t(14) = -4.49$, $p < .001"
## 
## 
## $full_result
## $full_result$Intercept
## [1] "$b = 30.50$, 95% CI $[17.35, 43.66]$, $t(14) = 4.54$, $p < .001"
## 
## $full_result$salaryP
## [1] "$b = -1.67$, 95% CI $[-2.51, -0.82]$, $t(14) = -3.86$, $p = .002"
## 
## $full_result$fatherWc
## [1] "$b = 0.08$, 95% CI $[0.06, 0.11]$, $t(14) = 5.74$, $p < .001"
## 
## $full_result$sstatus
## [1] "$b = 0.67$, 95% CI $[0.60, 0.73]$, $t(14) = 19.73$, $p < .001"
## 
## $full_result$teacherSc
## [1] "$b = 1.17$, 95% CI $[0.95, 1.38]$, $t(14) = 10.63$, $p < .001"
## 
## $full_result$motherLev
## [1] "$b = -4.14$, 95% CI $[-5.94, -2.33]$, $t(14) = -4.49$, $p < .001"
## 
## $full_result$modelfit
##             r2 
## "$R^2 = .981$" 
## 
## 
## $table
##        term    estimate  std.error statistic p.value       conf.int
## 1 Intercept 30.50231984 6.71260401  4.544037  < .001 [17.35, 43.66]
## 2   SalaryP -1.66614686 0.43128710 -3.863197    .002 [-2.51, -0.82]
## 3  FatherWc  0.08425381 0.01467468  5.741440  < .001   [0.06, 0.11]
## 4   Sstatus  0.66773659 0.03385090 19.725816  < .001   [0.60, 0.73]
## 5 TeacherSc  1.16777742 0.10983311 10.632289  < .001   [0.95, 1.38]
## 6 MotherLev -4.13656902 0.92083737 -4.492182  < .001 [-5.94, -2.33]
## 
## attr(,"class")
## [1] "apa_results" "list"

variable_labels(robust_lm_res$table)

## $term
## [1] "Predictor"
## 
## $estimate
## [1] "$b$"
## 
## $std.error
## [1] "SE"
## 
## $statistic
## [1] "t(14)"
## 
## $p.value
## [1] "$p$"
## 
## $conf.int
## [1] "95\\% CI"

Solutions

After you have tried yourself, feel free to have a look at our solutions.

Friends don’t let friends copy-paste

Exercises for the module Extending `apa_print()`

Preliminaries

Exercises

Exercise 1

Clues

Solution

Exercise 2

Clues

Solution

Exercise 3

Clues

Solution

Bonus

Bonus 1

Solution

Bonus 2

Solution

Solutions

Friends don’t let friends copy-paste

Exercises for the module Extending apa_print()

Preliminaries

Exercises

Exercise 1

Clues

Solution

Exercise 2

Clues

Solution

Exercise 3

Clues

Solution

Bonus

Bonus 1

Solution

Bonus 2

Solution

Solutions

Exercises for the module Extending `apa_print()`