[research] Decorate module output

[gogonzo]

We need to find an optimal way to allow app developer to "decorate" output of the module (including interactivity). In tmc modules are developed as follows.

• there is a template_xy function which generates a list of calls needed to produce an output
• template_xy is evaluated in qenv and plots use to be assigned to p binding (it is defined in the template)
• then p variable is extracted from qenv and passed to plot_with_settings

template_xy <- function(... <many arguments like dataname xvar yvar>) {
}

srv_xy <- function(...) {
  ...
  all_q <- reactive({
      my_calls <- template_xy(...)
      teal.code::eval_code(anl_q(), as.expression(my_calls))
  })

  plot_r <- reactive(all_q()[["p"]])
  plot_with_settings(plot_r)
}

We need to find a nice way to include any arbitrary code to change the p. No holds barred!
Issue should be addressed by POC

Definition of Done

• Research on how to decorate module output
• Followed by PoC(s) for coreDev and SME review -> [Discussion]: Discuss with SME team the concept of module decoration #1385
• Once decided, refine and create actionable issue for implementation

[gogonzo]

Discussion 1 summary

@kpagacz and I discussed the issue and decided to first focus on allowing app developers to provide arbitrary code to modify the module’s output. Interactivity is not yet included. We agreed almost immediately that decorators need to be provided through the tm_xyz argument and passed down by server_args to the srv_xyz. Discussion about the other ways seems irrelevant, but we will come back to this later. We considered three scenarios, though the list is not exhaustive.

1. Decorator passed as expression list

tm_xy <- function(
  ...
  decorator = expression(
    ggplot2::flip_axis(...) +
    ggplot2::ggtitle(...) +
    ggplot2::theme(...)
  )
)

Above call could be passed to the server and in the reactive which produces the plot call it would look something like this:

plot_call <- ...
if (length(decorator)) {
  plot_call <- substitute(p <- p + <decorator>) 
}

• ✅ simple api to evaluate inside of the module. Can be automatically generated from ggplot_args
• ✅ doesn't require knowing anything about p object created inside of the module. p doesn't have to be used as it will be automatically added to the final call
• ❌ with above it won't be possible to do more than just appending ggplot elements.

2. Decorator as a function

tm_xy <- function(
  ...,
  decorator = expression(
    function(plot, data) {
      plot + 
        ggplot2::flip_axis(...) +
        ggplot2::ggtitle(...) + 
        ggplot2::theme(...) +
        ggplot2::geom_points(data, aes(x = x, y = y))
     }
  )
)

Inside of the module above would be consumed in the following way. Because function is passed as expression it will be added to SRC for reproducibility.

substitute(
  p <- decorate(iris, p),
  list(
    decorate = eval(decorator)
  )
)

• ✅ doesn't need to know data object name nor p
• ❌ not elegant SRC output

3. teal_transform_module

If we consider that some decorations will depend on the app user input (limiting axes range, changing title etc.) then teal_transform_module could be a solution.

• ✅ standardised way of modifying objects for teal
• ❌ require to know the bindings names inside of the qenv like plot or ADSL

[gogonzo]

Discussion 2 summary

After short meeting, we agreed that in order to execute any custom call inside of the teal_module one of the following is needed:

1. App-developer can provide a function(plot) without knowing how plot is named inside the srv_xy. Inside of the srv_xy body, module-developer would call decorator(plot = p). Function can have more arguments, for example function(plot, data) for example to add ggplot elements dependent on some data.
2. App-developer can provide a call which can be executed inside of the module, but then app-developer should know the names of the objects as plot and data doesn't have to be the exact names inside of the teal_module. Then the module documentation should explicitly say that plot object is named p and data object is named ADSL. In most of the cases dataname is not fixed, so app-developer would have to know that if module receives iris then iris needs to be included in a decorate.

[gogonzo]

Conclusions from the last (general) meeting

