Skip to content

Commit

Permalink
Merge pull request #188 from sfcheung/devel
Browse files Browse the repository at this point in the history 
0.2.3.13: plot.cond_indirect_effect() support rows or cols > 1
  • Loading branch information
@sfcheung
sfcheung authored Sep 30, 2024
2 parents e837df0 + 1fbbb1d commit dfd3019
Show file tree
Hide file tree
Showing 5 changed files with 58 additions and 36 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: manymome
Title: Mediation, Moderation and Moderated-Mediation After Model Fitting
Version: 0.2.3.12
Version: 0.2.3.13
Authors@R:
c(person(given = "Shu Fai",
family = "Cheung",
Expand Down
4 changes: 2 additions & 2 deletions NEWS.md
View file
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
# manymome 0.2.3.12
# manymome 0.2.3.13

## New Features

Expand All @@ -7,7 +7,7 @@
using `facet_grid()` to plot the
conditional effects when there are
two or more moderators in a path.
(0.2.3.3, 0.2.3.5, 0.2.3.6)
(0.2.3.3, 0.2.3.5, 0.2.3.6, 0.2.3.13)

## Improvement

Expand Down
71 changes: 43 additions & 28 deletions R/plotmod.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -612,17 +612,11 @@ plot.cond_indirect_effects <- function(
if (!all(facet_grid_cols %in% w_names)) {
stop("'facet_grid_cols' must be among the moderators.")
}
if (length(facet_grid_cols) != 1) {
stop("Having more than one column in facet_grid is not yet supported.")
}
}
if (!is.null(facet_grid_rows)) {
if (!all(facet_grid_rows %in% w_names)) {
stop("'facet_grid_rows' must be among the moderators.")
}
if (length(facet_grid_rows) != 1) {
stop("Having more than one row in facet_grid is not yet supported.")
}
}
w_names_in <- setdiff(w_names, union(facet_grid_cols, facet_grid_rows))
if (length(w_names_in) == 0) {
Expand All @@ -640,34 +634,55 @@ plot.cond_indirect_effects <- function(
plot_df_xstart_end <- plot_df_xstart_tmp
plot_df_xstart_end[paste0(x, "___end")] <- plot_df_xend_tmp[, x, drop = TRUE]
plot_df_xstart_end[paste0(y, "___end")] <- plot_df_xend_tmp[, y, drop = TRUE]
p <- ggplot2::ggplot() +
ggplot2::geom_point(ggplot2::aes(x = .data[[x]],
y = .data[[y]],
colour = .data[[w_names_in]]),
data = plot_df_tmp,
size = point_size) +
ggplot2::geom_segment(ggplot2::aes(
x = .data[[x]],
xend = .data[[paste0(x, "___end")]],
y = .data[[y]],
yend = .data[[paste0(y, "___end")]],
colour = .data[[w_names_in]],
),
data = plot_df_xstart_end,
linewidth = line_width)
p <- ggplot2::ggplot()
if (is.null(w_names_in)) {
# This solution is not ideal. Code duplicated.
# But work for now.
p <- p + ggplot2::geom_point(ggplot2::aes(x = .data[[x]],
y = .data[[y]]),
data = plot_df_tmp,
size = point_size) +
ggplot2::geom_segment(ggplot2::aes(x = .data[[x]],
xend = .data[[paste0(x, "___end")]],
y = .data[[y]],
yend = .data[[paste0(y, "___end")]]),
data = plot_df_xstart_end,
linewidth = line_width)
} else {
p <- p + ggplot2::geom_point(ggplot2::aes(x = .data[[x]],
y = .data[[y]],
colour = .data[[w_names_in]]),
data = plot_df_tmp,
size = point_size) +
ggplot2::geom_segment(ggplot2::aes(x = .data[[x]],
xend = .data[[paste0(x, "___end")]],
y = .data[[y]],
yend = .data[[paste0(y, "___end")]],
colour = .data[[w_names_in]]),
data = plot_df_xstart_end,
linewidth = line_width)
}
if (!is.null(facet_grid_cols)) {
cols_tmp <- ggplot2::vars(.data[[facet_grid_cols]])
cols_tmp <- sapply(facet_grid_cols,
function(xx) paste0(".data[[", sQuote(xx), "]]"))
cols_tmp <- paste0("quote(ggplot2::vars(",
paste(cols_tmp, collapse = ","),
"))")
} else {
cols_tmp <- NULL
cols_tmp <- "NULL"
}
if (!is.null(facet_grid_rows)) {
rows_tmp <- ggplot2::vars(.data[[facet_grid_rows]])
rows_tmp <- sapply(facet_grid_rows,
function(xx) paste0(".data[[", sQuote(xx), "]]"))
rows_tmp <- paste0("quote(ggplot2::vars(",
paste(rows_tmp, collapse = ","),
"))")
} else {
rows_tmp <- NULL
rows_tmp <- "NULL"
}
facet_grid_args_final <- utils::modifyList(list(rows = rows_tmp,
cols = cols_tmp),
facet_grid_args)
facet_grid_args_final <- utils::modifyList(facet_grid_args,
list(cols = eval(parse(text = cols_tmp)),
rows = eval(parse(text = rows_tmp))))
p <- p + do.call(ggplot2::facet_grid,
facet_grid_args_final)
}
Expand Down
2 changes: 1 addition & 1 deletion README.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,7 @@
[![R-CMD-check](https://github.com/sfcheung/manymome/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/sfcheung/manymome/actions/workflows/R-CMD-check.yaml)
<!-- badges: end -->

(Version 0.2.3.12, updated on 2024-09-29, [release history](https://sfcheung.github.io/manymome/news/index.html))
(Version 0.2.3.13, updated on 2024-09-30, [release history](https://sfcheung.github.io/manymome/news/index.html))

# manymome <img src="man/figures/logo.png" align="right" height="150" />

Expand Down
15 changes: 11 additions & 4 deletions tests/testthat/test_plot_cond_indirect_effects_2ws.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -28,6 +28,12 @@ test_that("Two moderators", {
expect_no_error(plot(out_1, facet_grid_cols = "gp", graph_type = "tumble"))
expect_no_error(plot(out_1, facet_grid_rows = "w4", graph_type = "tumble"))
expect_no_error(plot(out_1, facet_grid_cols = "w4", graph_type = "tumble"))

expect_no_error(plot(out_1, facet_grid_rows = "gp", facet_grid_cols = "w4"))
expect_no_error(plot(out_1, facet_grid_rows = "w4", facet_grid_cols = "gp"))

expect_no_error(plot(out_1, facet_grid_rows = c("gp", "w4")))
expect_no_error(plot(out_1, facet_grid_cols = c("gp", "w4")))
})

lm_m3 <- lm(m3 ~ m1, dat)
Expand All @@ -50,9 +56,10 @@ test_that("Three moderators", {
expect_no_error(plot(out_1, graph_type = "tumble", facet_grid_rows = "gp", facet_grid_cols = "city"))
expect_no_error(plot(out_1, graph_type = "tumble", facet_grid_rows = "gp", facet_grid_cols = "w4"))
expect_no_error(plot(out_1, graph_type = "tumble", facet_grid_rows = "w4", facet_grid_cols = "city"))
})

test_that("Three moderators", {
expect_error(plot(out_1, facet_grid_cols = c("gp", "w4")))
expect_error(plot(out_1, facet_grid_rows = c("gp", "w4")))
expect_no_error(plot(out_1, graph_type = "tumble", facet_grid_rows = c("gp", "city")))
expect_no_error(plot(out_1, graph_type = "tumble", facet_grid_rows = c("w4", "city")))
expect_no_error(plot(out_1, graph_type = "tumble", facet_grid_cols = c("gp", "city"), facet_grid_rows = "w4"))

})

0 comments on commit dfd3019

Please sign in to comment.