1441 Introduce transformators parameter in modules

[m7pr]

insightsengineering/teal#1441

Included transformators parameter in modules. This is passed to teal::module that does assertions and checks on this parameter.

Did not introduce for tm_data_table, tm_file_viewer and tm_front_page as we also didn't introduce decorators for those modules. We can always introduce, if there is a user request, but I don't think there will ever be.

Lastly, a food for thought: default decorators value is NULL where default transformators value is list(). Maybe we can introduce a check, that allows transformators to be NULL on default, and which changes NULL to list().

[github-actions]

Unit Tests Summary

  1 files   22 suites   12m 57s ⏱️
145 tests 107 ✅ 38 💤 0 ❌
476 runs  438 ✅ 38 💤 0 ❌

Results for commit fff168d.

♻️ This comment has been updated with latest results.

[github-actions]

Unit Test Performance Difference

Test Suite	$Status$	Time on main	$±Time$	$±Tests$	$±Skipped$	$±Failures$	$±Errors$
shinytest2-tm_outliers	💔	$110.02$	$+1.09$	$0$	$0$	$0$	$0$

Results for commit 878c541

♻️ This comment has been updated with latest results.

[llrs-roche]

There are 15 modules:

ls -1 *.R | grep "tm_*"
tm_a_pca.Ro
tm_a_regression.R
tm_data_table.R
tm_file_viewer.R
tm_front_page.R
tm_g_association.R
tm_g_bivariate.R
tm_g_distribution.R
tm_g_response.R
tm_g_scatterplot.R
tm_g_scatterplotmatrix.R
tm_missing_data.R
tm_outliers.R
tm_t_crosstable.R
tm_variable_browser.R

Minus the three mentioned as not implemented: tm_data_table, tm_file_viewer and tm_front_page, this leaves tm_variable_browser as not implemented and not commented on. But as it doesn't have decorators I guess it falls on the same list.

About the difference between the defaults on transformators and decorators, I think it makes sense to have the same default. The suggested idea could work well with minimal changes.

[m7pr]

About the difference between the defaults on transformators and decorators, I think it makes sense to have the same default. The suggested idea could work well with minimal changes.

@llrs-roche I was thinking about changing defaults for decorators parameter to list() hence we now have transformators = list(). Previously we specified decorators = NULL to be default, because all other parameters are NULL when they are empty. However with the addition of transformators, we can now have two parameters to be set to list() by default.

What are your thoughts on this @gogonzo ? Should we unify decorators and transformators default values? First is now set to NULL and the other to list() by default.

[llrs-roche]

My 2 cents: On one hand I like that these two arguments doing similar things have similar arguments default that differentiate from the others. On the other hand I would prefer to have NULL as default, but list seems like a good indicator that more than one can be provided 👍

[gogonzo]

About the difference between the defaults on transformators and decorators, I think it makes sense to have the same default. The suggested idea could work well with minimal changes.

@llrs-roche I was thinking about changing defaults for decorators parameter to list() hence we now have transformators = list(). Previously we specified decorators = NULL to be default, because all other parameters are NULL when they are empty. However with the addition of transformators, we can now have two parameters to be set to list() by default.

What are your thoughts on this @gogonzo ? Should we unify decorators and transformators default values? First is now set to NULL and the other to list() by default.

transformators has to be a list otherwise teal will fail. decorators are inheriting from the transformer so I don't see any reason why their defaults differ. NULL possible only when you make a change in teal to accept transformers as NULL.

[m7pr]

Thanks for backing up the discussion. I'll proceed with changing decorators defaults to list()

[gogonzo]

I'm not sure if else { decorators } make sense. When decorators is not a list of teal_transform_module objects? Don't get this function.

[m7pr]

I think it supposed to be

normalize_decorators <- function(decorators) {
  if (checkmate::test_names(names(decorators))) {
    lapply(decorators, list)
  } else {
    list(default = decorators)
  }
}

So if the decorators list is named, it turns it into a named list per name, and if it's not named they it sets a name to default. So that decorators can be trimmed just to specific objects.

[m7pr]

With the simplified version it should be working. I testes on examples posted in this comment #826 (comment)

[gogonzo]

I think your commit have broken the modules. I think I understand now. Unlike transformators decorators suppose to be a list of lists of teal_transform_modules. Decorators are named after identifier of the output (like plot, table, etc.) . There are several scenarios for a module which has two outputs plot1 and plot2.