1. ui and server is needed for decoration in some cases
2. J&J need only to provide a working decorate-call
3. If we implement (2), it shouldn't put the burden on app developer to know the names of internal objects. Objects used by app developer should be a standard convention for decorate api
4. If (3) will have a standard naming convention, then teal_module(s) could also use this standard convention to name objects - technically renaming names in the teal_module could have the same effect
5. Decorators based on data will be a rabbit hole and would require app developer to understand teal_module reactivity (to know what is expected shape of the final dataset which plot/table is based on)
6. We might need an access to the inputs also

Initial apps showing apps the problem

Initial app for plot decoration (simple case, one output)

library(teal)
identity_decorator <- list(
  ui = function(id) NULL,
  server = function(id, data) {
    data
  }
)

tm_decorated_plot <- function(label = "module", decorator = identity_decorator) {
  module(
    label = label,
    ui = function(id, decorator) {
      ns <- NS(id)
      div(
        selectInput(ns("dataname"), label = "select dataname", choices = NULL),
        selectInput(ns("x"), label = "select x", choices = NULL),
        selectInput(ns("y"), label = "select y", choices = NULL),
        decorator$ui(ns("decorate")),
        plotOutput(ns("plot")),
        verbatimTextOutput(ns("text"))
      )
    },
    server = function(id, data, decorator) {
      moduleServer(id, function(input, output, session) {
        observeEvent(data(), {
          updateSelectInput(inputId = "dataname", choices = teal.data::datanames(data()))
        })

        observeEvent(input$dataname, {
          updateSelectInput(inputId = "x", choices = colnames(data()[[input$dataname]]))
          updateSelectInput(inputId = "y", label = "select y", choices = colnames(data()[[input$dataname]]))
        })

        q1 <- reactive({
          req(input$dataname, input$x, input$y)
          data() |>
            within(
              {
                plot <- ggplot2::ggplot(dataname, ggplot2::aes(x = x, y = y)) +
                  ggplot2::geom_point()
              },
              dataname = as.name(input$dataname),
              x = as.name(input$x),
              y = as.name(input$y)
            )
        })

        q2 <- decorator$server("decorate", data = q1)

        plot_r <- reactive({
          req(q2())
          q2()[["plot"]]
        })

        output$plot <- renderPlot(plot_r())
        output$text <- renderText({
          teal.code::get_code(q2())
        })
      })
    },
    ui_args = list(decorator = decorator),
    server_args = list(decorator = decorator)
  )
}

app <- init(
  data = teal_data(iris = iris, mtcars = mtcars),
  modules = modules(
    tm_decorated_plot("1")
  )
)

runApp(app)

[gogonzo]

POC

Create a decoration object

App developer can create a decorator in multiple ways. It is allowed to pass decorator to the module as teal_transform_module, language or function.

1. teal_transform_module without ui. Nothing will be displayed, only server code will be executed.

   static decorator

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

2. Using language will result in teal_transform_module without ui.

   language cunstructor

   static_decorator_lang <- quote(plot <- plot +
     ggtitle("This is title") +
     xlab("x axis title"))

3. Adding interactivity requires creating a proper shiny module.

   interactive decorator

   interactive_decorator <- teal_transform_module(
     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())
           data() |> within(
             {
               plot <- plot +
                 ggtitle("This is title") +
                 xlab(x_axis_title)
             },
             x_axis_title = input$x_axis_title
           )
         })
       })
     }
   )

4. Thanks to the function-constructor app developer doesn't need to know what is the object name inside of the module's
   server. One can create any single argument function. Mapping x -> plot happens in decorate_teal_data and
   requires to specify output_name = "plot" (modules' developer duty).

   function constructor

   fun_decorator <- function(x) {
      x <- x + ggtitle("This is title") + xlab("x_axis_title")
    }

5. Failures in decorators are handled by internal teal mechanism called trigger_on_success, which will never
   break data object inside of the module. Instead decorator will be ignored and relevant error message will be shown.

   failing decorator

   failing_decorator <- teal_transform_module(
     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(stop("Hihi"))
       })
     }
   )

