diff --git a/.gitignore b/.gitignore index 7c7dbdd..c8ac899 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,4 @@ *.Rcheck *.tar.gz +*.Rproj +.Rproj.user diff --git a/DESCRIPTION b/DESCRIPTION index 273e051..56c35e7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -50,6 +50,7 @@ Imports: teal.code, tern, yaml, + gridify, teal.modules.clinical Suggests: forcats, diff --git a/NAMESPACE b/NAMESPACE index 1c19383..6c91ca8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -11,29 +11,89 @@ export(or_filtering_transformator) export(patchwork_plot_decorator) export(remove_by_label) export(title_footer_decorator) -import(R6) -import(checkmate) -import(dplyr) -import(ggplot2) -import(ggplotify) -import(openxlsx) -import(patchwork) -import(rlang) -import(rtables) +export(watermark_decorator) import(shiny) -import(shinyBS) -import(shinyWidgets) import(teal) -import(tern) -import(yaml) +importFrom(R6,R6Class) +importFrom(checkmate,assert_character) +importFrom(checkmate,assert_class) +importFrom(checkmate,assert_multi_class) +importFrom(checkmate,assert_number) +importFrom(checkmate,assert_true) +importFrom(cowplot,as_grob) importFrom(cowplot,plot_grid) +importFrom(dplyr,filter) +importFrom(ggplot2,.pt) +importFrom(ggplot2,aes) +importFrom(ggplot2,annotate) +importFrom(ggplot2,arrow) +importFrom(ggplot2,coord_cartesian) +importFrom(ggplot2,element_blank) +importFrom(ggplot2,element_line) +importFrom(ggplot2,element_rect) +importFrom(ggplot2,element_text) +importFrom(ggplot2,geom_point) +importFrom(ggplot2,geom_text) +importFrom(ggplot2,ggplot) +importFrom(ggplot2,labs) +importFrom(ggplot2,layer_scales) +importFrom(ggplot2,margin) +importFrom(ggplot2,scale_x_continuous) +importFrom(ggplot2,scale_x_discrete) +importFrom(ggplot2,scale_y_continuous) +importFrom(ggplot2,scale_y_discrete) +importFrom(ggplot2,theme) +importFrom(ggplotify,as.ggplot) importFrom(grDevices,graphics.off) +importFrom(grid,unit) +importFrom(gridify,gridify) +importFrom(gridify,gridifyCell) +importFrom(gridify,gridifyCells) +importFrom(gridify,gridifyLayout) +importFrom(gridify,gridifyObject) +importFrom(gridify,set_cell) importFrom(methods,new) +importFrom(openxlsx,read.xlsx) +importFrom(patchwork,plot_annotation) importFrom(rlang,parse_expr) +importFrom(rtables,as_result_df) +importFrom(shiny,NS) +importFrom(shiny,actionButton) +importFrom(shiny,checkboxInput) +importFrom(shiny,div) +importFrom(shiny,eventReactive) +importFrom(shiny,hr) +importFrom(shiny,insertUI) +importFrom(shiny,modalDialog) +importFrom(shiny,moduleServer) +importFrom(shiny,observe) +importFrom(shiny,observeEvent) +importFrom(shiny,reactive) +importFrom(shiny,reactiveVal) +importFrom(shiny,reactiveValues) +importFrom(shiny,renderText) +importFrom(shiny,renderUI) +importFrom(shiny,req) +importFrom(shiny,selectInput) +importFrom(shiny,showModal) +importFrom(shiny,showNotification) +importFrom(shiny,span) +importFrom(shiny,tagAppendChild) +importFrom(shiny,tagList) +importFrom(shiny,tags) +importFrom(shiny,textInput) +importFrom(shiny,uiOutput) +importFrom(shiny,updateSelectInput) +importFrom(shinyBS,bsModal) +importFrom(shinyWidgets,pickerInput) importFrom(shinyjs,hidden) importFrom(shinyjs,hide) importFrom(shinyjs,show) importFrom(shinyjs,toggle) +importFrom(shinyjs,useShinyjs) +importFrom(teal,teal_transform_module) importFrom(teal.code,eval_code) importFrom(teal.modules.clinical,add_expr) importFrom(teal.modules.clinical,bracket_expr) +importFrom(tern,rtable2gg) +importFrom(yaml,as.yaml) diff --git a/NEWS.md b/NEWS.md index f5e7a6c..061d58e 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,7 @@ # Version 0.0.2.9000 - Refactored the `merge_levels_transformator` to handle the predefined inputs to the transformator. +- Added new `watermark_decorator`([#23](https://github.com/phuse-org/uteals/pull/23)). # Version 0.0.2 diff --git a/R/create_rel_risk_transformator.R b/R/create_rel_risk_transformator.R index e81dab4..2195382 100644 --- a/R/create_rel_risk_transformator.R +++ b/R/create_rel_risk_transformator.R @@ -12,7 +12,8 @@ #' @param control_group (`character(1)`) one of the existing level from the selected `column_name`. #' @param label_name (`character(1)`) label for the new field or variable. #' -#' @import teal shiny +#' @importFrom teal teal_transform_module +#' @importFrom shiny NS tagList selectInput textInput moduleServer observe updateSelectInput reactive #' #' @return `teal::teal_transform_module` #' diff --git a/R/forest_plot_decorator.R b/R/forest_plot_decorator.R index 2c6cb4b..86356cf 100644 --- a/R/forest_plot_decorator.R +++ b/R/forest_plot_decorator.R @@ -170,7 +170,12 @@ forestplot_x_decorator <- function() { #' printed side-by-side via [cowplot::plot_grid()]. #' #' @return `ggplot` forest plot and table. -#' @import checkmate tern ggplot2 rtables +#' @importFrom checkmate assert_class assert_number assert_character assert_true +#' @importFrom tern rtable2gg +#' @importFrom ggplot2 ggplot theme scale_x_continuous scale_y_continuous coord_cartesian annotate geom_point margin +#' @importFrom ggplot2 element_rect element_blank element_line element_text aes arrow .pt +#' @importFrom rtables as_result_df +#' @importFrom grid unit #' @importFrom cowplot plot_grid #' #' @export diff --git a/R/ggplot_decorator.R b/R/ggplot_decorator.R index e99ac75..0b66d83 100644 --- a/R/ggplot_decorator.R +++ b/R/ggplot_decorator.R @@ -31,7 +31,10 @@ #' of `ggplot` options given in the `plot_options` parameter value. #' The entered `ggplot` options are applied to `ggplot` plot object. #' -#' @import teal shiny ggplot2 +#' @importFrom teal teal_transform_module +#' @importFrom shiny NS tagList tagAppendChild textInput moduleServer reactive req +#' @importFrom ggplot2 labs theme element_text scale_y_continuous scale_x_continuous scale_x_discrete +#' @importFrom ggplot2 scale_y_discrete geom_text layer_scales #' #' @examples #' app <- teal::init( @@ -195,7 +198,7 @@ ggplot_decorator <- function(output_name, output_name <- output_name + ggplot2::scale_y_continuous( breaks = layer_scales(output_name)$y$break_positions(), - labels = trimws(str_split(y_labels_cont, ",")[[1]]) + labels = trimws(strsplit(y_labels_cont, ",")[[1]]) ) }, output_name = as.name(output_name), @@ -212,7 +215,7 @@ ggplot_decorator <- function(output_name, data4, { output_name <- output_name + - ggplot2::scale_x_continuous(breaks = trimws(str_split(x_breaks, ",")[[1]])) + ggplot2::scale_x_continuous(breaks = trimws(strsplit(x_breaks, ",")[[1]])) }, output_name = as.name(output_name), x_breaks = input$x_breaks @@ -229,7 +232,7 @@ ggplot_decorator <- function(output_name, output_name <- output_name + ggplot2::scale_x_continuous( breaks = layer_scales(output_name)$x$break_positions(), - labels = trimws(str_split(x_labels_cont, ",")[[1]]) + labels = trimws(strsplit(x_labels_cont, ",")[[1]]) ) }, output_name = as.name(output_name), @@ -245,7 +248,7 @@ ggplot_decorator <- function(output_name, data7 <- within( data6, { - x_labels_discrete <- trimws(str_split(x_labels_discrete, ",")[[1]]) + x_labels_discrete <- trimws(strsplit(x_labels_discrete, ",")[[1]]) output_name <- output_name + ggplot2::scale_x_discrete(labels = x_labels_discrete) }, output_name = as.name(output_name), @@ -261,7 +264,7 @@ ggplot_decorator <- function(output_name, data8 <- within( data7, { - y_labels_discrete <- trimws(str_split(y_labels_discrete, ",")[[1]]) + y_labels_discrete <- trimws(strsplit(y_labels_discrete, ",")[[1]]) output_name <- output_name + ggplot2::scale_y_discrete(labels = y_labels_discrete) }, output_name = as.name(output_name), diff --git a/R/merge_levels_transformator.R b/R/merge_levels_transformator.R index 670786c..67760c6 100644 --- a/R/merge_levels_transformator.R +++ b/R/merge_levels_transformator.R @@ -1,5 +1,6 @@ -##' R6 Class for managing the transformation objects -TransformationManager <- R6::R6Class( +# TransformationManager R6 Class for managing the transformation objects +# @noRd +TransformationManager <- R6::R6Class( # nolint: object_name_linter. "TransformationManager", public = list( counter = 0, @@ -13,7 +14,7 @@ TransformationManager <- R6::R6Class( add_id = function() { self$counter <- self$counter + 1 self$active_ids(c(self$active_ids(), self$counter)) - return(self$counter) + self$counter }, remove_id = function(id) { self$active_ids(setdiff(self$active_ids(), id)) @@ -27,10 +28,13 @@ TransformationManager <- R6::R6Class( ) #' UI design of the transformator +#' +#' @param id (`character(1)`) the id of the module. +#' @noRd merge_level_transformer_ui <- function(id) { ns <- NS(id) tagList( - useShinyjs(), + shinyjs::useShinyjs(), tags$div(id = ns("transformation_container")), hr(), actionButton(ns("add"), "Add", class = "btn-primary"), @@ -55,7 +59,10 @@ merge_level_transformer_srv <- function(id, data, manager, dataname) { req(input[[paste0("col_name_", idx)]]) col_data <- data()[[dataname]][[input[[paste0("col_name_", idx)]]]] choices <- if (is.factor(col_data)) levels(col_data) else unique(col_data) - selectInput(ns(paste0("levs_", idx)), "Levels to Update", choices = choices, multiple = TRUE, selected = lev_sel) + selectInput( + ns(paste0("levs_", idx)), "Levels to Update", + choices = choices, multiple = TRUE, selected = lev_sel + ) }) } @@ -82,7 +89,10 @@ merge_level_transformer_srv <- function(id, data, manager, dataname) { div( id = body_id, style = "margin-top: 10px;", - selectInput(ns(paste0("col_name_", idx)), "Variable", choices = names(data()[[dataname]]), selected = var_sel), + selectInput( + ns(paste0("col_name_", idx)), "Variable", + choices = names(data()[[dataname]]), selected = var_sel + ), uiOutput(ns(paste0("col_levels_ui_", idx))), textInput(ns(paste0("new_label_", idx)), "New Level Name", value = new_name) ), @@ -189,7 +199,10 @@ merge_level_transformer_srv <- function(id, data, manager, dataname) { #' which columns will be used for possible transformation. #' @param predefined (`list`) the list which has variable name, levels and new label #' -#' @import teal shiny shinyWidgets +#' @importFrom teal teal_transform_module +#' @importFrom shiny NS tagList actionButton hr div tags uiOutput renderUI req +#' @importFrom shiny selectInput textInput moduleServer reactiveVal observeEvent observe eventReactive reactive +#' @importFrom shinyWidgets pickerInput #' @importFrom teal.code eval_code #' @importFrom teal.modules.clinical add_expr bracket_expr #' diff --git a/R/or_filtering_transformator.R b/R/or_filtering_transformator.R index 1b8fa74..d787428 100644 --- a/R/or_filtering_transformator.R +++ b/R/or_filtering_transformator.R @@ -41,10 +41,15 @@ #' #' @param dataname (`character(1)`) Name of the dataset to filter. Pass a single dataset name as a string. #' -#' @import teal shiny shinyWidgets dplyr shinyBS rlang -#' @importFrom methods new -#' @importFrom shinyjs toggle show hidden hide +#' @importFrom teal teal_transform_module +#' @importFrom shiny NS tagList renderText renderUI div span actionButton observeEvent insertUI +#' @importFrom shiny updateSelectInput showNotification showModal modalDialog reactiveValues observe reactive +#' @importFrom shinyWidgets pickerInput +#' @importFrom dplyr filter +#' @importFrom shinyBS bsModal #' @importFrom rlang parse_expr +#' @importFrom methods new +#' @importFrom shinyjs toggle show hidden hide useShinyjs #' #' @return `teal::teal_transform_module` #' diff --git a/R/or_filtering_transformator_view_model.R b/R/or_filtering_transformator_view_model.R index 1c9e305..69a7e43 100644 --- a/R/or_filtering_transformator_view_model.R +++ b/R/or_filtering_transformator_view_model.R @@ -1,6 +1,6 @@ #' View model for [or_filtering_transformator()]. #' -#' @import R6 +#' @importFrom R6 R6Class #' @keywords internal filtering_transformator_model <- R6::R6Class("filtering_transformator_model", public = list( diff --git a/R/patchwork_plot_decorator.R b/R/patchwork_plot_decorator.R index cdf700d..94c66d8 100644 --- a/R/patchwork_plot_decorator.R +++ b/R/patchwork_plot_decorator.R @@ -9,7 +9,9 @@ #' @details The module creates a UI with text controls for plot title and footnote. #' The entered title and footnote text are applied to the patchwork plots. #' -#' @import teal shiny patchwork +#' @importFrom teal teal_transform_module +#' @importFrom shiny NS tagList textInput moduleServer reactive req +#' @importFrom patchwork plot_annotation #' #' @export patchwork_plot_decorator <- function(output_name, label_text = "decorator") { diff --git a/R/r_access_utilities.R b/R/r_access_utilities.R index decb696..7e3e63f 100644 --- a/R/r_access_utilities.R +++ b/R/r_access_utilities.R @@ -11,7 +11,7 @@ #' #' @return Character vector of non-parent module labels #' -#' @import yaml +#' @importFrom yaml as.yaml #' @examples #' # Extract modules from mods object to YAML file #' mods <- teal::modules( @@ -21,6 +21,11 @@ #' labels <- extract_modules_to_yaml(mods, "panel_str_modules.yml") #' unlink("panel_str_modules.yml") #' +#' # Clean up +#' if (file.exists("panel_str_modules.yml")) { +#' file.remove("panel_str_modules.yml") +#' } +#' #' @export extract_modules_to_yaml <- function(mods, filepath, verbose = FALSE) { # Recursively extract module labels, excluding parent containers @@ -58,7 +63,7 @@ extract_modules_to_yaml <- function(mods, filepath, verbose = FALSE) { if (verbose) { message("Generated ", filepath, " with ", length(non_parent_labels), " non-parent module labels") } - + non_parent_labels } @@ -74,7 +79,7 @@ extract_modules_to_yaml <- function(mods, filepath, verbose = FALSE) { #' #' @return Filtered `teal_modules` or `teal_module` object, or `NULL` if none matches. #' -#' @import checkmate +#' @importFrom checkmate assert_multi_class #' @examples #' # Keep only specific modules by label #' mods <- teal::modules( @@ -113,7 +118,7 @@ keep_by_label <- function(x, label) { #' @return The filtered teal modules object with matching modules removed, or `NULL` #' if all modules are removed. #' -#' @import checkmate +#' @importFrom checkmate assert_multi_class #' @examples #' mods <- teal::modules( #' teal::example_module("mod1"), diff --git a/R/title_footer_decorator.R b/R/title_footer_decorator.R index 7e8c086..dda1556 100644 --- a/R/title_footer_decorator.R +++ b/R/title_footer_decorator.R @@ -27,7 +27,12 @@ #' @seealso For the exact Excel workbook layout expected by this function, see the package vignette: #' `vignette("title-footer-decorator-excel-structure", package = "uteals")` #' -#' @import openxlsx ggplotify ggplot2 patchwork teal shiny +#' @importFrom openxlsx read.xlsx +#' @importFrom ggplotify as.ggplot +#' @importFrom ggplot2 labs theme element_text +#' @importFrom patchwork plot_annotation +#' @importFrom teal teal_transform_module +#' @importFrom shiny NS tagList div selectInput checkboxInput uiOutput renderUI textInput moduleServer reactive req #' @importFrom grDevices graphics.off #' #' @examples diff --git a/R/watermark_decorator.R b/R/watermark_decorator.R new file mode 100644 index 0000000..ff1f1b2 --- /dev/null +++ b/R/watermark_decorator.R @@ -0,0 +1,88 @@ +#' Watermark Decorator +#' +#' @description `r lifecycle::badge("experimental")` +#' A function to create a UI component for selecting watermark text +#' for plots. +#' Note: Currently tables are not supported +#' @param output_name (`character(1)`) a name for the output object (e.g., a plot or table). +#' @param watermark_text (`character(1)`) text to display for the watermark. +#' @param font_size (`character(1)`) font size for the watermark text. +#' +#' @return [`teal::teal_transform_module()`] +#' +#' @details The module creates a UI with `textInput` for specifying watermark text and +#' font size. +#' the entered watermark text is displayed with a default `gridify` layout. +#' +#' @importFrom cowplot as_grob +#' @importFrom gridify gridifyLayout gridifyObject gridifyCells gridifyCell gridify set_cell +#' @importFrom grDevices graphics.off +#' +#' @export +watermark_decorator <- function(output_name, watermark_text = "", font_size = 90) { + checkmate::assert_string(output_name) + checkmate::assert_string(watermark_text) + + teal::teal_transform_module( + label = "Watermark decorator", + ui = function(id) { + ns <- NS(id) + tagList( + div( + textInput(ns("txtWatermark"), label = "Enter Text", value = watermark_text), + numericInput(ns("numFontsize"), label = "Enter Font size", value = font_size) + ) + ) + }, + server = function(id, data) { + moduleServer(id, function(input, output, session) { + reactive({ + req(data()) + + res <- data() + # Determine the title and footer + res <- within( + res, + { + gridify_layout <- gridify::gridifyLayout( + nrow = 3L, + ncol = 1L, + heights = grid::unit(c(0.05, 0.9, 0.05), "npc"), + widths = grid::unit(1, "npc"), + margin = grid::unit(c(t = 0.1, r = 0.1, b = 0.1, l = 0.1), units = "cm"), + global_gpar = grid::gpar(), + background = grid::get.gpar()$fill, + adjust_height = FALSE, + object = gridify::gridifyObject(row = 2, col = 1), + cells = gridify::gridifyCells( + title = gridify::gridifyCell(row = 1, col = 1), + footer = gridify::gridifyCell(row = 3, col = 1), + watermark = gridify::gridifyCell( + row = 1:3, col = 1, rot = 45, + gpar = grid::gpar(fontsize = numFontsize, alpha = 0.3) + ) + ) + ) + }, + output_type = output_name, + output_name = as.name(output_name), + numFontsize = input$numFontsize + ) + + res <- within( + res, + { + output_name <- gridify::gridify( + object = cowplot::as_grob(output_name), + layout = gridify_layout + ) |> + gridify::set_cell("watermark", watermark_text) + }, + output_name = as.name(output_name), + watermark_text = input$txtWatermark + ) + }) + }) + } + ) +} diff --git a/man/TransformationManager.Rd b/man/TransformationManager.Rd deleted file mode 100644 index 08b8643..0000000 --- a/man/TransformationManager.Rd +++ /dev/null @@ -1,74 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/merge_levels_transformator.R -\name{TransformationManager} -\alias{TransformationManager} -\title{R6 Class for managing the transformation objects} -\description{ -R6 Class for managing the transformation objects - -R6 Class for managing the transformation objects -} -\section{Methods}{ -\subsection{Public methods}{ -\itemize{ -\item \href{#method-TransformationManager-new}{\code{TransformationManager$new()}} -\item \href{#method-TransformationManager-add_id}{\code{TransformationManager$add_id()}} -\item \href{#method-TransformationManager-remove_id}{\code{TransformationManager$remove_id()}} -\item \href{#method-TransformationManager-reset}{\code{TransformationManager$reset()}} -\item \href{#method-TransformationManager-clone}{\code{TransformationManager$clone()}} -} -} -\if{html}{\out{