🗃️ `decorators` feature branch #795

m7pr · 2024-11-12T10:07:44Z

Partner to insightsengineering/teal#1357
Introduces decorators to modules. More about decorators in here insightsengineering/teal#1384

Example with 1 tab per module

pkgload::load_all("../teal")
pkgload::load_all(".")

# ######################################################
#
#   _____                           _
#  |  __ \                         | |
#  | |  | | ___  ___ ___  _ __ __ _| |_ ___  _ __ ___
#  | |  | |/ _ \/ __/ _ \| '__/ _` | __/ _ \| '__/ __|
#  | |__| |  __/ (_| (_) | | | (_| | || (_) | |  \__ \
#  |_____/ \___|\___\___/|_|  \__,_|\__\___/|_|  |___/
#
#
#
#  Decorators
# #####################################################

plot_grob_decorator <- function(default_footnote = "I am a good decorator", .var_to_replace = "plot") {
  teal_transform_module(
    label = "Caption (grob)",
    ui = function(id) shiny::textInput(shiny::NS(id, "footnote"), "Footnote", value = default_footnote),
    server = function(id, data) {
      moduleServer(id, function(input, output, session) {
        logger::log_info("🟠 plot_grob with default: {default_footnote}!", namespace = "teal.modules.general")
        reactive({
          req(data(), input$footnote)
          logger::log_info("changing the footnote {default_footnote}", namespace = "teal.modules.general")
          teal.code::eval_code(data(), substitute(
            {
              footnote_grob <- grid::textGrob(footnote, x = 0, hjust = 0, gp = grid::gpar(fontsize = 10, fontface = "italic", col = "gray50"))
              # Arrange the plot and footnote
              .var_to_replace <- gridExtra::arrangeGrob(
                .var_to_replace,
                footnote_grob,
                ncol = 1,
                heights = grid::unit.c(grid::unit(1, "npc") - grid::unit(1, "lines"), grid::unit(1, "lines"))
              )
            },
            env = list(
              footnote = input$footnote,
              .var_to_replace = as.name(.var_to_replace)
            )))
        })
      })
    }
  )
}
caption_decorator <- function(default_caption = "I am a good decorator", .var_to_replace = "plot") {
  teal_transform_module(
    label = "Caption",
    ui = function(id) shiny::textInput(shiny::NS(id, "footnote"), "Footnote", value = default_caption),
    server = make_teal_transform_server(
      substitute({
        my_name <- .var_name
        .var_to_replace <- .var_to_replace + ggplot2::labs(caption = footnote)
      }, env = list(.var_to_replace = as.name(.var_to_replace), .var_name = .var_to_replace))
    )
  )
}
table_decorator <- function(.color1 = "#f9f9f9", .color2 = "#f0f0f0", .var_to_replace = "table") {
  teal_transform_module(
    label = "Table color",
    ui = function(id) {
      selectInput(
        NS(id, "style"),
        "Table Style",
        choices = c("Default", "Color1", "Color2"),
        selected = "Default"
      )
    },
    server = function(id, data) {
      moduleServer(id, function(input, output, session) {
        logger::log_info("🔵 Table row color called to action!", namespace = "teal.modules.general")
        reactive({
          req(data(), input$style)
          logger::log_info("changing the Table row color '{input$style}'", namespace = "teal.modules.general")
          teal.code::eval_code(data(), substitute({
            .var_to_replace <- switch(
              style,
              "Color1" = DT::formatStyle(
                .var_to_replace,
                columns = attr(.var_to_replace$x, "colnames")[-1],
                target = "row",
                backgroundColor = .color1
              ),
              "Color2" = DT::formatStyle(
                .var_to_replace,
                columns = attr(.var_to_replace$x, "colnames")[-1],
                target = "row",
                backgroundColor = .color2
              ),
              .var_to_replace
            )
          }, env = list(
            style = input$style,
            .var_to_replace = as.name(.var_to_replace),
            .color1 = .color1,
            .color2 = .color2
          )))
        })
      })
    }
  )
}
head_decorator <- function(default_value = 6, .var_to_replace = "object") {
  teal_transform_module(
    label = "Head",
    ui = function(id) shiny::numericInput(shiny::NS(id, "n"), "Footnote", value = default_value),
    server = make_teal_transform_server(
      substitute({
        .var_to_replace <- utils::head(.var_to_replace, n = n)
      }, env = list(.var_to_replace = as.name(.var_to_replace)))
    )
  )
}
treelis_subtitle_decorator <- function(default_caption = "I am a good decorator", .var_to_replace = "plot") {
  teal_transform_module(
    label = "Caption",
    ui = function(id) shiny::textInput(shiny::NS(id, "footnote"), "Footnote", value = default_caption),
    server = make_teal_transform_server(
      substitute({
        .var_to_replace <- update(.var_to_replace, sub = footnote)
      }, env = list(.var_to_replace = as.name(.var_to_replace)))
    )
  )
}
insert_rrow_decorator <- function(default_caption = "I am a good new row", .var_to_replace = "table") {
  teal_transform_module(
    label = "New row",
    ui = function(id) shiny::textInput(shiny::NS(id, "new_row"), "New row", value = default_caption),
    server = make_teal_transform_server(
      substitute({
        .var_to_replace <- rtables::insert_rrow(.var_to_replace, rtables::rrow(new_row))
      }, env = list(.var_to_replace = as.name(.var_to_replace)))
    )
  )
}
do_nothing_decorator <- teal_transform_module(server = function(id, data) moduleServer(id, function(input, output, session) data))

# ##########################################
#
#   _             _      _       _
#  | |           | |    | |     | |
#  | |_ ___  __ _| |  __| | __ _| |_ __ _
#  | __/ _ \/ _` | | / _` |/ _` | __/ _` |
#  | ||  __/ (_| | || (_| | (_| | || (_| |
#   \__\___|\__,_|_| \__,_|\__,_|\__\__,_|
#                ______
#               |______|
#
#  teal_data
# #########################################

data <- teal_data(join_keys = default_cdisc_join_keys[c("ADSL", "ADRS")])
data <- within(data, {
  require(nestcolor)
  ADSL <- rADSL
  ADRS <- rADRS
})

