library(shiny)
module_1 <- module(
label = "a module",
server = function(id, data) {
moduleServer(
id,
module = function(input, output, session) {
output$data <- renderDataTable(data()[["iris"]])
}
)
},
ui = function(id) {
ns <- NS(id)
tagList(dataTableOutput(ns("data")))
},
datanames = "all"
)
module_2 <- module(
label = "another module",
server = function(id) {
moduleServer(
id,
module = function(input, output, session) {
output$text <- renderText("Another Module")
}
)
},
ui = function(id) {
ns <- NS(id)
tagList(textOutput(ns("text")))
},
datanames = NULL
)
modules <- modules(
label = "modules",
modules(
label = "nested modules",
module_1
),
module_2
)
app <- init(
data = teal_data(iris = iris),
modules = modules
)
if (interactive()) {
shinyApp(app$ui, app$server)
}
mod <- module(
label = "My Custom Module",
server = function(id, data, ...) {},
ui = function(id, ...) {},
datanames = c("ADSL", "ADTTE"),
transformators = list(),
ui_args = list(a = 1, b = "b"),
server_args = list(x = 5, y = list(p = 1))
)
cat(format(mod))
custom_module <- function(
label = "label", ui_args = NULL, server_args = NULL,
datanames = "all", transformators = list(), bk = FALSE) {
ans <- module(
label,
server = function(id, data, ...) {},
ui = function(id, ...) {
},
datanames = datanames,
transformators = transformators,
ui_args = ui_args,
server_args = server_args
)
attr(ans, "teal_bookmarkable") <- bk
ans
}
dummy_transformator <- teal_transform_module(
label = "Dummy Transform",
ui = function(id) div("(does nothing)"),
server = function(id, data) {
moduleServer(id, function(input, output, session) data)
}
)
plot_transformator <- teal_transform_module(
label = "Plot Settings",
ui = function(id) div("(does nothing)"),
server = function(id, data) {
moduleServer(id, function(input, output, session) data)
}
)
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 +
ggtitle("This is title") +
xlab("x axis")
})
})
})
}
)
complete_modules <- modules(
custom_module(
label = "Data Overview",
datanames = c("ADSL", "ADAE", "ADVS"),
ui_args = list(
view_type = "table",
page_size = 10,
filters = c("ARM", "SEX", "RACE"),
decorators = list(static_decorator)
),
server_args = list(
cache = TRUE,
debounce = 1000,
decorators = list(static_decorator)
),
transformators = list(dummy_transformator),
bk = TRUE
),
modules(
label = "Nested 1",
custom_module(
label = "Interactive Plots",
datanames = c("ADSL", "ADVS"),
ui_args = list(
plot_type = c("scatter", "box", "line"),
height = 600,
width = 800,
color_scheme = "viridis"
),
server_args = list(
render_type = "svg",
cache_plots = TRUE
),
transformators = list(dummy_transformator, plot_transformator),
bk = TRUE
),
modules(
label = "Nested 2",
custom_module(
label = "Summary Statistics",
datanames = "ADSL",
ui_args = list(
stats = c("mean", "median", "sd", "range"),
grouping = c("ARM", "SEX")
)
),
modules(
label = "Labeled nested modules",
custom_module(
label = "Subgroup Analysis",
datanames = c("ADSL", "ADAE"),
ui_args = list(
subgroups = c("AGE", "SEX", "RACE"),
analysis_type = "stratified"
),
bk = TRUE
)
),
modules(custom_module(label = "Subgroup Analysis in non-labled modules"))
)
),
custom_module("Non-nested module")
)
cat(format(complete_modules))
cat(format(complete_modules, what = c("ui_args", "server_args", "transformators")))
cat(format(complete_modules, what = c("decorators", "transformators")))
Run the code above in your browser using DataLab