Example module and app

To include decorator to the teal_module one needs to add an extra argument to the module-constructor function tm_.
Decorator passed to the constructor needs to go through decorate_teal_data() in order to cast language or function object into teal_transform_module. decorate_teal_data() wouldn't be necessary if an app developer
always provides teal_transform_module. We could extend teal_transform_module() constructor by expr argument instead but using function would be impossible then.

Decorators should be passed via ui_args and server_args to the module's ui and server, where they should be
consumed by ui/srv_transform_data.

example module

library(ggplot2)
tm_decorated_plot <- function(label = "module", decorator = teal_transform_module()) {
  decorator_obj <- decorate_teal_data(x = decorator, output_name = "plot")

  module(
    label = label,
    ui = function(id, decorator) {
      ns <- NS(id)
      div(
        selectInput(ns("dataname"), label = "select dataname", choices = NULL),
        selectInput(ns("x"), label = "select x", choices = NULL),
        selectInput(ns("y"), label = "select y", choices = NULL),
        ui_transform_data(ns("decorate"), transforms = decorator),
        plotOutput(ns("plot")),
        verbatimTextOutput(ns("text"))
      )
    },
    server = function(id, data, decorator) {
      moduleServer(id, function(input, output, session) {
        observeEvent(data(), {
          updateSelectInput(inputId = "dataname", choices = teal.data::datanames(data()))
        })

        observeEvent(input$dataname, {
          updateSelectInput(inputId = "x", choices = colnames(data()[[input$dataname]]))
          updateSelectInput(inputId = "y", label = "select y", choices = colnames(data()[[input$dataname]]))
        })

        q1 <- reactive({
          req(input$dataname, input$x, input$y)
          data() |>
            within(
              {
                plot <- ggplot2::ggplot(dataname, ggplot2::aes(x = x, y = y)) +
                  ggplot2::geom_point()
              },
              dataname = as.name(input$dataname),
              x = as.name(input$x),
              y = as.name(input$y)
            )
        })

        q2 <- srv_transform_data("decorate", data = q1, transforms = decorator)

        plot_r <- reactive({
          req(q2())
          q2()[["plot"]]
        })

        output$plot <- renderPlot(plot_r())
        output$text <- renderText({
          teal.code::get_code(q2())
        })
      })
    },
    ui_args = list(decorator = decorator_obj),
    server_args = list(decorator = decorator_obj)
  )
}

example app

app <- init(
  data = teal_data(iris = iris, mtcars = mtcars),
  modules = modules(
    tm_decorated_plot("identity"),
    tm_decorated_plot("no-ui", decorator = static_decorator),
    tm_decorated_plot("lang", decorator = static_decorator_lang),
    tm_decorated_plot("fun", decorator = fun_decorator),
    tm_decorated_plot("interactive", decorator = interactive_decorator),
    tm_decorated_plot("failing", decorator = failing_decorator)
  )
)

shinyApp(app$ui, app$server)

tmg app

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_decorator <- teal_transform_module(
  label = "Footnote",
  ui = function(id) {
    ns <- NS(id)
    div(
      textInput(ns("footnote"), "Footnote", value = "Collaboration")
    )
  },
  server = function(id, data) {
    moduleServer(id, function(input, output, session) {
      reactive({
        req(data())
        within(
          data(),
          g <- g + labs(caption = footnote),
          footnote = input$footnote
        )
      })
    })
  }
)

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")
      ),
      decorator = list(default = footnote_decorator)
    ),
    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
          )
        )
      ),
      boxplot_decorator = footnote_decorator,
      density_decorator = quote(g <- g + labs(caption = "(custom caption)")),
      ggplot2_args = list(
        ggplot2_args(
          labs = list(subtitle = "Plot generated by Outliers Module")
        )
      )
    )
  )
)

shinyApp(app$ui, app$server)

Design

To improve

