introduce decorators for tm_g_scatterplotmatrix

[m7pr]

Part of insightsengineering/teal#1370

Working Example

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


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(),
          {
            plot$xlab <- footnote
          },
          footnote = input$footnote
        )
      )
    })
  }
)

# general data example
data <- teal_data()
data <- within(data, {
  countries <- data.frame(
    id = c("DE", "FR", "IT", "ES", "PT", "GR", "NL", "BE", "LU", "AT"),
    government = factor(
      c(2, 2, 2, 1, 2, 2, 1, 1, 1, 2),
      labels = c("Monarchy", "Republic")
    ),
    language_family = factor(
      c(1, 3, 3, 3, 3, 2, 1, 1, 3, 1),
      labels = c("Germanic", "Hellenic", "Romance")
    ),
    population = c(83, 67, 60, 47, 10, 11, 17, 11, 0.6, 9),
    area = c(357, 551, 301, 505, 92, 132, 41, 30, 2.6, 83),
    gdp = c(3.4, 2.7, 2.1, 1.4, 0.3, 0.2, 0.7, 0.5, 0.1, 0.4),
    debt = c(2.1, 2.3, 2.4, 2.6, 2.3, 2.4, 2.3, 2.4, 2.3, 2.4)
  )
  sales <- data.frame(
    id = 1:50,
    country_id = sample(
      c("DE", "FR", "IT", "ES", "PT", "GR", "NL", "BE", "LU", "AT"),
      size = 50,
      replace = TRUE
    ),
    year = sort(sample(2010:2020, 50, replace = TRUE)),
    venue = sample(c("small", "medium", "large", "online"), 50, replace = TRUE),
    cancelled = sample(c(TRUE, FALSE), 50, replace = TRUE),
    quantity = rnorm(50, 100, 20),
    costs = rnorm(50, 80, 20),
    profit = rnorm(50, 20, 10)
  )
})
join_keys(data) <- join_keys(
  join_key("countries", "countries", "id"),
  join_key("sales", "sales", "id"),
  join_key("countries", "sales", c("id" = "country_id"))
)

app <- init(
  data = data,
  modules = modules(
    tm_g_scatterplotmatrix(
      label = "Scatterplot matrix",
      variables = list(
        data_extract_spec(
          dataname = "countries",
          select = select_spec(
            label = "Select variables:",
            choices = variable_choices(data[["countries"]]),
            selected = c("area", "gdp", "debt"),
            multiple = TRUE,
            ordered = TRUE,
            fixed = FALSE
          )
        ),
        data_extract_spec(
          dataname = "sales",
          filter = filter_spec(
            label = "Select variable:",
            vars = "country_id",
            choices = value_choices(data[["sales"]], "country_id"),
            selected = c("DE", "FR", "IT", "ES", "PT", "GR", "NL", "BE", "LU", "AT"),
            multiple = TRUE
          ),
          select = select_spec(
            label = "Select variables:",
            choices = variable_choices(data[["sales"]], c("quantity", "costs", "profit")),
            selected = c("quantity", "costs", "profit"),
            multiple = TRUE,
            ordered = TRUE,
            fixed = FALSE
          )
        )
      ),
      decorators = list(footnote_dec)
    )
  )
)
if (interactive()) {
  shinyApp(app$ui, app$server)
}

[github-actions]

Code Coverage Summary

Filename                      Stmts    Miss  Cover    Missing
--------------------------  -------  ------  -------  -------------------------------------
R/tm_a_pca.R                    829     829  0.00%    118-1081
R/tm_a_regression.R             826     826  0.00%    160-1090
R/tm_data_table.R               185     185  0.00%    100-339
R/tm_file_viewer.R              173     173  0.00%    47-255
R/tm_front_page.R               133     122  8.27%    73-231
R/tm_g_association.R            330     330  0.00%    134-536
R/tm_g_bivariate.R              683     420  38.51%   313-793, 834, 945, 962, 980, 991-1013
R/tm_g_distribution.R          1075    1075  0.00%    136-1354
R/tm_g_response.R               362     362  0.00%    160-598
R/tm_g_scatterplot.R            722     722  0.00%    233-1056
R/tm_g_scatterplotmatrix.R      289     270  6.57%    181-500, 561, 575
R/tm_missing_data.R            1070    1070  0.00%    91-1317
R/tm_outliers.R                 985     985  0.00%    129-1258
R/tm_t_crosstable.R             257     257  0.00%    147-453
R/tm_variable_browser.R         830     825  0.60%    89-1081, 1119-1303
R/utils.R                        99      96  3.03%    84-269
R/zzz.R                           2       2  0.00%    2-3
TOTAL                          8850    8549  3.40%

Diff against main

Filename                      Stmts    Miss  Cover
--------------------------  -------  ------  --------
R/tm_a_pca.R                     +2      +2  +100.00%
R/tm_a_regression.R             +53     +53  +100.00%
R/tm_g_bivariate.R              +11     +10  -0.48%
R/tm_g_distribution.R           +27     +27  +100.00%
R/tm_g_response.R               +11     +11  +100.00%
R/tm_g_scatterplotmatrix.R      +11     +11  -0.26%
R/tm_t_crosstable.R              +6      +6  +100.00%
TOTAL                          +121    +120  -0.04%

Results for commit: 0170365

Minimum allowed coverage is 80%

♻️ 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_a_pca	💔	$120.63$	$+2.34$	$0$	$0$	$0$	$0$
shinytest2-tm_a_regression	💚	$54.97$	$-1.46$	$0$	$0$	$0$	$0$
shinytest2-tm_g_bivariate	💔	$74.92$	$+1.20$	$0$	$0$	$0$	$0$
shinytest2-tm_g_distribution	💔	$59.32$	$+1.41$	$0$	$0$	$0$	$0$
shinytest2-tm_g_scatterplot	💔	$74.74$	$+1.69$	$0$	$0$	$0$	$0$
shinytest2-tm_outliers	💔	$107.55$	$+2.54$	$0$	$0$	$0$	$0$

Results for commit 343e90b

♻️ This comment has been updated with latest results.

[averissimo]

👍

Tested both the main plot and the correlated one! works great.