diff --git a/R/mod_boxplot.R b/R/mod_boxplot.R index 4f06111..af2198c 100644 --- a/R/mod_boxplot.R +++ b/R/mod_boxplot.R @@ -14,6 +14,7 @@ BP <- poc( # nolint OTHER_BUTTON = "other_button", VIOLIN_CHECK = "violin_check", SHOW_POINTS_CHECK = "show_points_check", + Y_PROJECTION_CHECK = "y_projection_check", CHART = "chart", TAB_TABLES = "tab_tables", TABLE_SINGLE_LISTING = "table_single_listing", @@ -43,6 +44,7 @@ BP <- poc( # nolint OTHER_BUTTON = "Other", VIOLIN_CHECK = "Violin plot", SHOW_POINTS_CHECK = "Show individual points", + Y_PROJECTION_CHECK = "Y-axis logarithmic projection", TABLE_LISTING = "Data Listing", TABLE_SINGLE_LISTING = "Single Listing", TABLE_COUNT = "Data Count", @@ -118,7 +120,8 @@ boxplot_UI <- function(id) { # nolint other_menu <- drop_menu_helper( ns(BP$ID$OTHER_BUTTON), BP$MSG$LABEL$OTHER_BUTTON, shiny::checkboxInput(inputId = ns(BP$ID$VIOLIN_CHECK), BP$MSG$LABEL$VIOLIN_CHECK), - shiny::checkboxInput(inputId = ns(BP$ID$SHOW_POINTS_CHECK), BP$MSG$LABEL$SHOW_POINTS_CHECK) + shiny::checkboxInput(inputId = ns(BP$ID$SHOW_POINTS_CHECK), BP$MSG$LABEL$SHOW_POINTS_CHECK), + shiny::checkboxInput(inputId = ns(BP$ID$Y_PROJECTION_CHECK), BP$MSG$LABEL$Y_PROJECTION_CHECK) ) state_menu <- drop_menu_helper( @@ -400,6 +403,9 @@ boxplot_server <- function(id, inputs[[BP$ID$SHOW_POINTS_CHECK]] <- shiny::reactive({ input[[BP$ID$SHOW_POINTS_CHECK]] }) + inputs[[BP$ID$Y_PROJECTION_CHECK]] <- shiny::reactive({ + input[[BP$ID$Y_PROJECTION_CHECK]] + }) inputs[[BP$ID$CHART_CLICK]] <- shiny::reactive({ input[[BP$ID$CHART_CLICK]] }) @@ -574,6 +580,7 @@ boxplot_server <- function(id, ds = data_subset(), violin = inputs[[BP$ID$VIOLIN_CHECK]](), show_points = inputs[[BP$ID$SHOW_POINTS_CHECK]](), + log_project_y = inputs[[BP$ID$Y_PROJECTION_CHECK]](), title_data = bp_title_data() ) ) @@ -1024,7 +1031,7 @@ bp_subset_data <- function(cat, #' #' @keywords internal #' -boxplot_chart <- function(ds, violin, show_points, title_data = NULL) { +boxplot_chart <- function(ds, violin, show_points, log_project_y, title_data = NULL) { is_main_grouped <- CNT$MAIN_GROUP %in% names(ds) is_sub_grouped <- CNT$SUB_GROUP %in% names(ds) is_page_grouped <- CNT$PAGE_GROUP %in% names(ds) @@ -1101,7 +1108,7 @@ boxplot_chart <- function(ds, violin, show_points, title_data = NULL) { title_data$main_grp, title_data$sub_grp, title_data$page_grp ) - p + + p <- p + ggplot2::facet_grid( rows = rows, cols = cols, @@ -1118,6 +1125,12 @@ boxplot_chart <- function(ds, violin, show_points, title_data = NULL) { strip.text.x = ggplot2::element_text(size = STYLE$STRIP_TEXT_SIZE), strip.text.y = ggplot2::element_text(size = STYLE$STRIP_TEXT_SIZE) ) + + if (isTRUE(log_project_y)) { + p <- p + ggplot2::scale_y_continuous(trans = pseudo_log_projection(base = 10)) + } + + return(p) } #' Subsets a data.frame based on the values of a one-rowed data.frame @@ -1297,8 +1310,8 @@ NULL #' @rdname boxplot_composed #' @inheritParams boxplot_chart -bp_get_boxplot_output <- function(ds, violin, show_points, title_data) { - boxplot_chart(ds, violin, show_points, title_data) +bp_get_boxplot_output <- function(ds, violin, show_points, log_project_y, title_data) { + boxplot_chart(ds, violin, show_points, log_project_y, title_data) } #' @rdname boxplot_composed diff --git a/man/boxplot_chart.Rd b/man/boxplot_chart.Rd index 7f6e49e..9d2d962 100644 --- a/man/boxplot_chart.Rd +++ b/man/boxplot_chart.Rd @@ -4,7 +4,7 @@ \alias{boxplot_chart} \title{ggplot for a set of faceted boxplots} \usage{ -boxplot_chart(ds, violin, show_points, title_data = NULL) +boxplot_chart(ds, violin, show_points, log_project_y, title_data = NULL) } \arguments{ \item{ds}{\code{data.frame()} diff --git a/man/boxplot_composed.Rd b/man/boxplot_composed.Rd index b21fdf7..f7db4e4 100644 --- a/man/boxplot_composed.Rd +++ b/man/boxplot_composed.Rd @@ -10,7 +10,7 @@ \alias{bp_get_significance_output} \title{Composes data selection and charting for boxplot} \usage{ -bp_get_boxplot_output(ds, violin, show_points, title_data) +bp_get_boxplot_output(ds, violin, show_points, log_project_y, title_data) bp_get_listings_output(ds, closest_point)