Updates "Decorators" to use name-based execution and new wrappers #812

averissimo · 2024-11-26T14:42:43Z

Modules

1 object

2 objects

3 objects

tm_g_distribution
tm_outliers

4 objects

tm_missing_data

Not applicable

~~tm_file_viewer~~
~~tm_front_page~~
~~tm_variable_browser~~

Changes description

Allow named-based decorators
Use ui_decorate_teal_data and srv_decorate_teal_data wrapper to simplify code
New function to normalize decorators argument in module See this comment

App with all modules (WIP)

Working example

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()

R/tm_g_scatterplotmatrix.R

R/tm_a_pca.R

m7pr · 2024-11-26T22:08:00Z

Hey @averissimo this is sooooooooooooo excellent and fantastic work! Keep it up! It was a pleasure to review and check changes.

chapeau bas!

When reviewing I tried to apply changes to tmc modules. I am having issues with make_teal_transform_server and it's UI part. Check out tm_t_ancova example in here insightsengineering/teal.modules.clinical#1256
Decorator produces NULL output (hence there was an error), when I pass ui new_row variable and then us this in the server side. When I pass a regular string (not an shiny input) then this gets applied to the module.

…corator argument

R/tm_g_distribution.R

R/utils.R

…ble output

…fault

averissimo · 2024-11-27T18:32:01Z

R/roxygen2_templates.R

@@ -0,0 +1,30 @@
+# nocov start


See https://roxygen2.r-lib.org/articles/reuse.html?q=template#superseded

man-roxygen folder is a very old way of placing the template, if we want to keep using templates we should move to man/roxygen folder

@averissimo should we create a separate issue?

For other repos yes, although it's a low priority until it's really deprecated (not only twice superseded)

But still a priority IMO, as it's VERY weird to have man-roxygen folder on the root folder

For this one, depends on this PR and how we deal with @param decorators if we keep as is, the change can tag along.

R/tm_a_pca.R

m7pr · 2024-11-27T20:40:26Z

R/tm_a_pca.R

+#' @param ggplot2_args `r roxygen_ggplot2_args_param("Elbow plot", "Circle plot", "Biplot", "Eigenvector plot")`
+#' @param decorators `r roxygen_decorators_param("tm_a_pca")`


What is this sorcery : p?

It's the recommended way for dealing with roxygen2 tags.

It's all about having the tm_<module_name> as seen in image below.

It's nice to have, but I'm more than happy to revert this and keep it simple as it was (ggplot2_args back to template and shared @param decorators with "See "Decorating tm_<module_name> below" or an equivalent generic text

R/tm_a_pca.R

R/tm_data_table.R

R/tm_g_association.R

R/tm_g_bivariate.R

R/tm_g_distribution.R

R/tm_missing_data.R

R/utils.R

m7pr · 2024-11-27T21:19:15Z

R/utils.R

-#' @param decorators `r lifecycle::badge("experimental")` (`list` of `teal_transform_module` or `NULL`) optional,
-#' if not `NULL`, decorator for tables or plots included in the module.


Why this is removed? This was needed so that in each module we added decorators parameter automatically to the documentation.

It's added per module. this comment is a byproduct of this.

Which allows to have the module name specific text. It's a small issue, but it seems odd to have See tm_<module_name> in the documentation for the function.

This is a minor thing that we can remove and go back to a shared parameter.

For instance in the tm_missing_data.

+#' @param decorators `r roxygen_decorators_param("tm_missing_data")`

m7pr

Hey this is an amazing work! Well done my man.

I left a couple of questions that are really minor.

Let's get this merged, and let's start manually testing on the feature branch

Co-authored-by: Marcin <[email protected]> Signed-off-by: André Veríssimo <[email protected]>

@m7pr

suggestion by @m7pr

…de and nolint

averissimo · 2024-11-28T13:43:46Z

@m7pr The open comments are related to the same. I'm merging this PR and moving that conversation to the other PR so it doesn't block review

feat: tm_g_scatterplot

fb08fbf

averissimo added the core label Nov 26, 2024

averissimo changed the title ~~feat: tm_g_scatterplot~~ Updates "Decorators" to use name-based execution and new wrappers Nov 26, 2024

averissimo added 6 commits November 26, 2024 14:52

feat: tm_a_pca

82aeea5

feat: allow expression to be output of reactive

6561d03

fix: corrects assertion

0b3b10b

feat: tm_g_bivariate

8e262c3

feat: tm_g_response

929f45f

feat: tm_g_scatterplotmatrix

ff7d3c2

m7pr reviewed Nov 26, 2024

View reviewed changes

R/tm_g_scatterplotmatrix.R Outdated Show resolved Hide resolved

m7pr reviewed Nov 26, 2024

View reviewed changes

R/tm_g_scatterplotmatrix.R Show resolved Hide resolved

m7pr reviewed Nov 26, 2024

View reviewed changes

R/tm_a_pca.R Outdated Show resolved Hide resolved

averissimo added 2 commits November 26, 2024 15:50

feat: tm_g_crosstable

7a96181

feat: tm_data_table

e7cb0f1

m7pr reviewed Nov 26, 2024

View reviewed changes

R/tm_a_pca.R Outdated Show resolved Hide resolved

averissimo added 4 commits November 27, 2024 10:44

fix: when only 1 ui_decorate, default is the only accepted name in de…

b29e8d1

…corator argument

feat: tm_g_association

72b5d05

feat: tm_g_association

7b8b8c0

docs: first try at changing documentation for decorators arg

ea3f729

averissimo commented Nov 27, 2024

View reviewed changes

R/tm_g_distribution.R Show resolved Hide resolved

R/utils.R Outdated Show resolved Hide resolved

averissimo added 6 commits November 27, 2024 11:46

docs: typo with extra backtick

6d5dea3

feat: tm_outliers

668af66

feat: unifying documentation

ea8d583

feat: use common function to normalize decorators

2f9f79b

docs: update docs on other complex modules with more than 1 decoratea…

bb52cf6

…ble output

fix: use plot/table with only 1 output, instead of only relying on de…

943c260

…fault

averissimo commented Nov 27, 2024

View reviewed changes

averissimo added 2 commits November 27, 2024 19:32

docs: generate man page

039c37a

feat: tm_a_pca plot object split in 4

337c2af

averissimo marked this pull request as ready for review November 27, 2024 19:34

averissimo added 2 commits November 27, 2024 20:02

chore: fix linter errors

f9c1d7b

feat: tm_g_distribution

9ec4381