From a3c48d2bd73788084a3bf72129706c78a5429a91 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Mon, 30 Sep 2024 22:58:24 +0800 Subject: [PATCH] 0.2.3.13: plot.cond_indirect_effect() support rows or cols > 1 Tests, checks, and build_site() passed. --- DESCRIPTION | 2 +- NEWS.md | 4 +- R/plotmod.R | 71 +++++++++++-------- README.md | 2 +- .../test_plot_cond_indirect_effects_2ws.R | 15 ++-- 5 files changed, 58 insertions(+), 36 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 9574bd4c..7ad9fb71 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -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", diff --git a/NEWS.md b/NEWS.md index 2f56fdce..94a05051 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# manymome 0.2.3.12 +# manymome 0.2.3.13 ## New Features @@ -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 diff --git a/R/plotmod.R b/R/plotmod.R index 0632ba59..c6182afc 100644 --- a/R/plotmod.R +++ b/R/plotmod.R @@ -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) { @@ -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) } diff --git a/README.md b/README.md index 09bcae71..820d5f54 100644 --- a/README.md +++ b/README.md @@ -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) -(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 diff --git a/tests/testthat/test_plot_cond_indirect_effects_2ws.R b/tests/testthat/test_plot_cond_indirect_effects_2ws.R index 400b92f6..f88281f5 100644 --- a/tests/testthat/test_plot_cond_indirect_effects_2ws.R +++ b/tests/testthat/test_plot_cond_indirect_effects_2ws.R @@ -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) @@ -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")) + }) +