diff --git a/DESCRIPTION b/DESCRIPTION index 135f2daf..717dc759 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -20,7 +20,7 @@ Description: ready4use provides a set of tools for managing data for of the ready4use package has been made available as part of the process of testing and documenting the package. If you have any questions, please contact the authors (matthew.hamilton1@monash.edu). -License: GPL-3 + file LICENSE +License: GPL-3 URL: https://ready4-dev.github.io/ready4use/, https://github.com/ready4-dev/ready4use, https://www.ready4-dev.com/ Encoding: UTF-8 @@ -28,6 +28,7 @@ Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.2 Suggests: knitr, + pkgload, rmarkdown, testthat VignetteBuilder: knitr diff --git a/NAMESPACE b/NAMESPACE index bae02a3d..6835f820 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -151,7 +151,9 @@ importFrom(english,words) importFrom(fs,path_file) importFrom(ggplot2,aes) importFrom(ggplot2,after_stat) +importFrom(ggplot2,annotate) importFrom(ggplot2,element_blank) +importFrom(ggplot2,geom_segment) importFrom(ggplot2,ggplot_build) importFrom(ggplot2,labs) importFrom(ggplot2,position_dodge) diff --git a/R/fn_add.R b/R/fn_add.R index 86761e04..858f3208 100644 --- a/R/fn_add.R +++ b/R/fn_add.R @@ -350,6 +350,7 @@ add_latest_match <- function (data_tb, dynamic_lup, target_var_nm_1L_chr, date_v #' @param adjust_1L_dbl Adjust (a double vector of length one), Default: 0.4 #' @param as_percent_1L_lgl As percent (a logical vector of length one), Default: F #' @param digits_1L_int Digits (an integer vector of length one), Default: 4 +#' @param flip_1L_lgl Flip (a logical vector of length one), Default: F #' @param scientific_1L_lgl Scientific (a logical vector of length one), Default: F #' @param show_p_1L_lgl Show p (a logical vector of length one), Default: T #' @param show_test_1L_lgl Show test (a logical vector of length one), Default: F @@ -358,27 +359,47 @@ add_latest_match <- function (data_tb, dynamic_lup, target_var_nm_1L_chr, date_v #' @return Plot (a plot) #' @rdname add_significance #' @export -#' @importFrom ggplot2 ggplot_build +#' @importFrom ggplot2 ggplot_build geom_segment annotate #' @importFrom stringr str_remove_all #' @importFrom purrr discard #' @importFrom ggsignif geom_signif #' @keywords internal add_significance <- function (plot_plt, by_1L_chr, data_tb, var_1L_chr, add_1L_dbl = numeric(0), adjust_1L_dbl = 0.4, as_percent_1L_lgl = F, digits_1L_int = 4, - scientific_1L_lgl = F, show_p_1L_lgl = T, show_test_1L_lgl = F, - tip_1L_dbl = 0, ...) + flip_1L_lgl = F, scientific_1L_lgl = F, show_p_1L_lgl = T, + show_test_1L_lgl = F, tip_1L_dbl = 0, ...) { df <- make_significance_df(data_tb, by_1L_chr = by_1L_chr, vars_chr = var_1L_chr) - x_axis_chr <- ggplot2::ggplot_build(plot_plt)$layout$panel_params[[1]]$x$get_labels() + x_axis_xx <- ggplot2::ggplot_build(plot_plt)$layout$panel_params[[1]]$x$get_labels() + if (identical(add_1L_dbl, numeric(0)) & flip_1L_lgl) { + add_1L_dbl <- 0 + } if (!identical(add_1L_dbl, numeric(0))) { y_axis_dbl <- ggplot2::ggplot_build(plot_plt)$layout$panel_params[[1]]$y$get_labels() %>% stringr::str_remove_all("%") %>% purrr::discard(is.na) %>% as.numeric() y_axis_max_1L_dbl <- y_axis_dbl %>% max() - y_position <- y_axis_max_1L_dbl + add_1L_dbl + y_axis_min_1L_dbl <- min(y_axis_dbl) + if (flip_1L_lgl) { + if (is.numeric(x_axis_xx)) { + x_val_1L_dbl <- x_axis_xx[length(x_axis_xx)] + + add_1L_dbl + } + else { + x_val_1L_dbl <- length(x_axis_xx) + add_1L_dbl + } + y_position <- y_axis_max_1L_dbl + } + else { + y_position <- y_axis_max_1L_dbl + add_1L_dbl + } if (as_percent_1L_lgl) { + if (flip_1L_lgl) { + x_val_1L_dbl <- x_val_1L_dbl + } y_position <- y_position/100 + y_axis_min_1L_dbl <- y_axis_min_1L_dbl/100 } } else { @@ -391,9 +412,18 @@ add_significance <- function (plot_plt, by_1L_chr, data_tb, var_1L_chr, add_1L_d format(round(df$p.value, digits_1L_int), scientific = scientific_1L_lgl), " ")), df$stars, ifelse(show_test_1L_lgl, paste0(" ", df$test), "")) - plot_plt <- plot_plt + ggsignif::geom_signif(comparisons = list(x_axis_chr[c(1, - length(x_axis_chr))]), annotations = label_1L_chr, tip_length = tip_1L_dbl, - vjust = adjust_1L_dbl, y_position = y_position, ...) + if (flip_1L_lgl) { + plot_plt <- plot_plt + ggplot2::geom_segment(x = x_val_1L_dbl, + y = y_axis_min_1L_dbl, yend = y_position) + ggplot2::annotate("text", + x = x_val_1L_dbl, y = y_position/2, label = label_1L_chr, + vjust = adjust_1L_dbl, angle = 90) + } + else { + plot_plt <- plot_plt + ggsignif::geom_signif(comparisons = list(x_axis_xx[c(1, + length(x_axis_xx))]), annotations = label_1L_chr, + tip_length = tip_1L_dbl, vjust = adjust_1L_dbl, y_position = y_position, + ...) + } return(plot_plt) } #' Add with join diff --git a/R/fn_plot.R b/R/fn_plot.R index e9775c76..b7296248 100644 --- a/R/fn_plot.R +++ b/R/fn_plot.R @@ -8,6 +8,7 @@ #' @param drop_missing_1L_lgl Drop missing (a logical vector of length one), Default: FALSE #' @param drop_ticks_1L_lgl Drop ticks (a logical vector of length one), Default: FALSE #' @param fill_single_1L_lgl Fill single (a logical vector of length one), Default: FALSE +#' @param flip_1L_lgl Flip (a logical vector of length one), Default: F #' @param label_fill_1L_chr Label fill (a character vector of length one), Default: character(0) #' @param line_1L_chr Line (a character vector of length one), Default: 'black' #' @param position_xx Position (an output object of multiple potential types), Default: NULL @@ -41,7 +42,7 @@ plot_for_journal <- function (data_tb, as_percent_1L_lgl = FALSE, by_1L_chr = character(0), colours_chr = c("#de2d26", "#fc9272"), drop_legend_1L_lgl = FALSE, drop_missing_1L_lgl = FALSE, drop_ticks_1L_lgl = FALSE, fill_single_1L_lgl = FALSE, - label_fill_1L_chr = character(0), line_1L_chr = "black", + flip_1L_lgl = F, label_fill_1L_chr = character(0), line_1L_chr = "black", position_xx = NULL, recode_lup_r3 = ready4show::ready4show_correspondences(), significance_1L_lgl = F, significance_args_ls = list(), style_1L_chr = get_styles(), title_1L_chr = character(0), type_1L_chr = c("ggsci", "manual", @@ -341,7 +342,12 @@ plot_for_journal <- function (data_tb, as_percent_1L_lgl = FALSE, by_1L_chr = ch "Freq", y_1L_chr) if (!identical(by_1L_chr, x_1L_chr) & !identical(by_1L_chr, character(0))) { - data_xx <- data_xx %>% dplyr::group_by(!!rlang::sym(by_1L_chr)) + if (!flip_1L_lgl) { + data_xx <- data_xx %>% dplyr::group_by(!!rlang::sym(by_1L_chr)) + } + else { + data_xx <- data_xx %>% dplyr::group_by(!!rlang::sym(x_1L_chr)) + } } data_xx <- data_xx %>% dplyr::mutate(Percent = (!!rlang::sym(y_1L_chr)/sum(!!rlang::sym(y_1L_chr)))) args_ls$y <- "Percent" diff --git a/R/mthd_depict.R b/R/mthd_depict.R index 58f5d8d0..3cbfe3c6 100644 --- a/R/mthd_depict.R +++ b/R/mthd_depict.R @@ -14,6 +14,7 @@ #' @param drop_missing_1L_lgl Drop missing (a logical vector of length one), Default: FALSE #' @param drop_ticks_1L_lgl Drop ticks (a logical vector of length one), Default: FALSE #' @param fill_single_1L_lgl Fill single (a logical vector of length one), Default: FALSE +#' @param flip_1L_lgl Flip (a logical vector of length one), Default: F #' @param line_1L_chr Line (a character vector of length one), Default: 'black' #' @param position_xx Position (an output object of multiple potential types), Default: NULL #' @param recode_lup_r3 Recode (a ready4 submodule extension of lookup table), Default: ready4show::ready4show_correspondences() @@ -41,8 +42,8 @@ methods::setMethod("depict", "Ready4useDyad", function (x, x_vars_chr = characte z_vars_chr = character(0), arrange_1L_lgl = FALSE, arrange_args_ls = list(), as_percent_1L_lgl = FALSE, colours_chr = c("#de2d26", "#fc9272"), drop_legend_1L_lgl = FALSE, drop_missing_1L_lgl = FALSE, - drop_ticks_1L_lgl = FALSE, fill_single_1L_lgl = FALSE, line_1L_chr = "black", - position_xx = NULL, recode_lup_r3 = ready4show::ready4show_correspondences(), + drop_ticks_1L_lgl = FALSE, fill_single_1L_lgl = FALSE, flip_1L_lgl = F, + line_1L_chr = "black", position_xx = NULL, recode_lup_r3 = ready4show::ready4show_correspondences(), significance_1L_lgl = F, significance_args_ls = list(), style_1L_chr = get_styles(), titles_chr = character(0), type_1L_chr = c("ggsci", "manual", "viridis"), x_labels_chr = character(0), y_labels_chr = character(0), @@ -243,11 +244,11 @@ methods::setMethod("depict", "Ready4useDyad", function (x, x_vars_chr = characte by_1L_chr = by_1L_chr, colours_chr = colours_chr, drop_legend_1L_lgl = drop_legend_1L_lgl, drop_missing_1L_lgl = drop_missing_1L_lgl, drop_ticks_1L_lgl = drop_ticks_1L_lgl, fill_single_1L_lgl = fill_single_1L_lgl, - label_fill_1L_chr = label_fill_1L_chr, line_1L_chr = line_1L_chr, - significance_1L_lgl = significance_1L_lgl, significance_args_ls = significance_args_ls, - position_xx = position_xx, style_1L_chr = style_1L_chr, - title_1L_chr = title_1L_chr, type_1L_chr = type_1L_chr, - x_1L_chr = x_1L_chr, x_label_1L_chr = x_label_1L_chr, + flip_1L_lgl = flip_1L_lgl, label_fill_1L_chr = label_fill_1L_chr, + line_1L_chr = line_1L_chr, significance_1L_lgl = significance_1L_lgl, + significance_args_ls = significance_args_ls, position_xx = position_xx, + style_1L_chr = style_1L_chr, title_1L_chr = title_1L_chr, + type_1L_chr = type_1L_chr, x_1L_chr = x_1L_chr, x_label_1L_chr = x_label_1L_chr, recode_lup_r3 = recode_lup_r3, y_1L_chr = y_1L_chr, y_label_1L_chr = y_label_1L_chr, what_1L_chr = what_1L_chr)) rlang::exec(plot_for_journal, x@ds_tb, !!!args_ls) diff --git a/data-raw/fns/add.R b/data-raw/fns/add.R index 2f4fdf5a..d1b5ccef 100644 --- a/data-raw/fns/add.R +++ b/data-raw/fns/add.R @@ -260,6 +260,7 @@ add_significance <- function(plot_plt, adjust_1L_dbl = 0.4, as_percent_1L_lgl = F, digits_1L_int = 4, + flip_1L_lgl = F, ############### scientific_1L_lgl = F, show_p_1L_lgl = T, show_test_1L_lgl = F, @@ -268,29 +269,51 @@ add_significance <- function(plot_plt, df <- make_significance_df(data_tb, by_1L_chr = by_1L_chr, vars_chr = var_1L_chr) - x_axis_chr <- ggplot2::ggplot_build(plot_plt)$layout$panel_params[[1]]$x$get_labels() + x_axis_xx <- ggplot2::ggplot_build(plot_plt)$layout$panel_params[[1]]$x$get_labels() + if(identical(add_1L_dbl, numeric(0)) & flip_1L_lgl){ + add_1L_dbl <- 0 + } if(!identical(add_1L_dbl, numeric(0))){ y_axis_dbl <- ggplot2::ggplot_build(plot_plt)$layout$panel_params[[1]]$y$get_labels() %>% stringr::str_remove_all("%") %>% purrr::discard(is.na) %>% as.numeric() y_axis_max_1L_dbl <- y_axis_dbl %>% max() - y_position <- y_axis_max_1L_dbl + add_1L_dbl + y_axis_min_1L_dbl <- min(y_axis_dbl) + + if(flip_1L_lgl){ + if(is.numeric(x_axis_xx)){ + x_val_1L_dbl <- x_axis_xx[length(x_axis_xx)] + add_1L_dbl + }else{ + x_val_1L_dbl <- length(x_axis_xx) + add_1L_dbl + } + y_position <- y_axis_max_1L_dbl + }else{ + y_position <- y_axis_max_1L_dbl + add_1L_dbl + } if(as_percent_1L_lgl){ - y_position <- y_position/100 + if(flip_1L_lgl){ + x_val_1L_dbl <- x_val_1L_dbl + } + y_position <- y_position / 100 + y_axis_min_1L_dbl <- y_axis_min_1L_dbl / 100 } }else{ y_position <- NULL } if(as_percent_1L_lgl){ - tip_1L_dbl <- tip_1L_dbl/100 + tip_1L_dbl <- tip_1L_dbl / 100 } - label_1L_chr <- paste0(ifelse(show_p_1L_lgl, paste0("p=", format(round(df$p.value, digits_1L_int), scientific = scientific_1L_lgl)," ")), + label_1L_chr <- paste0(ifelse(show_p_1L_lgl, paste0("p=",format(round(df$p.value, digits_1L_int), scientific = scientific_1L_lgl)," ")), df$stars, ifelse(show_test_1L_lgl,paste0(" ",df$test),"")) - plot_plt <- plot_plt + - ggsignif::geom_signif(comparisons=list(x_axis_chr[c(1,length(x_axis_chr))]), - annotations=label_1L_chr, tip_length = tip_1L_dbl, vjust = adjust_1L_dbl, - y_position = y_position, - ...) + if(flip_1L_lgl){ + plot_plt <- plot_plt + ggplot2::geom_segment(x=x_val_1L_dbl, y=y_axis_min_1L_dbl, yend=y_position) + ggplot2::annotate("text",x=x_val_1L_dbl, y=y_position/2, label = label_1L_chr, vjust=adjust_1L_dbl, angle = 90) + }else{ + plot_plt <- plot_plt + + ggsignif::geom_signif(comparisons=list(x_axis_xx[c(1,length(x_axis_xx))]), + annotations=label_1L_chr, tip_length = tip_1L_dbl, vjust = adjust_1L_dbl, + y_position = y_position, + ...) + } return(plot_plt) } add_with_join <- function (X_Ready4useDyad, diff --git a/data-raw/fns/plot.R b/data-raw/fns/plot.R index 0f6a9b1c..bb53dbad 100644 --- a/data-raw/fns/plot.R +++ b/data-raw/fns/plot.R @@ -6,12 +6,13 @@ plot_for_journal <- function (data_tb, drop_missing_1L_lgl = FALSE, drop_ticks_1L_lgl = FALSE, fill_single_1L_lgl = FALSE, + flip_1L_lgl = F, ######################################## label_fill_1L_chr = character(0), line_1L_chr = "black", position_xx = NULL, recode_lup_r3 = ready4show::ready4show_correspondences(), significance_1L_lgl = F, - significance_args_ls = list(), + significance_args_ls = list(), # style_1L_chr = get_styles(), title_1L_chr = character(0), type_1L_chr = c("ggsci", "manual", "viridis"), @@ -284,7 +285,7 @@ plot_for_journal <- function (data_tb, if ((what_1L_chr %in% c("donutchart", "pie") & identical(by_1L_chr, character(0))) | (what_1L_chr %in% c("barplot") & identical(y_1L_chr, character(0)))) { - data_xx <- table(data_xx %>% dplyr::select(tidyselect::any_of(unique(c(x_1L_chr, by_1L_chr)) + data_xx <- table(data_xx %>% dplyr::select(tidyselect::any_of(unique(c(x_1L_chr, by_1L_chr)) ##### )), useNA = "ifany") %>% tibble::as_tibble() %>% dplyr::rename(Freq = n) if (drop_missing_1L_lgl) { @@ -296,10 +297,14 @@ plot_for_journal <- function (data_tb, new_by_1L_chr <- ifelse(what_1L_chr %in% c("donutchart", "pie"), x_1L_chr, by_1L_chr) } - if(what_1L_chr %in% c("barplot") & as_percent_1L_lgl){ + if(what_1L_chr %in% c("barplot") & as_percent_1L_lgl){ #### y_1L_chr <- ifelse(identical(y_1L_chr, character(0)), "Freq", y_1L_chr) if(!identical(by_1L_chr, x_1L_chr) & !identical(by_1L_chr, character(0))){ - data_xx <- data_xx %>% dplyr::group_by(!!rlang::sym(by_1L_chr)) + if(!flip_1L_lgl){ + data_xx <- data_xx %>% dplyr::group_by(!!rlang::sym(by_1L_chr)) + }else{ + data_xx <- data_xx %>% dplyr::group_by(!!rlang::sym(x_1L_chr)) + } } data_xx <- data_xx %>% dplyr::mutate(Percent = (!!rlang::sym(y_1L_chr) / sum(!!rlang::sym(y_1L_chr)))) args_ls$y <- "Percent" @@ -318,6 +323,9 @@ plot_for_journal <- function (data_tb, } plot_plt <- rlang::exec(plot_fn, data_xx, !!!args_ls) if (as_percent_1L_lgl) { + # if (what_1L_chr %in% c("barplot")) { + # plot_plt <- plot_plt + ggplot2::aes(y = !!rlang::sym(new_by_1L_chr)/sum(!!rlang::sym(new_by_1L_chr))) + # } if (!what_1L_chr %in% c("donutchart", "pie", "histogram")) { plot_plt <- plot_plt + ggplot2::scale_y_continuous(labels = scales::label_percent()) + ggplot2::labs(y = y_label_1L_chr) diff --git a/data-raw/s4_fns/depict.R b/data-raw/s4_fns/depict.R index b04ec96b..11a1a0ba 100644 --- a/data-raw/s4_fns/depict.R +++ b/data-raw/s4_fns/depict.R @@ -10,6 +10,7 @@ depict_Ready4useDyad <- function(x, drop_missing_1L_lgl = FALSE, drop_ticks_1L_lgl = FALSE, fill_single_1L_lgl = FALSE, + flip_1L_lgl = F, line_1L_chr = "black", position_xx = NULL, recode_lup_r3 = ready4show::ready4show_correspondences(), @@ -220,6 +221,7 @@ depict_Ready4useDyad <- function(x, drop_missing_1L_lgl = drop_missing_1L_lgl, drop_ticks_1L_lgl = drop_ticks_1L_lgl, fill_single_1L_lgl = fill_single_1L_lgl, + flip_1L_lgl = flip_1L_lgl, label_fill_1L_chr = label_fill_1L_chr, line_1L_chr = line_1L_chr, significance_1L_lgl = significance_1L_lgl, # diff --git a/man/add_significance.Rd b/man/add_significance.Rd index 1d3aa0fb..d66b16d2 100644 --- a/man/add_significance.Rd +++ b/man/add_significance.Rd @@ -13,6 +13,7 @@ add_significance( adjust_1L_dbl = 0.4, as_percent_1L_lgl = F, digits_1L_int = 4, + flip_1L_lgl = F, scientific_1L_lgl = F, show_p_1L_lgl = T, show_test_1L_lgl = F, @@ -37,6 +38,8 @@ add_significance( \item{digits_1L_int}{Digits (an integer vector of length one), Default: 4} +\item{flip_1L_lgl}{Flip (a logical vector of length one), Default: F} + \item{scientific_1L_lgl}{Scientific (a logical vector of length one), Default: F} \item{show_p_1L_lgl}{Show p (a logical vector of length one), Default: T} diff --git a/man/depict-methods.Rd b/man/depict-methods.Rd index 4c7085c0..0669d4f6 100644 --- a/man/depict-methods.Rd +++ b/man/depict-methods.Rd @@ -18,6 +18,7 @@ drop_missing_1L_lgl = FALSE, drop_ticks_1L_lgl = FALSE, fill_single_1L_lgl = FALSE, + flip_1L_lgl = F, line_1L_chr = "black", position_xx = NULL, recode_lup_r3 = ready4show::ready4show_correspondences(), @@ -58,6 +59,8 @@ \item{fill_single_1L_lgl}{Fill single (a logical vector of length one), Default: FALSE} +\item{flip_1L_lgl}{Flip (a logical vector of length one), Default: F} + \item{line_1L_chr}{Line (a character vector of length one), Default: 'black'} \item{position_xx}{Position (an output object of multiple potential types), Default: NULL} diff --git a/man/plot_for_journal.Rd b/man/plot_for_journal.Rd index f629f8e1..ba830498 100644 --- a/man/plot_for_journal.Rd +++ b/man/plot_for_journal.Rd @@ -13,6 +13,7 @@ plot_for_journal( drop_missing_1L_lgl = FALSE, drop_ticks_1L_lgl = FALSE, fill_single_1L_lgl = FALSE, + flip_1L_lgl = F, label_fill_1L_chr = character(0), line_1L_chr = "black", position_xx = NULL, @@ -47,6 +48,8 @@ plot_for_journal( \item{fill_single_1L_lgl}{Fill single (a logical vector of length one), Default: FALSE} +\item{flip_1L_lgl}{Flip (a logical vector of length one), Default: F} + \item{label_fill_1L_chr}{Label fill (a character vector of length one), Default: character(0)} \item{line_1L_chr}{Line (a character vector of length one), Default: 'black'}