# For tm_outliers
fact_vars_adsl <- names(Filter(isTRUE, sapply(data[["ADSL"]], is.factor)))
vars <- choices_selected(variable_choices(data[["ADSL"]], fact_vars_adsl))

# For tm_g_distribution

vars1 <- choices_selected(
  variable_choices(data[["ADSL"]], c("ARM", "COUNTRY", "SEX")),
  selected = NULL
)


init(
  data = data,
  modules = modules(
    # ###################################################
    #
    #                                    _
    #                                   (_)
    #   _ __ ___  __ _ _ __ ___  ___ ___ _  ___  _ __
    #  | '__/ _ \/ _` | '__/ _ \/ __/ __| |/ _ \| '_ \
    #  | | |  __/ (_| | | |  __/\__ \__ \ | (_) | | | |
    #  |_|  \___|\__, |_|  \___||___/___/_|\___/|_| |_|
    #             __/ |
    #            |___/
    #
    #  regression
    # ##################################################
    tm_a_regression(
      label = "Regression",
      response = data_extract_spec(
        dataname = "ADSL",
        select = select_spec(
          label = "Select variable:",
          choices = "BMRKR1",
          selected = "BMRKR1",
          multiple = FALSE,
          fixed = TRUE
        )
      ),
      regressor = data_extract_spec(
        dataname = "ADSL",
        select = select_spec(
          label = "Select variables:",
          choices = variable_choices(data[["ADSL"]], c("AGE", "SEX", "RACE")),
          selected = "AGE",
          multiple = TRUE,
          fixed = FALSE
        )
      ),
      decorators = list(caption_decorator("I am Regression", "plot"))
    ),
    # #########################################################
    #
    #       _ _     _        _ _           _   _
    #      | (_)   | |      (_) |         | | (_)
    #    __| |_ ___| |_ _ __ _| |__  _   _| |_ _  ___  _ __
    #   / _` | / __| __| '__| | '_ \| | | | __| |/ _ \| '_ \
    #  | (_| | \__ \ |_| |  | | |_) | |_| | |_| | (_) | | | |
    #   \__,_|_|___/\__|_|  |_|_.__/ \__,_|\__|_|\___/|_| |_|
    #
    #
    #
    #  distribution
    # ########################################################
    tm_g_distribution(
      dist_var = data_extract_spec(
        dataname = "ADSL",
        select = select_spec(
          choices = variable_choices(data[["ADSL"]], c("AGE", "BMRKR1")),
          selected = "BMRKR1",
          multiple = FALSE,
          fixed = FALSE
        )
      ),
      strata_var = data_extract_spec(
        dataname = "ADSL",
        filter = filter_spec(
          vars = vars1,
          multiple = TRUE
        )
      ),
      group_var = data_extract_spec(
        dataname = "ADSL",
        filter = filter_spec(
          vars = vars1,
          multiple = TRUE
        )
      ),
      decorators = list(
        histogram_plot = caption_decorator("I am density!", "histogram_plot"),
        qq_plot = caption_decorator("I am QQ!", "qq_plot"),
        summary_table = table_decorator("#FFA500", "#800080", "summary_table"),
        test_table = table_decorator("#2FA000", "#80FF80", "test_table")
      )
    ),
    # ####################
    #
    #
    #
    #   _ __   ___ __ _
    #  | '_ \ / __/ _` |
    #  | |_) | (_| (_| |
    #  | .__/ \___\__,_|
    #  | |
    #  |_|
    #
    #  pca
    # ###################
    tm_a_pca(
      "PCA",
      dat = data_extract_spec(
        dataname = "ADSL",
        select = select_spec(
          choices = variable_choices(data = data[["ADSL"]], c("BMRKR1", "AGE", "EOSDY")),
          selected = c("BMRKR1", "AGE")
        )
      ),
      decorators = list(
        elbow_plot = caption_decorator("I am PCA / elbow", "elbow_plot"),
        circle_plot = caption_decorator("I am a PCA / circle", "circle_plot"),
        biplot = caption_decorator("I am a PCA / bipot", "biplot"),
        eigenvector_plot = caption_decorator("I am a PCA / eigenvector", "eigenvector_plot")
      )
    ),
    ######################################
    #
    #               _   _ _
    #              | | | (_)
    #    ___  _   _| |_| |_  ___ _ __ ___
    #   / _ \| | | | __| | |/ _ \ '__/ __|
    #  | (_) | |_| | |_| | |  __/ |  \__ \
    #   \___/ \__,_|\__|_|_|\___|_|  |___/
    #
    #
    #
    #  outliers
    # #####################################
    tm_outliers(
      outlier_var = list(
        data_extract_spec(
          dataname = "ADSL",
          select = select_spec(
            label = "Select variable:",
            choices = variable_choices(data[["ADSL"]], c("AGE", "BMRKR1")),
            selected = "AGE",
            multiple = FALSE,
            fixed = FALSE
          )
        )
      ),
      categorical_var = list(
        data_extract_spec(
          dataname = "ADSL",
          filter = filter_spec(
            vars = vars,
            choices = value_choices(data[["ADSL"]], vars$selected),
            selected = value_choices(data[["ADSL"]], vars$selected),
            multiple = TRUE
          )
        )
      ),
      decorators = list(
        box_plot = caption_decorator("I am a good decorator", "box_plot"),
        density_plot = caption_decorator("I am a good decorator", "density_plot"),
        cumulative_plot = caption_decorator("I am a good decorator", "cumulative_plot"),
        table = table_decorator("#FFA500", "#800080")
      )
    ),
    # #######################################################
    #
    #                            _       _   _
    #                           (_)     | | (_)
    #    __ _ ___ ___  ___   ___ _  __ _| |_ _  ___  _ __
    #   / _` / __/ __|/ _ \ / __| |/ _` | __| |/ _ \| '_ \
    #  | (_| \__ \__ \ (_) | (__| | (_| | |_| | (_) | | | |
    #   \__,_|___/___/\___/ \___|_|\__,_|\__|_|\___/|_| |_|
    #
    #
    #
    #  association
    # ######################################################
    tm_g_association(
      ref = data_extract_spec(
        dataname = "ADSL",
        select = select_spec(
          choices = variable_choices(
            data[["ADSL"]],
            c("SEX", "RACE", "COUNTRY", "ARM", "STRATA1", "STRATA2", "ITTFL", "BMRKR2")
          ),
          selected = "RACE"
        )
      ),
      vars = data_extract_spec(
        dataname = "ADSL",
        select = select_spec(
          choices = variable_choices(
            data[["ADSL"]],
            c("SEX", "RACE", "COUNTRY", "ARM", "STRATA1", "STRATA2", "ITTFL", "BMRKR2")
          ),
          selected = "BMRKR2",
          multiple = TRUE
        )
      ),
      decorators = list(plot_grob_decorator("I am a good grob (association)"))
    ),
    # ################################################
    #
    #       _       _         _        _     _
    #      | |     | |       | |      | |   | |
    #    __| | __ _| |_ __ _ | |_ __ _| |__ | | ___
    #   / _` |/ _` | __/ _` || __/ _` | '_ \| |/ _ \
    #  | (_| | (_| | || (_| || || (_| | |_) | |  __/
    #   \__,_|\__,_|\__\__,_| \__\__,_|_.__/|_|\___|
    #                     ______
    #                    |______|
    #
    #  data_table
    # ###############################################
    tm_data_table(
      variables_selected = list(
        iris = c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width", "Species")
      ),
      dt_args = list(caption = "IRIS Table Caption"),
      decorators = list(table_decorator())
    ),
    # ########################################################
    #
    #                                 _        _     _
    #                                | |      | |   | |
    #    ___ _ __ ___  ___ ___ ______| |_ __ _| |__ | | ___
    #   / __| '__/ _ \/ __/ __|______| __/ _` | '_ \| |/ _ \
    #  | (__| | | (_) \__ \__ \      | || (_| | |_) | |  __/
    #   \___|_|  \___/|___/___/       \__\__,_|_.__/|_|\___|
    #
    #
    #
    #  cross-table
    # #######################################################
    tm_t_crosstable(
      label = "Cross Table",
      x = data_extract_spec(
        dataname = "ADSL",
        select = select_spec(
          choices = variable_choices(data[["ADSL"]], subset = function(data) {
            idx <- !vapply(data, inherits, logical(1), c("Date", "POSIXct", "POSIXlt"))
            return(names(data)[idx])
          }),
          selected = "COUNTRY",
          multiple = TRUE,
          ordered = TRUE
        )
      ),
      y = data_extract_spec(
        dataname = "ADSL",
        select = select_spec(
          choices = variable_choices(data[["ADSL"]], subset = function(data) {
            idx <- vapply(data, is.factor, logical(1))
            return(names(data)[idx])
          }),
          selected = "SEX"
        )
      ),
      decorators = list(insert_rrow_decorator("I am a good new row"))
    ),
    # #######################################################################################
    #
    #                 _   _                  _       _                     _        _
    #                | | | |                | |     | |                   | |      (_)
    #   ___  ___ __ _| |_| |_ ___ _ __ _ __ | | ___ | |_   _ __ ___   __ _| |_ _ __ ___  __
    #  / __|/ __/ _` | __| __/ _ \ '__| '_ \| |/ _ \| __| | '_ ` _ \ / _` | __| '__| \ \/ /
    #  \__ \ (_| (_| | |_| ||  __/ |  | |_) | | (_) | |_  | | | | | | (_| | |_| |  | |>  <
    #  |___/\___\__,_|\__|\__\___|_|  | .__/|_|\___/ \__| |_| |_| |_|\__,_|\__|_|  |_/_/\_\
    #                                 | |
    #                                 |_|
    #
    #  scatterplot matrix
    # ######################################################################################
    tm_g_scatterplotmatrix(
      label = "Scatterplot matrix",
      variables = list(
        data_extract_spec(
          dataname = "ADSL",
          select = select_spec(
            choices = variable_choices(data[["ADSL"]]),
            selected = c("AGE", "RACE", "SEX"),
            multiple = TRUE,
            ordered = TRUE
          )
        ),
        data_extract_spec(
          dataname = "ADRS",
          filter = filter_spec(
            label = "Select endpoints:",
            vars = c("PARAMCD", "AVISIT"),
            choices = value_choices(data[["ADRS"]], c("PARAMCD", "AVISIT"), c("PARAM", "AVISIT")),
            selected = "INVET - END OF INDUCTION",
            multiple = TRUE
          ),
          select = select_spec(
            choices = variable_choices(data[["ADRS"]]),
            selected = c("AGE", "AVAL", "ADY"),
            multiple = TRUE,
            ordered = TRUE
          )
        )
      ),
      decorators = list(treelis_subtitle_decorator("I am a Scatterplot matrix", "plot"))
    ),
    # #############################################
    #
    #
    #
    #   _ __ ___  ___ _ __   ___  _ __  ___  ___
    #  | '__/ _ \/ __| '_ \ / _ \| '_ \/ __|/ _ \
    #  | | |  __/\__ \ |_) | (_) | | | \__ \  __/
    #  |_|  \___||___/ .__/ \___/|_| |_|___/\___|
    #                | |
    #                |_|
    #
    #  response
    # ############################################
    tm_g_response(
      label = "Response",
      response = data_extract_spec(
        dataname = "ADSL",
        select = select_spec(choices = variable_choices(data[["ADSL"]], c("BMRKR2", "COUNTRY")))
      ),
      x = data_extract_spec(
        dataname = "ADSL",
        select = select_spec(choices = variable_choices(data[["ADSL"]], c("SEX", "RACE")), selected = "RACE")
      ),
      decorators = list(caption_decorator("I am a Response", "plot"))
    ),
    # ############################################
    #
    #   _     _                 _       _
    #  | |   (_)               (_)     | |
    #  | |__  ___   ____ _ _ __ _  __ _| |_ ___
    #  | '_ \| \ \ / / _` | '__| |/ _` | __/ _ \
    #  | |_) | |\ V / (_| | |  | | (_| | ||  __/
    #  |_.__/|_| \_/ \__,_|_|  |_|\__,_|\__\___|
    #
    #
    #
    #  bivariate
    # ###########################################
    tm_g_bivariate(
      x = data_extract_spec(
        dataname = "ADSL",
        select = select_spec(choices = variable_choices(data[["ADSL"]]), selected = "AGE")
      ),
      y = data_extract_spec(
        dataname = "ADSL",
        select = select_spec(choices = variable_choices(data[["ADSL"]]), selected = "SEX")
      ),
      row_facet = data_extract_spec(
        dataname = "ADSL",
        select = select_spec(choices = variable_choices(data[["ADSL"]]), selected = "ARM")
      ),
      col_facet = data_extract_spec(
        dataname = "ADSL",
        select = select_spec(choices = variable_choices(data[["ADSL"]]), selected = "COUNTRY")
      ),
      decorators = list(caption_decorator("I am a Bivariate", "plot"))
    ),
    #####################################################
    #
    #                 _   _                  _       _
    #                | | | |                | |     | |
    #   ___  ___ __ _| |_| |_ ___ _ __ _ __ | | ___ | |_
    #  / __|/ __/ _` | __| __/ _ \ '__| '_ \| |/ _ \| __|
    #  \__ \ (_| (_| | |_| ||  __/ |  | |_) | | (_) | |_
    #  |___/\___\__,_|\__|\__\___|_|  | .__/|_|\___/ \__|
    #                                 | |
    #                                 |_|
    #
    #  scatterplot
    # ####################################################
    tm_g_scatterplot(
      label = "Scatterplot",
      x = data_extract_spec(
        dataname = "ADSL",
        select = select_spec(choices = variable_choices(data[["ADSL"]], c("AGE", "BMRKR1", "BMRKR2")))
      ),
      y = data_extract_spec(
        dataname = "ADSL",
        select = select_spec(
          choices = variable_choices(data[["ADSL"]], c("AGE", "BMRKR1", "BMRKR2")),
          selected = "BMRKR1"
        )
      ),
      color_by = data_extract_spec(
        dataname = "ADSL",
        select = select_spec(
          choices = variable_choices(data[["ADSL"]], c("AGE", "BMRKR1", "BMRKR2", "RACE", "REGION1")),
          selected = NULL
        )
      ),
      size_by = data_extract_spec(
        dataname = "ADSL",
        select = select_spec(choices = variable_choices(data[["ADSL"]], c("AGE", "BMRKR1")))
      ),
      row_facet = data_extract_spec(
        dataname = "ADSL",
        select = select_spec(
          choices = variable_choices(data[["ADSL"]], c("BMRKR2", "RACE", "REGION1")),
          selected = NULL
        )
      ),
      col_facet = data_extract_spec(
        dataname = "ADSL",
        select = select_spec(
          choices = variable_choices(data[["ADSL"]], c("BMRKR2", "RACE", "REGION1")),
          selected = NULL
        )
      ),
      decorators = list(caption_decorator("I am a scatterplot", "plot"))
    ),
    # ##############################################################
    #
    #             _         _                    _       _
    #            (_)       (_)                  | |     | |
    #   _ __ ___  _ ___ ___ _ _ __   __ _     __| | __ _| |_ __ _
    #  | '_ ` _ \| / __/ __| | '_ \ / _` |   / _` |/ _` | __/ _` |
    #  | | | | | | \__ \__ \ | | | | (_| |  | (_| | (_| | || (_| |
    #  |_| |_| |_|_|___/___/_|_| |_|\__, |   \__,_|\__,_|\__\__,_|
    #                                __/ |_____
    #                               |___/______|
    #
    #  missing_data
    # #############################################################
    tm_missing_data(
      label = "Missing data",
      decorators = list(
        summary_plot = plot_grob_decorator("A", "summary_plot"),
        combination_plot = plot_grob_decorator("B", "combination_plot"),
        summary_table = table_decorator("table", .color1 = "#f0000055"),
        by_subject_plot = caption_decorator("by_subject_plot")
      )
    ),
    example_module(decorators = list(head_decorator(6)))
  )
) |> shiny::runApp()

