Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

🗃️ decorators feature branch #795

Merged
merged 68 commits into from
Nov 29, 2024
Merged

Conversation

m7pr
Copy link
Contributor

@m7pr m7pr commented Nov 12, 2024

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

@m7pr m7pr added the core label Nov 12, 2024
R/tm_outliers.R Outdated Show resolved Hide resolved
R/tm_a_regression.R Outdated Show resolved Hide resolved
R/tm_a_regression.R Outdated Show resolved Hide resolved
R/tm_outliers.R Outdated Show resolved Hide resolved
R/tm_outliers.R Outdated Show resolved Hide resolved
R/tm_outliers.R Outdated Show resolved Hide resolved
R/tm_outliers.R Outdated Show resolved Hide resolved
R/tm_a_regression.R Outdated Show resolved Hide resolved
@m7pr m7pr changed the title WIP for decorators feature Decorators feature Nov 19, 2024
@m7pr m7pr marked this pull request as ready for review November 19, 2024 11:08
@m7pr
Copy link
Contributor Author

m7pr commented Nov 19, 2024

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

averissimo and others added 2 commits November 28, 2024 14:43
#### 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 <[email protected]>
Co-authored-by: Marcin <[email protected]>
R/tm_g_distribution.R Outdated Show resolved Hide resolved
R/tm_outliers.R Show resolved Hide resolved
@m7pr
Copy link
Contributor Author

m7pr commented Nov 29, 2024

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 Show resolved Hide resolved
@m7pr
Copy link
Contributor Author

m7pr commented Nov 29, 2024

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!

averissimo added a commit to insightsengineering/teal that referenced this pull request Nov 29, 2024
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 <[email protected]>
Signed-off-by: André Veríssimo <[email protected]>
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 <[email protected]>
Co-authored-by: Konrad Pagacz <[email protected]>
Co-authored-by: m7pr <[email protected]>
Co-authored-by: Pawel Rucki <[email protected]>
Co-authored-by: André Veríssimo <[email protected]>
Co-authored-by: Lluís Revilla <[email protected]>
@averissimo averissimo merged commit 02f18ab into main Nov 29, 2024
29 checks passed
@averissimo averissimo deleted the 1187_decorate_output@main branch November 29, 2024 16:55
@github-actions github-actions bot locked and limited conversation to collaborators Nov 29, 2024
Sign up for free to subscribe to this conversation on GitHub. Already have an account? Sign in.
Labels
Projects
None yet
Development

Successfully merging this pull request may close these issues.

4 participants