• Error handling when a decorator throws an error.
• Rewrite modules so that they always have a graph as graph (or plot, g, p etc.) and table as
  table (or t etc.) and listings as listings (or l etc.). This simplifies/standardizes a construction of
  teal_transform_module which can be re-used in multiple modules.

[gogonzo]

Conclusions from the last meeting

1. There seems to be a consensus that tm_xyz should accept teal_transform_module which means that extra constructor decorate_teal_data is not needed.

2. Consequence of (1) is also that an app developer should know the output-object name when creating a transformers/decorators.

3. (1) and (2) requires very explicit statement in the documentation that output-object is named <name> and we should rather keep consistent naming across the modules (table, listing, graph or t, l, g).

4. Re-using teal_transform_module might fail when output-object name is different than it is in a "shared" teal_transform_module. This means that it is better to have library of functions which create teal_transform_module rather than ready-to-use decorators. See following example gg_xlab_decorator function and example usage.

   example builder

   ```r gg_xlab_decorator <- function(output_name) { teal_transform_module( 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()) data() |> within( { output_name <- output_name + xlab(x_axis_title) }, x_axis_title = input$x_axis_title, output_name = as.name(output_name) ) }) }) } ) } ```

   Function can be used as follows

   tm_decorated_plot("from-fun", decorator = gg_xlab_decorator("graph"))

5. teal_transform_module-constructor will be extended to accept expression as a simplified form of a server to avoid writing boilerplate code around EXPR (function(id, data) moduleServer(..., reactive( data() |> within(EXPR) ))).

6. NOTE: Once teal_transform_module is created it is very difficult to robustly change output-object name as it requires parsing server function and detecting within.teal_data or eval_code call. Task is nearly impossible if some parts of this server is calling some wrapper functions which contain eval_code call.

Example app with simplified teal_transform_module constructors

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

static_decorator_lang <- teal_transform_module(server = quote(plot <- plot +
ggtitle("This is title") +
xlab("x axis title")))

interactive_decorator <- teal_transform_module(
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())
data() |> within(
{
plot <- plot +
ggtitle("This is title") +
xlab(x_axis_title)
},
x_axis_title = input$x_axis_title
)
})
})
}
)

interactive_decorator_lang <- teal_transform_module(
ui = function(id) {
ns <- NS(id)
div(
textInput(ns("x_axis_title"), "X axis title", value = "x axis")
)
},
server = expression(
plot <- plot +
ggtitle("This is title") +
xlab(x_axis_title)
)
)

gg_xlab_decorator <- function(output_name) {
teal_transform_module(
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())
data() |> within(
{
output_name <- output_name +
xlab(x_axis_title)
},
x_axis_title = input$x_axis_title,
output_name = as.name(output_name)
)
})
})
}
)
}

failing_decorator <- teal_transform_module(
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(stop("Hihi"))
})
}
)

tm_decorated_plot <- function(label = "module", transforms = list(), decorator = teal_transform_module()) {
module(
label = label,
ui = function(id, decorator) {
ns <- NS(id)
div(
selectInput(ns("dataname"), label = "select dataname", choices = NULL),
selectInput(ns("x"), label = "select x", choices = NULL),
selectInput(ns("y"), label = "select y", choices = NULL),
ui_transform_data(ns("decorate"), transforms = decorator),
plotOutput(ns("plot")),
verbatimTextOutput(ns("text"))
)
},
server = function(id, data, decorator) {
moduleServer(id, function(input, output, session) {
observeEvent(data(), {
updateSelectInput(inputId = "dataname", choices = teal.data::datanames(data()))
})

    observeEvent(input$dataname, {
      updateSelectInput(inputId = "x", choices = colnames(data()[[input$dataname]]))
      updateSelectInput(inputId = "y", label = "select y", choices = colnames(data()[[input$dataname]]))
    })

    q1 <- reactive({
      req(input$dataname, input$x, input$y)
      data() |>
        within(
          {
            plot <- ggplot2::ggplot(dataname, ggplot2::aes(x = x, y = y)) +
              ggplot2::geom_point()
          },
          dataname = as.name(input$dataname),
          x = as.name(input$x),
          y = as.name(input$y)
        )
    })

    q2 <- srv_transform_data("decorate", data = q1, transforms = decorator)

    plot_r <- reactive({
      req(q2())
      q2()[["plot"]]
    })

    output$plot <- renderPlot(plot_r())
    output$text <- renderText({
      teal.code::get_code(q2())
    })
  })
},
ui_args = list(decorator = decorator),
server_args = list(decorator = decorator)

)
}