R/tm_outliers.R

…decorators

R/tm_a_regression.R

R/tm_outliers.R

Signed-off-by: Marcin <133694481+m7pr@users.noreply.github.com>

R/tm_outliers.R

Signed-off-by: Marcin <133694481+m7pr@users.noreply.github.com>

R/tm_a_regression.R

m7pr · 2024-11-19T11:08:42Z

Marking this ready for the review, so we can start CI/CD tests

#### Modules ##### 1 object - [x] tm_a_pca - [x] tm_g_bivariate - [x] tm_g_response - [x] tm_g_scatterplot - [x] tm_g_scatterplotmatrix - [x] tm_a_regression - [x] tm_t_crosstable - [x] tm_data_table - [x] tm_g_association ##### 2 objects ##### 3 objects - [x] tm_g_distribution - [x] tm_outliers ##### 4 objects - [x] tm_missing_data ##### Not applicable - [x] ~~tm_file_viewer~~ - [x] ~~tm_front_page~~ - [x] ~~tm_variable_browser~~ #### Changes description - Allow named-based decorators - Use `ui_decorate_teal_data` and `srv_decorate_teal_data` wrapper to simplify code - [x] New function to normalize `decorators` argument in module See [this comment](#812 (comment)) #### App with all modules (WIP) <details><summary>Working example</summary> ```r pkgload::load_all("../teal") pkgload::load_all(".") # ###################################################### # # _____ _ # | __ \ | | # | | | | ___ ___ ___ _ __ __ _| |_ ___ _ __ ___ # | | | |/ _ \/ __/ _ \| '__/ _` | __/ _ \| '__/ __| # | |__| | __/ (_| (_) | | | (_| | || (_) | | \__ \ # |_____/ \___|\___\___/|_| \__,_|\__\___/|_| |___/ # # # # Decorators # ##################################################### plot_grob_decorator <- function(default_footnote = "I am a good decorator", .var_to_replace = "plot") { teal_transform_module( label = "Caption (grob)", ui = function(id) shiny::textInput(shiny::NS(id, "footnote"), "Footnote", value = default_footnote), server = function(id, data) { moduleServer(id, function(input, output, session) { logger::log_info("🟠 plot_grob with default: {default_footnote}!", namespace = "teal.modules.general") reactive({ req(data(), input$footnote) logger::log_info("changing the footnote {default_footnote}", namespace = "teal.modules.general") teal.code::eval_code(data(), substitute( { footnote_grob <- grid::textGrob(footnote, x = 0, hjust = 0, gp = grid::gpar(fontsize = 10, fontface = "italic", col = "gray50")) # Arrange the plot and footnote .var_to_replace <- gridExtra::arrangeGrob( .var_to_replace, footnote_grob, ncol = 1, heights = grid::unit.c(grid::unit(1, "npc") - grid::unit(1, "lines"), grid::unit(1, "lines")) ) }, env = list( footnote = input$footnote, .var_to_replace = as.name(.var_to_replace) ))) }) }) } ) } caption_decorator <- function(default_caption = "I am a good decorator", .var_to_replace = "plot") { teal_transform_module( label = "Caption", ui = function(id) shiny::textInput(shiny::NS(id, "footnote"), "Footnote", value = default_caption), server = make_teal_transform_server( substitute({ .var_to_replace <- .var_to_replace + ggplot2::labs(caption = footnote) }, env = list(.var_to_replace = as.name(.var_to_replace))) ) ) } table_decorator <- function(.color1 = "#f9f9f9", .color2 = "#f0f0f0", .var_to_replace = "table") { teal_transform_module( label = "Table color", ui = function(id) { selectInput( NS(id, "style"), "Table Style", choices = c("Default", "Color1", "Color2"), selected = "Default" ) }, server = function(id, data) { moduleServer(id, function(input, output, session) { logger::log_info("🔵 Table row color called to action!", namespace = "teal.modules.general") reactive({ req(data(), input$style) logger::log_info("changing the Table row color '{input$style}'", namespace = "teal.modules.general") teal.code::eval_code(data(), substitute({ .var_to_replace <- switch( style, "Color1" = DT::formatStyle( .var_to_replace, columns = attr(.var_to_replace$x, "colnames")[-1], target = "row", backgroundColor = .color1 ), "Color2" = DT::formatStyle( .var_to_replace, columns = attr(.var_to_replace$x, "colnames")[-1], target = "row", backgroundColor = .color2 ), .var_to_replace ) }, env = list( style = input$style, .var_to_replace = as.name(.var_to_replace), .color1 = .color1, .color2 = .color2 ))) }) }) } ) } head_decorator <- function(default_value = 6, .var_to_replace = "object") { teal_transform_module( label = "Head", ui = function(id) shiny::numericInput(shiny::NS(id, "n"), "Footnote", value = default_value), server = make_teal_transform_server( substitute({ .var_to_replace <- utils::head(.var_to_replace, n = n) }, env = list(.var_to_replace = as.name(.var_to_replace))) ) ) } treelis_subtitle_decorator <- function(default_caption = "I am a good decorator", .var_to_replace = "plot") { teal_transform_module( label = "Caption", ui = function(id) shiny::textInput(shiny::NS(id, "footnote"), "Footnote", value = default_caption), server = make_teal_transform_server( substitute({ .var_to_replace <- update(.var_to_replace, sub = footnote) }, env = list(.var_to_replace = as.name(.var_to_replace))) ) ) } insert_rrow_decorator <- function(default_caption = "I am a good new row", .var_to_replace = "table") { teal_transform_module( label = "New row", ui = function(id) shiny::textInput(shiny::NS(id, "new_row"), "New row", value = default_caption), server = make_teal_transform_server( substitute({ .var_to_replace <- rtables::insert_rrow(.var_to_replace, rtables::rrow(new_row)) }, env = list(.var_to_replace = as.name(.var_to_replace))) ) ) } do_nothing_decorator <- teal_transform_module(server = function(id, data) moduleServer(id, function(input, output, session) data)) # ########################################## # # _ _ _ _ # | | | | | | | | # | |_ ___ __ _| | __| | __ _| |_ __ _ # | __/ _ \/ _` | | / _` |/ _` | __/ _` | # | || __/ (_| | || (_| | (_| | || (_| | # \__\___|\__,_|_| \__,_|\__,_|\__\__,_| # ______ # |______| # # teal_data # ######################################### data <- teal_data(join_keys = default_cdisc_join_keys[c("ADSL", "ADRS")]) data <- within(data, { require(nestcolor) ADSL <- rADSL ADRS <- rADRS }) # For tm_outliers fact_vars_adsl <- names(Filter(isTRUE, sapply(data[["ADSL"]], is.factor))) vars <- choices_selected(variable_choices(data[["ADSL"]], fact_vars_adsl)) init( data = data, modules = modules( ###################################### # # _ _ _ # | | | (_) # ___ _ _| |_| |_ ___ _ __ ___ # / _ \| | | | __| | |/ _ \ '__/ __| # | (_) | |_| | |_| | | __/ | \__ \ # \___/ \__,_|\__|_|_|\___|_| |___/ # # # # outliers # ##################################### tm_outliers( outlier_var = list( data_extract_spec( dataname = "ADSL", select = select_spec( label = "Select variable:", choices = variable_choices(data[["ADSL"]], c("AGE", "BMRKR1")), selected = "AGE", multiple = FALSE, fixed = FALSE ) ) ), categorical_var = list( data_extract_spec( dataname = "ADSL", filter = filter_spec( vars = vars, choices = value_choices(data[["ADSL"]], vars$selected), selected = value_choices(data[["ADSL"]], vars$selected), multiple = TRUE ) ) ), decorators = list( box_plot = caption_decorator("I am a good decorator", "box_plot"), density_plot = caption_decorator("I am a good decorator", "density_plot"), cumulative_plot = caption_decorator("I am a good decorator", "cumulative_plot"), table = table_decorator("#FFA500", "#800080") ) ), # ####################################################### # # _ _ _ # (_) | | (_) # __ _ ___ ___ ___ ___ _ __ _| |_ _ ___ _ __ # / _` / __/ __|/ _ \ / __| |/ _` | __| |/ _ \| '_ \ # | (_| \__ \__ \ (_) | (__| | (_| | |_| | (_) | | | | # \__,_|___/___/\___/ \___|_|\__,_|\__|_|\___/|_| |_| # # # # association # ###################################################### tm_g_association( ref = data_extract_spec( dataname = "ADSL", select = select_spec( choices = variable_choices( data[["ADSL"]], c("SEX", "RACE", "COUNTRY", "ARM", "STRATA1", "STRATA2", "ITTFL", "BMRKR2") ), selected = "RACE" ) ), vars = data_extract_spec( dataname = "ADSL", select = select_spec( choices = variable_choices( data[["ADSL"]], c("SEX", "RACE", "COUNTRY", "ARM", "STRATA1", "STRATA2", "ITTFL", "BMRKR2") ), selected = "BMRKR2", multiple = TRUE ) ), decorators = list(plot_grob_decorator("I am a good grob (association)")) ), # ################################################ # # _ _ _ _ _ # | | | | | | | | | | # __| | __ _| |_ __ _ | |_ __ _| |__ | | ___ # / _` |/ _` | __/ _` || __/ _` | '_ \| |/ _ \ # | (_| | (_| | || (_| || || (_| | |_) | | __/ # \__,_|\__,_|\__\__,_| \__\__,_|_.__/|_|\___| # ______ # |______| # # data_table # ############################################### tm_data_table( variables_selected = list( iris = c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width", "Species") ), dt_args = list(caption = "IRIS Table Caption"), decorators = list(table_decorator()) ), # ######################################################## # # _ _ _ # | | | | | | # ___ _ __ ___ ___ ___ ______| |_ __ _| |__ | | ___ # / __| '__/ _ \/ __/ __|______| __/ _` | '_ \| |/ _ \ # | (__| | | (_) \__ \__ \ | || (_| | |_) | | __/ # \___|_| \___/|___/___/ \__\__,_|_.__/|_|\___| # # # # cross-table # ####################################################### tm_t_crosstable( label = "Cross Table", x = data_extract_spec( dataname = "ADSL", select = select_spec( choices = variable_choices(data[["ADSL"]], subset = function(data) { idx <- !vapply(data, inherits, logical(1), c("Date", "POSIXct", "POSIXlt")) return(names(data)[idx]) }), selected = "COUNTRY", multiple = TRUE, ordered = TRUE ) ), y = data_extract_spec( dataname = "ADSL", select = select_spec( choices = variable_choices(data[["ADSL"]], subset = function(data) { idx <- vapply(data, is.factor, logical(1)) return(names(data)[idx]) }), selected = "SEX" ) ), decorators = list(insert_rrow_decorator("I am a good new row")) ), # ####################################################################################### # # _ _ _ _ _ _ # | | | | | | | | | | (_) # ___ ___ __ _| |_| |_ ___ _ __ _ __ | | ___ | |_ _ __ ___ __ _| |_ _ __ ___ __ # / __|/ __/ _` | __| __/ _ \ '__| '_ \| |/ _ \| __| | '_ ` _ \ / _` | __| '__| \ \/ / # \__ \ (_| (_| | |_| || __/ | | |_) | | (_) | |_ | | | | | | (_| | |_| | | |> < # |___/\___\__,_|\__|\__\___|_| | .__/|_|\___/ \__| |_| |_| |_|\__,_|\__|_| |_/_/\_\ # | | # |_| # # scatterplot matrix # ###################################################################################### tm_g_scatterplotmatrix( label = "Scatterplot matrix", variables = list( data_extract_spec( dataname = "ADSL", select = select_spec( choices = variable_choices(data[["ADSL"]]), selected = c("AGE", "RACE", "SEX"), multiple = TRUE, ordered = TRUE ) ), data_extract_spec( dataname = "ADRS", filter = filter_spec( label = "Select endpoints:", vars = c("PARAMCD", "AVISIT"), choices = value_choices(data[["ADRS"]], c("PARAMCD", "AVISIT"), c("PARAM", "AVISIT")), selected = "INVET - END OF INDUCTION", multiple = TRUE ), select = select_spec( choices = variable_choices(data[["ADRS"]]), selected = c("AGE", "AVAL", "ADY"), multiple = TRUE, ordered = TRUE ) ) ), decorators = list(treelis_subtitle_decorator("I am a Scatterplot matrix", "plot")) ), # ############################################# # # # # _ __ ___ ___ _ __ ___ _ __ ___ ___ # | '__/ _ \/ __| '_ \ / _ \| '_ \/ __|/ _ \ # | | | __/\__ \ |_) | (_) | | | \__ \ __/ # |_| \___||___/ .__/ \___/|_| |_|___/\___| # | | # |_| # # response # ############################################ tm_g_response( label = "Response", response = data_extract_spec( dataname = "ADSL", select = select_spec(choices = variable_choices(data[["ADSL"]], c("BMRKR2", "COUNTRY"))) ), x = data_extract_spec( dataname = "ADSL", select = select_spec(choices = variable_choices(data[["ADSL"]], c("SEX", "RACE")), selected = "RACE") ), decorators = list(caption_decorator("I am a Response", "plot")) ), # ############################################ # # _ _ _ _ # | | (_) (_) | | # | |__ ___ ____ _ _ __ _ __ _| |_ ___ # | '_ \| \ \ / / _` | '__| |/ _` | __/ _ \ # | |_) | |\ V / (_| | | | | (_| | || __/ # |_.__/|_| \_/ \__,_|_| |_|\__,_|\__\___| # # # # bivariate # ########################################### tm_g_bivariate( x = data_extract_spec( dataname = "ADSL", select = select_spec(choices = variable_choices(data[["ADSL"]]), selected = "AGE") ), y = data_extract_spec( dataname = "ADSL", select = select_spec(choices = variable_choices(data[["ADSL"]]), selected = "SEX") ), row_facet = data_extract_spec( dataname = "ADSL", select = select_spec(choices = variable_choices(data[["ADSL"]]), selected = "ARM") ), col_facet = data_extract_spec( dataname = "ADSL", select = select_spec(choices = variable_choices(data[["ADSL"]]), selected = "COUNTRY") ), decorators = list(caption_decorator("I am a Bivariate", "plot")) ), # #################### # # # # _ __ ___ __ _ # | '_ \ / __/ _` | # | |_) | (_| (_| | # | .__/ \___\__,_| # | | # |_| # # pca # ################### tm_a_pca( "PCA", dat = data_extract_spec( dataname = "ADSL", select = select_spec( choices = variable_choices(data = data[["ADSL"]], c("BMRKR1", "AGE", "EOSDY")), selected = c("BMRKR1", "AGE") ) ), decorators = list(caption_decorator("I am a PCA", "plot")) ), ##################################################### # # _ _ _ _ # | | | | | | | | # ___ ___ __ _| |_| |_ ___ _ __ _ __ | | ___ | |_ # / __|/ __/ _` | __| __/ _ \ '__| '_ \| |/ _ \| __| # \__ \ (_| (_| | |_| || __/ | | |_) | | (_) | |_ # |___/\___\__,_|\__|\__\___|_| | .__/|_|\___/ \__| # | | # |_| # # scatterplot # #################################################### tm_g_scatterplot( label = "Scatterplot", x = data_extract_spec( dataname = "ADSL", select = select_spec(choices = variable_choices(data[["ADSL"]], c("AGE", "BMRKR1", "BMRKR2"))) ), y = data_extract_spec( dataname = "ADSL", select = select_spec( choices = variable_choices(data[["ADSL"]], c("AGE", "BMRKR1", "BMRKR2")), selected = "BMRKR1" ) ), color_by = data_extract_spec( dataname = "ADSL", select = select_spec( choices = variable_choices(data[["ADSL"]], c("AGE", "BMRKR1", "BMRKR2", "RACE", "REGION1")), selected = NULL ) ), size_by = data_extract_spec( dataname = "ADSL", select = select_spec(choices = variable_choices(data[["ADSL"]], c("AGE", "BMRKR1"))) ), row_facet = data_extract_spec( dataname = "ADSL", select = select_spec( choices = variable_choices(data[["ADSL"]], c("BMRKR2", "RACE", "REGION1")), selected = NULL ) ), col_facet = data_extract_spec( dataname = "ADSL", select = select_spec( choices = variable_choices(data[["ADSL"]], c("BMRKR2", "RACE", "REGION1")), selected = NULL ) ), decorators = list(caption_decorator("I am a scatterplot", "plot")) ), # ############################################################## # # _ _ _ _ # (_) (_) | | | | # _ __ ___ _ ___ ___ _ _ __ __ _ __| | __ _| |_ __ _ # | '_ ` _ \| / __/ __| | '_ \ / _` | / _` |/ _` | __/ _` | # | | | | | | \__ \__ \ | | | | (_| | | (_| | (_| | || (_| | # |_| |_| |_|_|___/___/_|_| |_|\__, | \__,_|\__,_|\__\__,_| # __/ |_____ # |___/______| # # missing_data # ############################################################# tm_missing_data( label = "Missing data", decorators = list( summary_plot = plot_grob_decorator("A", "summary_plot"), combination_plot = plot_grob_decorator("B", "combination_plot"), summary_table = table_decorator("table", .color1 = "#f0000055"), by_subject_plot = caption_decorator("by_subject_plot") ) ), example_module(decorators = list(head_decorator(6))) ) ) |> shiny::runApp() ``` </details> --------- Signed-off-by: André Veríssimo <211358+averissimo@users.noreply.github.com> Co-authored-by: Marcin <133694481+m7pr@users.noreply.github.com>

