Duplicated decorators during an edge case of named and unnamed decorators

[m7pr]

Companion to insightsengineering/teal.modules.clinical#1325

[llrs-roche]

I can also reproduce the CI checks failures about the vignettes.
Check the linter message and Dawid comment.

[m7pr]

Alrighty, for now I allowed only to pass either all named, or all unnamed decorators

Code

pkgload::load_all(".")
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)
})

static_decorator <- teal_transform_module(
  label = "Static decorator",
  server = function(id, data) {
    moduleServer(id, function(input, output, session) {
      reactive({
        req(data())
        within(data(), {
          plot <- plot +
            ggplot2::ggtitle("This is title") +
            ggplot2::xlab("x axis")
        })
      })
    })
  }
)

interactive_decorator <- teal_transform_module(
  label = "Interactive decorator",
  ui = function(id) {
    ns <- NS(id)
    div(
      textInput(ns("x_axis_title"), "X axis title", value = "x axis")
    )
  },
  server = function(id, data) {
    moduleServer(id, function(input, output, session) {
      reactive({
        req(data())
        within(data(),
               {
                 plot <- plot +
                   ggplot2::ggtitle("This is title") +
                   ggplot2::xlab(my_title)
               },
               my_title = input$x_axis_title
        )
      })
    })
  }
)

app <- init(
  data = data,
  modules = tm_g_bivariate(
    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
      )
    ),
    # decorators = list() # SHOULD BE OK
    # decorators = list(plot = static_decorator, default = interactive_decorator) # SHOULD BE OK
    # decorators = list(static_decorator, interactive_decorator) # SHOULD BE OK
    # decorators = list(plot = static_decorator, interactive_decorator) # SHOULD THROWN AN ERROR
  )
)

shinyApp(app$ui, app$server)

[github-actions]

Unit Tests Summary

  1 files   22 suites   13m 2s ⏱️
145 tests 107 ✅ 38 💤 0 ❌
475 runs  437 ✅ 38 💤 0 ❌

Results for commit 67d76ed.

♻️ 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$
examples	💚	$5.24$	$-4.66$	$-1$	$+38$	$0$	$0$
shinytest2-tm_a_pca	💚	$118.90$	$-2.24$	$0$	$0$	$0$	$0$
shinytest2-tm_a_regression	💚	$53.87$	$-1.49$	$0$	$0$	$0$	$0$
shinytest2-tm_front_page	💚	$21.70$	$-1.15$	$0$	$0$	$0$	$0$
shinytest2-tm_g_association	💚	$33.18$	$-1.88$	$0$	$0$	$0$	$0$
shinytest2-tm_g_bivariate	💚	$75.94$	$-1.78$	$0$	$0$	$0$	$0$
shinytest2-tm_outliers	💚	$112.28$	$-1.12$	$0$	$0$	$0$	$0$

Additional test case details

Test Suite	$Status$	Time on main	$±Time$	Test Case
examples	💚	$1.71$	$-1.63$	example_add_facet_labels.Rd

Results for commit 8bf03fb

♻️ This comment has been updated with latest results.

[llrs-roche]

I like the decision to only allow named or unnamed decorators.

• decorators = list()

  No problem ✅

• decorators = list(plot = static_decorator, default = interactive_decorator)

  I don't see the default interactive decorator having any effect. This makes sense but there is no message that the named one will be used instead. This confused me initially. Could you add a message/warning so that users know what is happening on that case? Or alternative patch the documentation?

⁉️

• decorators = list(static_decorator, interactive_decorator)
  The interactive decorator worked well, but again no notification of what happened with the static_decorator. I would prefer to have some documentation or a clear message of what is happening here. ⁉️

• decorators = list(plot = static_decorator, interactive_decorator)
  Throws an error (not a warning) ✅

• decorators = list(plot = static_decorator, plot = interactive_decorator)
  This example also throws the same error "All decorators should either be named or unnamed" but here the duplicated decorator are named so the message is not informative. Could the users get a more informative message? ❌

[m7pr]

@llrs-roche funny things.

I don't see the default interactive decorator having any effect. This makes sense but there is no message that the named one will be used instead. This confused me initially. Could you add a message/warning so that users know what is happening on that case? Or alternative patch the documentation?

Both of them are used, but both of them edit the same thing.

static_decorator is applied after interactive_decorator
they both edit ggplot2::xlab("x axis").

interactive_decorator uses input to edit xlab but then static_decorator overwrites with ggplot2::xlab("x axis").

If you remove ggplot2::xlab("x axis") from static_decorator, you can see that changes from interactive_decorator are actually visible:

Code

pkgload::load_all(".")
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)
})

static_decorator <- teal_transform_module(
  label = "Static decorator",
  server = function(id, data) {
    moduleServer(id, function(input, output, session) {
      reactive({
        req(data())
        within(data(), {
          plot <- plot +
            ggplot2::ggtitle("This is title")
        })
      })
    })
  }
)

interactive_decorator <- teal_transform_module(
  label = "Interactive decorator",
  ui = function(id) {
    ns <- NS(id)
    div(
      textInput(ns("x_axis_title"), "X axis title", value = "x axis")
    )
  },
  server = function(id, data) {
    moduleServer(id, function(input, output, session) {
      reactive({
        req(data())
        within(data(),
               {
                 plot <- plot +
                   ggplot2::ggtitle("This is title") +
                   ggplot2::xlab(my_title)
               },
               my_title = input$x_axis_title
        )
      })
    })
  }
)

app <- init(
  data = data,
  modules = tm_g_bivariate(
    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
      )
    ),
    # decorators = list() # SHOULD BE OK
    # decorators = list(plot = static_decorator, default = interactive_decorator) # SHOULD BE OK
    # decorators = list(static_decorator, interactive_decorator) # SHOULD BE OK
    decorators = list(plot = static_decorator, default = interactive_decorator) # SHOULD THROWN A WARNING
  )
)

shinyApp(app$ui, app$server)

[m7pr]

decorators = list(plot = static_decorator, plot = interactive_decorator)
This example also throws the same error "All decorators should either be named or unnamed" but here the duplicated decorator are named so the message is not informative. Could the users get a more informative message? ❌

I think we can work on this. Thanks for double checking

[m7pr]

Hey @llrs-roche when non-unique names are passed to decorators, function will throw a warning from assert_decorators. I allowed such case to pass through normalize_decorators. Check last commit.

Now user will see

Error in tm_g_bivariate(x = data_extract_spec(dataname = "CO2", select = select_spec(label = "Select variable:",  : 
  Assertion on 'decorators' failed: Non-unique names in decorators.
Called from: mstop("Assertion on '%s' failed: %s.", var.name, res, call. = sys.call(-2L))

I will push the same to tmc

[llrs-roche]

Looks good and the corner case was handled elegantly. 👍