• app developer specified tm_two_plots(decorators = decorator_footer()). This is translated into list(default = decorator_footer())
• app developer specified tm_two_plots(decorators = list(plot1 = list(decorator_footer())). This should be kept as is (if the names are matching output identifiers)

[m7pr]

Oh yes, I did broke the scenario for 2 objects being decorated with 2 different deocrators

Code

footnote_dec <- teal_transform_module(
  label = "Footnote",
  ui = function(id) shiny::textInput(shiny::NS(id, "footnote"), "Footnote", value = "I am a good decorator"),
  server = function(id, data) {
    moduleServer(id, function(input, output, session) {
      logger::log_info("🟢 Footnote called to action!", namespace = "teal.modules.general")
      reactive(
        within(
          data(),
          {
            footnote_str <- footnote
            plot <- plot + ggplot2::labs(caption = footnote_str)
          },
          footnote = input$footnote
        )
      )
    })
  }
)

table_dup_dec <- teal_transform_module(
  server = make_teal_transform_server(
    expression(
      logger::log_info("🔴 Table dup being called to action!", namespace = "teal.modules.general"),
      summary_table <- rbind(summary_table, summary_table),
      if (exists("test_table")) test_table <- rbind(test_table, test_table, test_table) 
    )
  )
)

# CDISC data example
data <- teal_data()
data <- within(data, {
  ADSL <- rADSL
})
join_keys(data) <- default_cdisc_join_keys[names(data)]

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

app <- init(
  data = data,
  modules = modules(
    tm_g_distribution(
      decorators = list(histogram_plot  = list(footnote_dec), summary_table = list(table_dup_dec)),
      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
        )
      )
    )
  )
)
if (interactive()) {
  shinyApp(app$ui, app$server)
}

[m7pr]

I guess we could add one script with a couple of shinytest2 tests that test decorators

[m7pr]

reverted changes on normalize_decorators 582a8a3

[m7pr]

Example with no decorators and no transformators

# general data example
data <- teal_data()
data <- within(data, {
  require(nestcolor)
  USArrests <- USArrests
})

app <- init(
  data = data,
  modules = modules(
    tm_a_pca(
      "PCA",
      dat = data_extract_spec(
        dataname = "USArrests",
        select = select_spec(
          choices = variable_choices(
            data = data[["USArrests"]], c("Murder", "Assault", "UrbanPop", "Rape")
          ),
          selected = c("Murder", "Assault"),
          multiple = TRUE
        ),
        filter = NULL
      )
    )
  )
)
if (interactive()) {
  shinyApp(app$ui, app$server)
}

Example with decorators and no transformators

footnote_dec <- teal_transform_module(
  label = "Footnote",
  ui = function(id) shiny::textInput(shiny::NS(id, "footnote"), "Footnote", value = "I am a good decorator"),
  server = function(id, data) {
    moduleServer(id, function(input, output, session) {
      logger::log_info("🟢 Footnote called to action!", namespace = "teal.modules.general")
      reactive(
        within(
          data(),
          {
            footnote_str <- footnote
            plot <- plot + ggplot2::labs(caption = footnote_str)
          },
          footnote = input$footnote
        )
      )
    })
  }
)


title_plot <- teal_transform_module(
  server = make_teal_transform_server(
    expression(
      logger::log_info("🔴 Title being called to action!", namespace = "teal.modules.general"),
      plot <- plot + ggplot2::ggtitle("A title to the plot")
    )
  )
)

# CDISC data example
data <- teal_data()
data <- within(data, {
  require(nestcolor)
  ADSL <- rADSL
})
join_keys(data) <- default_cdisc_join_keys[names(data)]

app <- init(
  data = data,
  modules = modules(
    tm_g_response(
      label = "Response Plots",
      decorators = list(footnote_dec, title_plot),
      response = data_extract_spec(
        dataname = "ADSL",
        select = select_spec(
          label = "Select variable:",
          choices = variable_choices(data[["ADSL"]], c("BMRKR2", "COUNTRY")),
          selected = "BMRKR2",
          multiple = FALSE,
          fixed = FALSE
        )
      ),
      x = data_extract_spec(
        dataname = "ADSL",
        select = select_spec(
          label = "Select variable:",
          choices = variable_choices(data[["ADSL"]], c("SEX", "RACE")),
          selected = "RACE",
          multiple = FALSE,
          fixed = FALSE
        )
      )
    )
  )
)
if (interactive()) {
  shinyApp(app$ui, app$server)
}

Example with no decorators and with transformators

# general data example
data <- teal_data()
data <- within(data, {
  require(nestcolor)
  CO2 <- data.frame(CO2)
})

head_transformator <- 
  teal_transform_module(
    label = "Custom transformator for CO2",
    ui = function(id) {
      ns <- NS(id)
      tags$div(
        numericInput(ns("n_rows"), "Number of rows to subset", value = 6, min = 1, max = 150, step = 1)
      )
    },
    server = function(id, data) {
      moduleServer(id, function(input, output, session) {
        reactive({
          within(data(),
                 {
                   CO2 <- head(CO2, num_rows)
                 },
                 num_rows = input$n_rows
          )
        })
      })
    }
  )