library(ggplot2)
app <- init(
data = teal_data(iris = iris, mtcars = mtcars),
modules = modules(
tm_decorated_plot("identity"),
tm_decorated_plot("no-ui", decorator = static_decorator),
tm_decorated_plot("lang", decorator = static_decorator_lang),
tm_decorated_plot("interactive", decorator = interactive_decorator),
tm_decorated_plot("interactive-from lang", decorator = interactive_decorator_lang),
tm_decorated_plot("from-fun", decorator = gg_xlab_decorator("plot")),
tm_decorated_plot("failing", decorator = failing_decorator)
)
)

shinyApp(app$ui, app$server)

</details>

[gogonzo]

Improved POC

In response to the conclusions from the last meeting we implemented a slightly different design.

1. decorators specified for tm_ constructor should be a list of teal_transform_module.

2. There is a way to simplify building of teal_transform_module's server by calling make_teal_transform_server(expr). This function allows to simply write an expression which will be wrapped in necessary boilerplate shiny-server code. When expression contains a name which matches the input, then it will be substituted with input value. Consider following, where ui has input named gg_title and in the expression there is ggtitle(gg_title). This would result in gg_title to be replaced with input$gg_title value.

   simplified server constructor

   teal_transform_module(
     ui = function(id) {
       ns <- NS(id)
       textInput(ns("gg_title"), ...)
     },
     server = make_teal_transform_server(expression(graph <- graph + ggtitle(gg_title)))
   )

3. When created teal_transform_module has constant object names. This means that it is hard to robustly reuse
   transformer in any tm_ module. It is recomended for external parties to collect library of "decorators" as functions
   to potentially adjust the content of the evaluated expression to teal_modules's internals. See the following example
   and focus on output_name.

   function constructor

   gg_xlab_decorator <- function(output_name) {
     teal_transform_module(
       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())
             data() |> within(
               {
                 output_name <- output_name +
                   xlab(x_axis_title)
               },
               x_axis_title = input$x_axis_title,
               output_name = as.name(output_name)
             )
           })
         })
       }
     )
   }

example app

pkgload::load_all("teal")

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

static_decorator_lang <- teal_transform_module(
  server = make_teal_transform_server(
    expression(
      plot <- plot +
        ggtitle("This is title") +
        xlab("x axis title")
    )
  )
)

interactive_decorator <- teal_transform_module(
  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())
        data() |> within(
          {
            plot <- plot +
              ggtitle("This is title") +
              xlab(x_axis_title)
          },
          x_axis_title = input$x_axis_title
        )
      })
    })
  }
)

interactive_decorator_lang <- teal_transform_module(
  ui = function(id) {
    ns <- NS(id)
    div(
      textInput(ns("x_axis_title"), "X axis title", value = "x axis")
    )
  },
  server = make_teal_transform_server(
    expression(
      plot <- plot +
        ggtitle("This is title") +
        xlab(x_axis_title)
    )
  )
)

gg_xlab_decorator <- function(output_name) {
  teal_transform_module(
    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())
          data() |> within(
            {
              output_name <- output_name +
                xlab(x_axis_title)
            },
            x_axis_title = input$x_axis_title,
            output_name = as.name(output_name)
          )
        })
      })
    }
  )
}

failing_decorator <- teal_transform_module(
  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(stop("Hihi"))
    })
  }
)