R/tm_a_pca.R

R/roxygen2_templates.R

R/tm_g_distribution.R

Co-authored-by: Marcin <133694481+m7pr@users.noreply.github.com> Signed-off-by: André Veríssimo <211358+averissimo@users.noreply.github.com>

R/tm_g_distribution.R

R/tm_outliers.R

m7pr · 2024-11-29T12:10:37Z

There is a common error for some modules, that get muuuuch time to load to display such a warning

Listening on http://127.0.0.1:3599
Warning: Error in if: argument is of length zero
  120: getDims
  119: catch
  118: value[[3L]]
  117: tryCatchOne
  116: tryCatchList
  115: tryCatch
  114: do
  113: hybrid_chain
  112: <reactive:plotObj>
   96: drawReactive
   83: renderFunc
   82: output$teal-teal_modules-regression-module-myplot-plot_main
    1: shiny::runApp

but then they load and evertyhing works. I'm not sure it's related to this feature. Rather to the apps with mulitiple modules, that are slow

R/tm_a_pca.R

m7pr · 2024-11-29T12:27:26Z

Hey @averissimo I can not accept as I am the one who raised this PR.
This is great job. I would say we can accept. I did review the app, based on the example code that you provided.
There are no major issues. The functionality works as intended.

Great work!

closes #1383 #1384 Companion PRs: - insightsengineering/teal.modules.general#795 <details> <summary>example tmg app</summary> ```r pkgload::load_all("teal") pkgload::load_all("teal.modules.general") library(teal.widgets) data <- teal_data() data <- within(data, { require(nestcolor) ADSL <- rADSL }) join_keys(data) <- default_cdisc_join_keys[c("ADSL")] footnote_regression <- teal_transform_module( server = make_teal_transform_server(expression( plot <- plot + labs(caption = deparse(summary(fit)[[1]])) )) ) fact_vars_adsl <- names(Filter(isTRUE, sapply(data[["ADSL"]], is.factor))) vars <- choices_selected(variable_choices(data[["ADSL"]], fact_vars_adsl)) app <- init( data = data, modules = modules( tm_a_regression( label = "Regression", response = data_extract_spec( dataname = "ADSL", select = select_spec( label = "Select variable:", choices = "BMRKR1", selected = "BMRKR1", multiple = FALSE, fixed = TRUE ) ), regressor = data_extract_spec( dataname = "ADSL", select = select_spec( label = "Select variables:", choices = variable_choices(data[["ADSL"]], c("AGE", "SEX", "RACE")), selected = "AGE", multiple = TRUE, fixed = FALSE ) ), ggplot2_args = ggplot2_args( labs = list(subtitle = "Plot generated by Regression Module") ), decorators = list(footnote_regression) ) ) ) shinyApp(app$ui, app$server) ``` </details> --------- Signed-off-by: Marcin <133694481+m7pr@users.noreply.github.com> Signed-off-by: André Veríssimo <211358+averissimo@users.noreply.github.com> Co-authored-by: 27856297+dependabot-preview[bot]@users.noreply.github.com <27856297+dependabot-preview[bot]@users.noreply.github.com> Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Co-authored-by: Marcin <133694481+m7pr@users.noreply.github.com> Co-authored-by: Konrad Pagacz <konrad.pagacz@contractors.roche.com> Co-authored-by: m7pr <marcin.kosinski.mk1@roche.com> Co-authored-by: Pawel Rucki <12943682+pawelru@users.noreply.github.com> Co-authored-by: André Veríssimo <211358+averissimo@users.noreply.github.com> Co-authored-by: Lluís Revilla <185338939+llrs-roche@users.noreply.github.com>

