Skip to content

Commit bcc72fe

Browse files
committed
#24 (accept a vector of replacements in lavaan_defined)
1 parent c8d8717 commit bcc72fe

14 files changed

+353
-183
lines changed

R/lavaan_defined.R

Lines changed: 8 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,7 @@
1515
#' reference values at the bottom of the table.
1616
#' @param underscores_to_symbol Character to convert underscores
1717
#' to arrows in the first column, like for indirect effects. Default to
18-
#' the arrow symbol (→ "u2192"), but can be set to NULL or "_", or to any
18+
#' the arrow symbol (→), but can be set to NULL or "_", or to any
1919
#' other desired symbol. It is also possible to provide a vector of
2020
#' replacements if they they are not all the same.
2121
#' @param lhs_name Name of first column, referring to the left-hand side
@@ -81,7 +81,13 @@ lavaan_defined <- function(fit,
8181
x <- x[og.names]
8282
names(x) <- new.names
8383
if (!is.null(underscores_to_symbol)) {
84-
x[[1]] <- gsub("_", paste0(" ", underscores_to_symbol, " "), x[[1]])
84+
if (length(underscores_to_symbol) == 1 || length(underscores_to_symbol) == nrow(x)) {
85+
x[[1]] <- unlist(lapply(seq_along(underscores_to_symbol), function(i) {
86+
gsub("_", paste0(" ", underscores_to_symbol[[i]], " "), as.list(x[[1]])[[i]])
87+
}))
88+
} else {
89+
stop("'underscores_to_symbol' must match the number of rows.")
90+
}
8591
}
8692
if (nice_table) {
8793
insight::check_if_installed("rempsyc",

R/nice_fit.R

Lines changed: 22 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -94,29 +94,29 @@ nice_fit <- function(model, model.labels, nice_table = FALSE, cutoffs = TRUE, st
9494

9595
table <- flextable::align(table, align = "center", part = "all")
9696
if (isTRUE(cutoffs)) {
97-
table <- flextable::add_footer_row(table,
98-
values = c(
99-
Model = "Suggested soft cutoffs",
100-
chi2 = "\u2014",
101-
df = "\u2014",
102-
chi2.df = "< 2 or 3",
103-
p = "> .05",
104-
CFI = "\u2265 .95",
105-
TLI = "\u2265 .95",
106-
`RMSEA (90% CI)` = "< .05 [.00, .08]",
107-
SRMR = "\u2264 .08",
108-
AIC = "Smaller",
109-
BIC = "Smaller"
110-
),
111-
colwidths = rep(1, length(table$col_keys))
112-
)
113-
table <- flextable::bold(table, part = "footer")
114-
table <- flextable::align(table, align = "center", part = "all")
115-
table <- flextable::footnote(table, i = 1, j = 1, value = flextable::as_paragraph(
116-
"Based on Schreiber (2017), Table 3."
97+
table <- flextable::add_footer_row(table,
98+
values = c(
99+
Model = "Suggested soft cutoffs",
100+
chi2 = "\u2014",
101+
df = "\u2014",
102+
chi2.df = "< 2 or 3",
103+
p = "> .05",
104+
CFI = "\u2265 .95",
105+
TLI = "\u2265 .95",
106+
`RMSEA (90% CI)` = "< .05 [.00, .08]",
107+
SRMR = "\u2264 .08",
108+
AIC = "Smaller",
109+
BIC = "Smaller"
110+
),
111+
colwidths = rep(1, length(table$col_keys))
112+
)
113+
table <- flextable::bold(table, part = "footer")
114+
table <- flextable::align(table, align = "center", part = "all")
115+
table <- flextable::footnote(table, i = 1, j = 1, value = flextable::as_paragraph(
116+
"Based on Schreiber (2017), Table 3."
117117
), ref_symbols = "a", part = "footer")
118-
table <- flextable::bold(table, i = 2, bold = FALSE, part = "footer")
119-
table <- flextable::align(table, i = 2, part = "footer", align = "left")
118+
table <- flextable::bold(table, i = 2, bold = FALSE, part = "footer")
119+
table <- flextable::align(table, i = 2, part = "footer", align = "left")
120120
}
121121

122122
table <- flextable::font(table, part = "all", fontname = "Times New Roman")

R/nice_modindices.R

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -93,8 +93,8 @@ nice_modindices <- function(fit,
9393
x$similarity <- NA
9494
} else {
9595
x$similarity <- stringdist::stringsim(x$lhs.labels,
96-
x$rhs.labels,
97-
method = method
96+
x$rhs.labels,
97+
method = method
9898
)
9999
}
100100
x$similar <- x$similarity > .50

R/write_lavaan.R

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -202,7 +202,7 @@ write_lavaan <- function(mediation = NULL,
202202
custom <- paste0(header, custom)
203203
}
204204
paste0(latent, mediation, regression, covariance, indirect, intercept,
205-
threshold, constraint, custom, collapse = ""
205+
threshold, constraint, custom,
206+
collapse = ""
206207
)
207208
}
208-

README.Rmd

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -175,10 +175,10 @@ indirect <- list(IV = IV, M = M, DV = DV)
175175
176176
# Write the model, and check it
177177
model <- write_lavaan(
178-
mediation = mediation,
179-
regression = regression,
178+
mediation = mediation,
179+
regression = regression,
180180
covariance = covariance,
181-
indirect = indirect,
181+
indirect = indirect,
182182
latent = latent,
183183
label = TRUE
184184
)
@@ -239,12 +239,12 @@ flextable::save_as_image(table_temp,
239239
```{r indirect2, results='hide'}
240240
# Save fit table to Word!
241241
flextable::save_as_docx(fit_table, path = "fit_table.docx")
242-
# Note that it will also render to PDF in an `rmarkdown` document
243-
# with `output: pdf_document`, but using `latex_engine: xelatex`
244-
# is necessary when including Unicode symbols in tables like with
242+
# Note that it will also render to PDF in an `rmarkdown` document
243+
# with `output: pdf_document`, but using `latex_engine: xelatex`
244+
# is necessary when including Unicode symbols in tables like with
245245
# the `nice_fit()` function.
246246
247-
# Let's get the user-defined (e.g., indirect) effects only and make it pretty
247+
# Let's get the user-defined (e.g., indirect) effects only and make it pretty
248248
# with the `rempsyc::nice_table` integration
249249
lavaan_defined(fit.sem, nice_table = TRUE)
250250
```

man/lavaan_defined.Rd

Lines changed: 1 addition & 1 deletion
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

tests/spelling.R

Lines changed: 6 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,6 @@
1-
if(requireNamespace('spelling', quietly = TRUE))
2-
spelling::spell_check_test(vignettes = TRUE, error = FALSE,
3-
skip_on_cran = TRUE)
1+
if (requireNamespace("spelling", quietly = TRUE)) {
2+
spelling::spell_check_test(
3+
vignettes = TRUE, error = FALSE,
4+
skip_on_cran = TRUE
5+
)
6+
}
Lines changed: 86 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,86 @@
1+
# nice_fit regular
2+
3+
Code
4+
lavaan_defined(fit)
5+
Output
6+
User.Defined.Parameter Paths p B CI_lower
7+
30 ageyr → visual → speed ageyr_visual*visual_speed 0.001 -0.151 -0.236
8+
31 ageyr → visual → speed ageyr_visual*visual_textual 0.000 -0.153 -0.237
9+
32 ageyr → visual → speed grade_visual*visual_speed 0.000 0.248 0.150
10+
33 ageyr → visual → speed grade_visual*visual_textual 0.000 0.252 0.160
11+
CI_upper
12+
30 -0.066
13+
31 -0.070
14+
32 0.345
15+
33 0.344
16+
17+
# nice_fit as nice_table
18+
19+
Code
20+
lavaan_defined(fit, nice_table = TRUE)
21+
Output
22+
a flextable object.
23+
col_keys: `User-Defined Parameter`, `Paths`, `p`, `B`, `95% CI`
24+
header has 1 row(s)
25+
body has 4 row(s)
26+
original dataset sample:
27+
User-Defined Parameter Paths p B
28+
30 ageyr → visual → speed ageyr_visual*visual_speed 5.108293e-04 -0.1508037
29+
31 ageyr → visual → speed ageyr_visual*visual_textual 3.207669e-04 -0.1534909
30+
32 ageyr → visual → speed grade_visual*visual_speed 6.163554e-07 0.2477787
31+
33 ageyr → visual → speed grade_visual*visual_textual 7.824837e-08 0.2521937
32+
95% CI
33+
30 [-0.24, -0.07]
34+
31 [-0.24, -0.07]
35+
32 [0.15, 0.35]
36+
33 [0.16, 0.34]
37+
38+
# nice_fit estimates
39+
40+
Code
41+
lavaan_defined(fit, estimate = "b")
42+
Output
43+
User.Defined.Parameter Paths p b CI_lower
44+
30 ageyr → visual → speed ageyr_visual*visual_speed 0.001 -0.090 -0.145
45+
31 ageyr → visual → speed ageyr_visual*visual_textual 0.001 -0.145 -0.227
46+
32 ageyr → visual → speed grade_visual*visual_speed 0.000 0.310 0.168
47+
33 ageyr → visual → speed grade_visual*visual_textual 0.000 0.501 0.303
48+
CI_upper
49+
30 -0.035
50+
31 -0.063
51+
32 0.453
52+
33 0.700
53+
54+
---
55+
56+
Code
57+
lavaan_defined(fit, estimate = "B")
58+
Output
59+
User.Defined.Parameter Paths p B CI_lower
60+
30 ageyr → visual → speed ageyr_visual*visual_speed 0.001 -0.151 -0.236
61+
31 ageyr → visual → speed ageyr_visual*visual_textual 0.000 -0.153 -0.237
62+
32 ageyr → visual → speed grade_visual*visual_speed 0.000 0.248 0.150
63+
33 ageyr → visual → speed grade_visual*visual_textual 0.000 0.252 0.160
64+
CI_upper
65+
30 -0.066
66+
31 -0.070
67+
32 0.345
68+
33 0.344
69+
70+
# nice_fit multiple symbols, lhs, rhs
71+
72+
Code
73+
lavaan_defined(fit, underscores_to_symbol = c("*", "+", "|", "~"), lhs_name = "Special Parameters",
74+
rhs_name = "Some paths")
75+
Output
76+
Special.Parameters Some.paths p B CI_lower
77+
30 ageyr * visual * speed ageyr_visual*visual_speed 0.001 -0.151 -0.236
78+
31 ageyr + visual + textual ageyr_visual*visual_textual 0.000 -0.153 -0.237
79+
32 grade | visual | speed grade_visual*visual_speed 0.000 0.248 0.150
80+
33 grade ~ visual ~ textual grade_visual*visual_textual 0.000 0.252 0.160
81+
CI_upper
82+
30 -0.066
83+
31 -0.070
84+
32 0.345
85+
33 0.344
86+

tests/testthat/test-lavaan_defined.R

Lines changed: 92 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,92 @@
1+
suppressWarnings(library(lavaan))
2+
3+
latent <- list(
4+
visual = paste0("x", 1:3),
5+
textual = paste0("x", 4:6),
6+
speed = paste0("x", 7:9)
7+
)
8+
9+
mediation <- list(
10+
speed = "visual",
11+
textual = "visual",
12+
visual = c("ageyr", "grade")
13+
)
14+
15+
indirect <- list(
16+
IV = c("ageyr", "grade"),
17+
M = "visual",
18+
DV = c("speed", "textual")
19+
)
20+
21+
HS.model <- write_lavaan(mediation,
22+
indirect = indirect,
23+
latent = latent, label = TRUE
24+
)
25+
26+
fit <- sem(HS.model, data = HolzingerSwineford1939)
27+
28+
# ____________________________________________________________________________
29+
# Tests ####
30+
31+
32+
test_that("nice_fit regular", {
33+
expect_snapshot(
34+
lavaan_defined(fit)
35+
)
36+
})
37+
38+
test_that("nice_fit as nice_table", {
39+
skip_if_not_installed("rempsyc")
40+
expect_snapshot(
41+
lavaan_defined(fit, nice_table = TRUE)
42+
)
43+
})
44+
45+
test_that("nice_fit estimates", {
46+
expect_snapshot(
47+
lavaan_defined(fit, estimate = "b")
48+
)
49+
expect_snapshot(
50+
lavaan_defined(fit, estimate = "B")
51+
)
52+
expect_error(
53+
lavaan_defined(fit, estimate = "C"),
54+
)
55+
})
56+
57+
test_that("nice_fit total effects", {
58+
set.seed(1234)
59+
X <- rnorm(100)
60+
M <- 0.5*X + rnorm(100)
61+
Y <- 0.7*M + rnorm(100)
62+
Data <- data.frame(X = X, Y = Y, M = M)
63+
mediation <- list(
64+
Y = "c*X",
65+
M = "a*X",
66+
Y = "b*M"
67+
)
68+
indirect <- list(
69+
ab = "a*b",
70+
total = "c + (a*b)"
71+
)
72+
model <- write_lavaan(mediation = mediation, indirect = indirect)
73+
fit <- sem(model, data = Data)
74+
expect_snapshot(
75+
lavaan_defined(fit)
76+
)
77+
})
78+
79+
test_that("nice_fit multiple symbols, lhs, rhs", {
80+
latent <- list(visual = paste0("x", 1:3), textual = paste0("x", 4:6), speed = paste0("x", 7:9))
81+
mediation <- list(speed = "visual", textual = "visual", visual = c("ageyr", "grade"))
82+
indirect <- list(IV = c("ageyr", "grade"), M = "visual", DV = c("speed", "textual"))
83+
HS.model <- write_lavaan(mediation, indirect = indirect, latent = latent, label = TRUE)
84+
fit <- sem(HS.model, data = HolzingerSwineford1939)
85+
expect_snapshot(
86+
lavaan_defined(fit,
87+
underscores_to_symbol = c("*", "+", "|", "~"),
88+
lhs_name = "Special Parameters",
89+
rhs_name = "Some paths"
90+
)
91+
)
92+
})

tests/testthat/test-lavaan_ind.R

Lines changed: 0 additions & 50 deletions
This file was deleted.

0 commit comments

Comments
 (0)