tm_decorated_plot <- function(label = "module", transforms = list(), decorators = teal_transform_module()) {
  module(
    label = label,
    ui = function(id, decorators) {
      ns <- NS(id)
      div(
        selectInput(ns("dataname"), label = "select dataname", choices = NULL),
        selectInput(ns("x"), label = "select x", choices = NULL),
        selectInput(ns("y"), label = "select y", choices = NULL),
        ui_teal_transform_module(ns("decorate"), transforms = decorators),
        plotOutput(ns("plot")),
        verbatimTextOutput(ns("text"))
      )
    },
    server = function(id, data, decorators) {
      moduleServer(id, function(input, output, session) {
        observeEvent(data(), {
          updateSelectInput(inputId = "dataname", choices = teal.data::datanames(data()))
        })

        observeEvent(input$dataname, {
          updateSelectInput(inputId = "x", choices = colnames(data()[[input$dataname]]))
          updateSelectInput(inputId = "y", label = "select y", choices = colnames(data()[[input$dataname]]))
        })

        q1 <- reactive({
          req(input$dataname, input$x, input$y)
          data() |>
            within(
              {
                plot <- ggplot2::ggplot(dataname, ggplot2::aes(x = x, y = y)) +
                  ggplot2::geom_point()
              },
              dataname = as.name(input$dataname),
              x = as.name(input$x),
              y = as.name(input$y)
            )
        })

        q2 <- srv_teal_transform_module("decorate", data = q1, transforms = decorators)

        plot_r <- reactive({
          req(q2())
          q2()[["plot"]]
        })

        output$plot <- renderPlot(plot_r())
        output$text <- renderText({
          teal.code::get_code(q2())
        })
      })
    },
    ui_args = list(decorators = decorators),
    server_args = list(decorators = decorators)
  )
}

library(ggplot2)
app <- init(
  data = teal_data(iris = iris, mtcars = mtcars),
  modules = modules(
    tm_decorated_plot("identity"),
    tm_decorated_plot("no-ui", decorator = static_decorator),
    tm_decorated_plot("lang", decorator = static_decorator_lang),
    tm_decorated_plot("interactive", decorator = interactive_decorator),
    tm_decorated_plot("interactive-from lang", decorator = interactive_decorator_lang),
    tm_decorated_plot("from-fun", decorator = gg_xlab_decorator("plot")),
    tm_decorated_plot("failing", decorator = failing_decorator)
  )
)

shinyApp(app$ui, app$server)

Example tmg app

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_decorator <- teal_transform_module(
  label = "Footnote",
  ui = function(id) {
    ns <- NS(id)
    div(
      textInput(ns("footnote"), "Footnote", value = "Collaboration")
    )
  },
  server = function(id, data) {
    moduleServer(id, function(input, output, session) {
      reactive({
        req(data())
        within(
          data(),
          g <- g + labs(caption = footnote),
          footnote = input$footnote
        )
      })
    })
  }
)

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")
      ),
      decorator = list(default = footnote_decorator)
    ),
    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
          )
        )
      ),
      boxplot_decorator = footnote_decorator,
      density_decorator = footnote_decorator,
      ggplot2_args = list(
        ggplot2_args(
          labs = list(subtitle = "Plot generated by Outliers Module")
        )
      )
    )
  )
)

shinyApp(app$ui, app$server)

Regression footnote

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 based on the `fit`
footnote_regression <- teal_transform_module(
  server = make_teal_transform_server(expression(
    g <- g + 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)

---

Design challenges:

• transforms and decorators they are very similar concepts. transforms modify module's data input while decorators modify module's output object. module function has transforms argument, which is attached to the teal_module object and executed by teal before teal_module's server is called. We would like to document decorators also, but decorators fits better as ui/server_args and thus they don't have a dedicated place in the module() formals. Just consider a module which is defined as follows:
  • ui is a function of id and additional args (ui_args)
  • server is a function if id, data and additional args (server_args)
    If we decide to feed a ui and server with decorators as a separate module() argument it means it goes beyond the definition.

[gogonzo]

Closing this issue as research has been done