app <- init(
  data = data,
  modules = tm_g_bivariate(
    transformators = list(head_transformator),
    x = data_extract_spec(
      dataname = "CO2",
      select = select_spec(
        label = "Select variable:",
        choices = variable_choices(data[["CO2"]]),
        selected = "conc",
        fixed = FALSE
      )
    ),
    y = data_extract_spec(
      dataname = "CO2",
      select = select_spec(
        label = "Select variable:",
        choices = variable_choices(data[["CO2"]]),
        selected = "uptake",
        multiple = FALSE,
        fixed = FALSE
      )
    ),
    row_facet = data_extract_spec(
      dataname = "CO2",
      select = select_spec(
        label = "Select variable:",
        choices = variable_choices(data[["CO2"]]),
        selected = "Type",
        fixed = FALSE
      )
    ),
    col_facet = data_extract_spec(
      dataname = "CO2",
      select = select_spec(
        label = "Select variable:",
        choices = variable_choices(data[["CO2"]]),
        selected = "Treatment",
        fixed = FALSE
      )
    )
  )
)
if (interactive()) {
  shinyApp(app$ui, app$server)
}

Example with with decorators and with transformators

head_transformator <- 
  teal_transform_module(
    label = "Custom transformator for CO2",
    ui = function(id) {
      ns <- NS(id)
      tags$div(
        numericInput(ns("n_rows"), "Number of rows to subset", value = 6, min = 1, max = 150, step = 1)
      )
    },
    server = function(id, data) {
      moduleServer(id, function(input, output, session) {
        reactive({
          within(data(),
                 {
                   CO2 <- head(CO2, num_rows)
                 },
                 num_rows = input$n_rows
          )
        })
      })
    }
  )


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

# general data example
data <- teal_data()
data <- within(data, {
  require(nestcolor)
  CO2 <- CO2
  factors <- names(Filter(isTRUE, vapply(CO2, is.factor, logical(1L))))
  CO2[factors] <- lapply(CO2[factors], as.character)
})

app <- init(
  data = data,
  modules = modules(
    tm_g_association(
      ref = data_extract_spec(
        dataname = "CO2",
        select = select_spec(
          label = "Select variable:",
          choices = variable_choices(data[["CO2"]], c("Plant", "Type", "Treatment")),
          selected = "Plant",
          fixed = FALSE
        )
      ),
      vars = data_extract_spec(
        dataname = "CO2",
        select = select_spec(
          label = "Select variables:",
          choices = variable_choices(data[["CO2"]], c("Plant", "Type", "Treatment")),
          selected = "Treatment",
          multiple = TRUE,
          fixed = FALSE
        )
      ),
      transformators = list(head_transformator),
      decorators = list(plot_grob_decorator("I am a good grob (association)"))
    )
  )
)
if (interactive()) {
  shinyApp(app$ui, app$server)
}

Example with with decorators and with transformators AND DECORATORS IS NAMED

head_transformator <- 
  teal_transform_module(
    label = "Custom transformator for CO2",
    ui = function(id) {
      ns <- NS(id)
      tags$div(
        numericInput(ns("n_rows"), "Number of rows to subset", value = 6, min = 1, max = 150, step = 1)
      )
    },
    server = function(id, data) {
      moduleServer(id, function(input, output, session) {
        reactive({
          within(data(),
                 {
                   CO2 <- head(CO2, num_rows)
                 },
                 num_rows = input$n_rows
          )
        })
      })
    }
  )


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

# general data example
data <- teal_data()
data <- within(data, {
  require(nestcolor)
  CO2 <- CO2
  factors <- names(Filter(isTRUE, vapply(CO2, is.factor, logical(1L))))
  CO2[factors] <- lapply(CO2[factors], as.character)
})

app <- init(
  data = data,
  modules = modules(
    tm_g_association(
      ref = data_extract_spec(
        dataname = "CO2",
        select = select_spec(
          label = "Select variable:",
          choices = variable_choices(data[["CO2"]], c("Plant", "Type", "Treatment")),
          selected = "Plant",
          fixed = FALSE
        )
      ),
      vars = data_extract_spec(
        dataname = "CO2",
        select = select_spec(
          label = "Select variables:",
          choices = variable_choices(data[["CO2"]], c("Plant", "Type", "Treatment")),
          selected = "Treatment",
          multiple = TRUE,
          fixed = FALSE
        )
      ),
      transformators = list(head_transformator),
      decorators = list(plot = plot_grob_decorator("I am a good grob (association)"))
    )
  )
)
if (interactive()) {
  shinyApp(app$ui, app$server)
}

[m7pr]

@llrs-roche would you mind revisiting PR?

[llrs-roche]

All the other changes since my previous feedback look good. I left a minor comment to help users.

Not sure of the implications of the changes on normalize_decorators but I didn't notice any problem with the changes.

I tested adding two decorators with the same name (to see what would happen):

decorators = list(plot = plot_grob_decorator("I am a good grob (association)"),
                        plot= plot_grob_decorator("I am a good grob 2 (association)"))

The module uses only the first (and doesn't warn about removing the second). I don't think this was covered initially, but maybe it is a good time to consider/add it?

[m7pr]

I tested adding two decorators with the same name (to see what would happen):

That's funny : ) I think there is a way to extend assert_decorators to handle that