gogonzo and others added 10 commits October 1, 2024 10:27

WIP

661585d

reorg regression for decoration

de6f56c

feat: refactored outliers to allow for decorators (#788)

f014f3e

regression with validate

6bb26f5

elo

d045e7b

fixes

95e0fbf

conditionalPanel for regression

bf87833

fix after teal

7c4996c

fix error

8e8457d

Merge branch 'main' into 1187_decorate_output@main

40f053a

m7pr added the core label Nov 12, 2024

m7pr commented Nov 18, 2024

View reviewed changes

R/tm_outliers.R Outdated Show resolved Hide resolved

averissimo mentioned this pull request Nov 18, 2024

Adds decorate functionality to module output insightsengineering/teal#1357

Merged

m7pr mentioned this pull request Nov 18, 2024

Add decorators to all TMG modules insightsengineering/teal#1370

Closed

15 tasks

update tm_a_regression and tm_outliers after changes in teal for the …

b6d9bff

…decorators

averissimo reviewed Nov 18, 2024

View reviewed changes

R/tm_a_regression.R Outdated Show resolved Hide resolved

averissimo reviewed Nov 18, 2024

View reviewed changes

R/tm_a_regression.R Outdated Show resolved Hide resolved

m7pr commented Nov 18, 2024

View reviewed changes

R/tm_outliers.R Outdated Show resolved Hide resolved

m7pr and others added 2 commits November 18, 2024 15:36

Update R/tm_outliers.R

5196b7f

Signed-off-by: Marcin <133694481+m7pr@users.noreply.github.com>

unify decorators usage with outliers

f28d40d

m7pr commented Nov 18, 2024

View reviewed changes

R/tm_outliers.R Outdated Show resolved Hide resolved

m7pr commented Nov 18, 2024

View reviewed changes

R/tm_outliers.R Outdated Show resolved Hide resolved

m7pr commented Nov 18, 2024

View reviewed changes

R/tm_outliers.R Outdated Show resolved Hide resolved

m7pr and others added 2 commits November 18, 2024 16:07

Apply suggestions from code review

bf0af48

Signed-off-by: Marcin <133694481+m7pr@users.noreply.github.com>

add req statements to get_code

d52361b

m7pr commented Nov 19, 2024

View reviewed changes

R/tm_a_regression.R Outdated Show resolved Hide resolved

remove examples and link to the vignette

a3d3de8

m7pr changed the title ~~WIP for decorators feature~~ Decorators feature Nov 19, 2024

m7pr marked this pull request as ready for review November 19, 2024 11:08

averissimo and others added 2 commits November 28, 2024 14:43

[skip roxygen] [skip vbump] Roxygen Man Pages Auto Update

6908d9c

averissimo reviewed Nov 28, 2024

View reviewed changes

R/tm_a_pca.R Show resolved Hide resolved

averissimo reviewed Nov 28, 2024

View reviewed changes

R/roxygen2_templates.R Show resolved Hide resolved

m7pr commented Nov 28, 2024

View reviewed changes

R/tm_g_distribution.R Outdated Show resolved Hide resolved

averissimo and others added 14 commits November 28, 2024 16:45

Update R/tm_g_distribution.R

39437e7

Co-authored-by: Marcin <133694481+m7pr@users.noreply.github.com> Signed-off-by: André Veríssimo <211358+averissimo@users.noreply.github.com>

fix: linter error with long line

2478c93

docs: regenerate man pages

94cc740

[skip roxygen] [skip vbump] Roxygen Man Pages Auto Update

0357e15

fix: 3 out 4 e2e tests

0b2967e

fix: value was 2 not 1 in main

040b311

docs: update missing @param

4e0d82e

docs: typo

737fe42

fix: R CMD check errors and adds lifecycle to dependencies

f5a741a

[skip roxygen] [skip vbump] Roxygen Man Pages Auto Update

db6793f

fix: wrong function was being called

0048a41

feat: build output objects separately

630ee6a

[skip roxygen] [skip vbump] Roxygen Man Pages Auto Update

097326e

fix: minor bug

1af3642

averissimo reviewed Nov 29, 2024

View reviewed changes

R/tm_g_distribution.R Show resolved Hide resolved

m7pr mentioned this pull request Nov 29, 2024

introduce decorators for tm_g_barchart_simple insightsengineering/teal.modules.clinical#1267

Merged

6 tasks

m7pr commented Nov 29, 2024

View reviewed changes

R/tm_outliers.R Show resolved Hide resolved

m7pr commented Nov 29, 2024

View reviewed changes

R/tm_a_pca.R Show resolved Hide resolved

averissimo approved these changes Nov 29, 2024

View reviewed changes

averissimo merged commit 02f18ab into main Nov 29, 2024
29 checks passed

averissimo deleted the 1187_decorate_output@main branch November 29, 2024 16:55

github-actions bot locked and limited conversation to collaborators Nov 29, 2024

Provide feedback

Saved searches

Use saved searches to filter your results more quickly

🗃️ `decorators` feature branch #795

🗃️ `decorators` feature branch #795

m7pr commented Nov 12, 2024 •

edited

Loading

m7pr commented Nov 19, 2024

m7pr commented Nov 29, 2024

m7pr commented Nov 29, 2024

🗃️ decorators feature branch #795

🗃️ decorators feature branch #795

Conversation

m7pr commented Nov 12, 2024 • edited Loading

m7pr commented Nov 19, 2024

m7pr commented Nov 29, 2024

m7pr commented Nov 29, 2024

🗃️ `decorators` feature branch #795

🗃️ `decorators` feature branch #795

m7pr commented Nov 12, 2024 •

edited

Loading