Remove "default" decoration and use the same way of decoration in all modules #846
Conversation
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
|
Code Coverage SummaryDiff against mainResults for commit: 2183ecd Minimum allowed coverage is ♻️ This comment has been updated with latest results |
Unit Tests Summary 1 files 22 suites 13m 17s ⏱️ Results for commit 40d8f5c. |
Unit Tests Summary 1 files 22 suites 12m 47s ⏱️ Results for commit 2183ecd. ♻️ This comment has been updated with latest results. |
Unit Test Performance Difference
Additional test case details
Results for commit 1080cca ♻️ This comment has been updated with latest results. |
|
Tested with Codepkgload::load_all("../teal")
pkgload::load_all(".")
# ######################################################
#
# _____ _
# | __ \ | |
# | | | | ___ ___ ___ _ __ __ _| |_ ___ _ __ ___
# | | | |/ _ \/ __/ _ \| '__/ _` | __/ _ \| '__/ __|
# | |__| | __/ (_| (_) | | | (_| | || (_) | | \__ \
# |_____/ \___|\___\___/|_| \__,_|\__\___/|_| |___/
#
#
#
# Decorators
# #####################################################
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)
)))
})
})
}
)
}
caption_decorator <- function(default_caption = "I am a good decorator", .var_to_replace = "plot") {
teal_transform_module(
label = "Caption",
ui = function(id) shiny::textInput(shiny::NS(id, "footnote"), "Footnote", value = default_caption),
server = make_teal_transform_server(
substitute({
.var_to_replace <- .var_to_replace + ggplot2::labs(caption = footnote)
}, env = list(.var_to_replace = as.name(.var_to_replace)))
)
)
}
table_decorator <- function(.color1 = "#f9f9f9", .color2 = "#f0f0f0", .var_to_replace = "table") {
teal_transform_module(
label = "Table color",
ui = function(id) {
selectInput(
NS(id, "style"),
"Table Style",
choices = c("Default", "Color1", "Color2"),
selected = "Default"
)
},
server = function(id, data) {
moduleServer(id, function(input, output, session) {
logger::log_info("🔵 Table row color called to action!", namespace = "teal.modules.general")
reactive({
req(data(), input$style)
logger::log_info("changing the Table row color '{input$style}'", namespace = "teal.modules.general")
teal.code::eval_code(data(), substitute({
.var_to_replace <- switch(
style,
"Color1" = DT::formatStyle(
.var_to_replace,
columns = attr(.var_to_replace$x, "colnames")[-1],
target = "row",
backgroundColor = .color1
),
"Color2" = DT::formatStyle(
.var_to_replace,
columns = attr(.var_to_replace$x, "colnames")[-1],
target = "row",
backgroundColor = .color2
),
.var_to_replace
)
}, env = list(
style = input$style,
.var_to_replace = as.name(.var_to_replace),
.color1 = .color1,
.color2 = .color2
)))
})
})
}
)
}
head_decorator <- function(default_value = 6, .var_to_replace = "object") {
teal_transform_module(
label = "Head",
ui = function(id) shiny::numericInput(shiny::NS(id, "n"), "Footnote", value = default_value),
server = make_teal_transform_server(
substitute({
.var_to_replace <- utils::head(.var_to_replace, n = n)
}, env = list(.var_to_replace = as.name(.var_to_replace)))
)
)
}
treelis_subtitle_decorator <- function(default_caption = "I am a good decorator", .var_to_replace = "plot") {
teal_transform_module(
label = "Caption",
ui = function(id) shiny::textInput(shiny::NS(id, "footnote"), "Footnote", value = default_caption),
server = make_teal_transform_server(
substitute({
.var_to_replace <- update(.var_to_replace, sub = footnote)
}, env = list(.var_to_replace = as.name(.var_to_replace)))
)
)
}
insert_rrow_decorator <- function(default_caption = "I am a good new row", .var_to_replace = "table") {
teal_transform_module(
label = "New row",
ui = function(id) shiny::textInput(shiny::NS(id, "new_row"), "New row", value = default_caption),
server = make_teal_transform_server(
substitute({
.var_to_replace <- rtables::insert_rrow(.var_to_replace, rtables::rrow(new_row))
}, env = list(.var_to_replace = as.name(.var_to_replace)))
)
)
}
do_nothing_decorator <- teal_transform_module(server = function(id, data) moduleServer(id, function(input, output, session) data))
# ##########################################
#
# _ _ _ _
# | | | | | | | |
# | |_ ___ __ _| | __| | __ _| |_ __ _
# | __/ _ \/ _` | | / _` |/ _` | __/ _` |
# | || __/ (_| | || (_| | (_| | || (_| |
# \__\___|\__,_|_| \__,_|\__,_|\__\__,_|
# ______
# |______|
#
# teal_data
# #########################################
data <- teal_data(join_keys = default_cdisc_join_keys[c("ADSL", "ADRS")])
data <- within(data, {
require(nestcolor)
ADSL <- rADSL
ADRS <- rADRS
})
# For tm_outliers
fact_vars_adsl <- names(Filter(isTRUE, sapply(data[["ADSL"]], is.factor)))
vars <- choices_selected(variable_choices(data[["ADSL"]], fact_vars_adsl))
init(
data = data,
modules = modules(
######################################
#
# _ _ _
# | | | (_)
# ___ _ _| |_| |_ ___ _ __ ___
# / _ \| | | | __| | |/ _ \ '__/ __|
# | (_) | |_| | |_| | | __/ | \__ \
# \___/ \__,_|\__|_|_|\___|_| |___/
#
#
#
# outliers
# #####################################
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
)
)
),
decorators = list(
box_plot = caption_decorator("I am a good decorator", "box_plot"),
density_plot = caption_decorator("I am a good decorator", "density_plot"),
cumulative_plot = caption_decorator("I am a good decorator", "cumulative_plot"),
table = table_decorator("#FFA500", "#800080")
)
),
# #######################################################
#
# _ _ _
# (_) | | (_)
# __ _ ___ ___ ___ ___ _ __ _| |_ _ ___ _ __
# / _` / __/ __|/ _ \ / __| |/ _` | __| |/ _ \| '_ \
# | (_| \__ \__ \ (_) | (__| | (_| | |_| | (_) | | | |
# \__,_|___/___/\___/ \___|_|\__,_|\__|_|\___/|_| |_|
#
#
#
# association
# ######################################################
tm_g_association(
ref = data_extract_spec(
dataname = "ADSL",
select = select_spec(
choices = variable_choices(
data[["ADSL"]],
c("SEX", "RACE", "COUNTRY", "ARM", "STRATA1", "STRATA2", "ITTFL", "BMRKR2")
),
selected = "RACE"
)
),
vars = data_extract_spec(
dataname = "ADSL",
select = select_spec(
choices = variable_choices(
data[["ADSL"]],
c("SEX", "RACE", "COUNTRY", "ARM", "STRATA1", "STRATA2", "ITTFL", "BMRKR2")
),
selected = "BMRKR2",
multiple = TRUE
)
),
decorators = list(plot = plot_grob_decorator("I am a good grob (association)"))
),
# ########################################################
#
# _ _ _
# | | | | | |
# ___ _ __ ___ ___ ___ ______| |_ __ _| |__ | | ___
# / __| '__/ _ \/ __/ __|______| __/ _` | '_ \| |/ _ \
# | (__| | | (_) \__ \__ \ | || (_| | |_) | | __/
# \___|_| \___/|___/___/ \__\__,_|_.__/|_|\___|
#
#
#
# cross-table
# #######################################################
tm_t_crosstable(
label = "Cross Table",
x = data_extract_spec(
dataname = "ADSL",
select = select_spec(
choices = variable_choices(data[["ADSL"]], subset = function(data) {
idx <- !vapply(data, inherits, logical(1), c("Date", "POSIXct", "POSIXlt"))
return(names(data)[idx])
}),
selected = "COUNTRY",
multiple = TRUE,
ordered = TRUE
)
),
y = data_extract_spec(
dataname = "ADSL",
select = select_spec(
choices = variable_choices(data[["ADSL"]], subset = function(data) {
idx <- vapply(data, is.factor, logical(1))
return(names(data)[idx])
}),
selected = "SEX"
)
),
decorators = list(table = insert_rrow_decorator("I am a good new row"))
),
# #######################################################################################
#
# _ _ _ _ _ _
# | | | | | | | | | | (_)
# ___ ___ __ _| |_| |_ ___ _ __ _ __ | | ___ | |_ _ __ ___ __ _| |_ _ __ ___ __
# / __|/ __/ _` | __| __/ _ \ '__| '_ \| |/ _ \| __| | '_ ` _ \ / _` | __| '__| \ \/ /
# \__ \ (_| (_| | |_| || __/ | | |_) | | (_) | |_ | | | | | | (_| | |_| | | |> <
# |___/\___\__,_|\__|\__\___|_| | .__/|_|\___/ \__| |_| |_| |_|\__,_|\__|_| |_/_/\_\
# | |
# |_|
#
# scatterplot matrix
# ######################################################################################
tm_g_scatterplotmatrix(
label = "Scatterplot matrix",
variables = list(
data_extract_spec(
dataname = "ADSL",
select = select_spec(
choices = variable_choices(data[["ADSL"]]),
selected = c("AGE", "RACE", "SEX"),
multiple = TRUE,
ordered = TRUE
)
),
data_extract_spec(
dataname = "ADRS",
filter = filter_spec(
label = "Select endpoints:",
vars = c("PARAMCD", "AVISIT"),
choices = value_choices(data[["ADRS"]], c("PARAMCD", "AVISIT"), c("PARAM", "AVISIT")),
selected = "INVET - END OF INDUCTION",
multiple = TRUE
),
select = select_spec(
choices = variable_choices(data[["ADRS"]]),
selected = c("AGE", "AVAL", "ADY"),
multiple = TRUE,
ordered = TRUE
)
)
),
decorators = list(plot = treelis_subtitle_decorator("I am a Scatterplot matrix", "plot"))
),
# #############################################
#
#
#
# _ __ ___ ___ _ __ ___ _ __ ___ ___
# | '__/ _ \/ __| '_ \ / _ \| '_ \/ __|/ _ \
# | | | __/\__ \ |_) | (_) | | | \__ \ __/
# |_| \___||___/ .__/ \___/|_| |_|___/\___|
# | |
# |_|
#
# response
# ############################################
tm_g_response(
label = "Response",
response = data_extract_spec(
dataname = "ADSL",
select = select_spec(choices = variable_choices(data[["ADSL"]], c("BMRKR2", "COUNTRY")))
),
x = data_extract_spec(
dataname = "ADSL",
select = select_spec(choices = variable_choices(data[["ADSL"]], c("SEX", "RACE")), selected = "RACE")
),
decorators = list(plot = caption_decorator("I am a Response", "plot"))
),
# ############################################
#
# _ _ _ _
# | | (_) (_) | |
# | |__ ___ ____ _ _ __ _ __ _| |_ ___
# | '_ \| \ \ / / _` | '__| |/ _` | __/ _ \
# | |_) | |\ V / (_| | | | | (_| | || __/
# |_.__/|_| \_/ \__,_|_| |_|\__,_|\__\___|
#
#
#
# bivariate
# ###########################################
tm_g_bivariate(
x = data_extract_spec(
dataname = "ADSL",
select = select_spec(choices = variable_choices(data[["ADSL"]]), selected = "AGE")
),
y = data_extract_spec(
dataname = "ADSL",
select = select_spec(choices = variable_choices(data[["ADSL"]]), selected = "SEX")
),
row_facet = data_extract_spec(
dataname = "ADSL",
select = select_spec(choices = variable_choices(data[["ADSL"]]), selected = "ARM")
),
col_facet = data_extract_spec(
dataname = "ADSL",
select = select_spec(choices = variable_choices(data[["ADSL"]]), selected = "COUNTRY")
),
decorators = list(plot = caption_decorator("I am a Bivariate", "plot"))
),
# ####################
#
#
#
# _ __ ___ __ _
# | '_ \ / __/ _` |
# | |_) | (_| (_| |
# | .__/ \___\__,_|
# | |
# |_|
#
# pca
# ###################
tm_a_pca(
"PCA",
dat = data_extract_spec(
dataname = "ADSL",
select = select_spec(
choices = variable_choices(data = data[["ADSL"]], c("BMRKR1", "AGE", "EOSDY")),
selected = c("BMRKR1", "AGE")
)
),
decorators = list(elbow_plot = caption_decorator("I am a PCA", "elbow_plot"))
),
#####################################################
#
# _ _ _ _
# | | | | | | | |
# ___ ___ __ _| |_| |_ ___ _ __ _ __ | | ___ | |_
# / __|/ __/ _` | __| __/ _ \ '__| '_ \| |/ _ \| __|
# \__ \ (_| (_| | |_| || __/ | | |_) | | (_) | |_
# |___/\___\__,_|\__|\__\___|_| | .__/|_|\___/ \__|
# | |
# |_|
#
# scatterplot
# ####################################################
tm_g_scatterplot(
label = "Scatterplot",
x = data_extract_spec(
dataname = "ADSL",
select = select_spec(choices = variable_choices(data[["ADSL"]], c("AGE", "BMRKR1", "BMRKR2")))
),
y = data_extract_spec(
dataname = "ADSL",
select = select_spec(
choices = variable_choices(data[["ADSL"]], c("AGE", "BMRKR1", "BMRKR2")),
selected = "BMRKR1"
)
),
color_by = data_extract_spec(
dataname = "ADSL",
select = select_spec(
choices = variable_choices(data[["ADSL"]], c("AGE", "BMRKR1", "BMRKR2", "RACE", "REGION1")),
selected = NULL
)
),
size_by = data_extract_spec(
dataname = "ADSL",
select = select_spec(choices = variable_choices(data[["ADSL"]], c("AGE", "BMRKR1")))
),
row_facet = data_extract_spec(
dataname = "ADSL",
select = select_spec(
choices = variable_choices(data[["ADSL"]], c("BMRKR2", "RACE", "REGION1")),
selected = NULL
)
),
col_facet = data_extract_spec(
dataname = "ADSL",
select = select_spec(
choices = variable_choices(data[["ADSL"]], c("BMRKR2", "RACE", "REGION1")),
selected = NULL
)
),
decorators = list(plot = caption_decorator("I am a scatterplot", "plot"))
),
# ##############################################################
#
# _ _ _ _
# (_) (_) | | | |
# _ __ ___ _ ___ ___ _ _ __ __ _ __| | __ _| |_ __ _
# | '_ ` _ \| / __/ __| | '_ \ / _` | / _` |/ _` | __/ _` |
# | | | | | | \__ \__ \ | | | | (_| | | (_| | (_| | || (_| |
# |_| |_| |_|_|___/___/_|_| |_|\__, | \__,_|\__,_|\__\__,_|
# __/ |_____
# |___/______|
#
# missing_data
# #############################################################
tm_missing_data(
label = "Missing data",
decorators = list(
summary_plot = plot_grob_decorator("A", "summary_plot"),
combination_plot = plot_grob_decorator("B", "combination_plot"),
# table = insert_rrow_decorator("I am a good new row"), ### SOMETHING IS OFF IN HERE
by_subject_plot = caption_decorator("Caption XX", "by_subject_plot")
)
),
example_module(decorators = list(object = head_decorator(6)))
)
) |> shiny::runApp() |
|
TODO: Example doesn't cover
Code
|
|
Current status of the decorators: Works fine (✅) Have issues (❌)
|
m7pr
approved these changes
Feb 18, 2025
There was a problem hiding this comment.
Thanks Vedha for the hard work on simplification of the decorators in here.
The examples work fine.
I think we can reuse those in the vignette.
For the modules that are failing in some objects, I would recommend to create separate issues. Would you be able to create those?
Sign up for free
to subscribe to this conversation on GitHub.
Already have an account?
Sign in.
Add this suggestion to a batch that can be applied as a single commit.
This suggestion is invalid because no changes were made to the code.
Suggestions cannot be applied while the pull request is closed.
Suggestions cannot be applied while viewing a subset of changes.
Only one suggestion per line can be applied in a batch.
Add this suggestion to a batch that can be applied as a single commit.
Applying suggestions on deleted lines is not supported.
You must change the existing code in this line in order to create a valid suggestion.
Outdated suggestions cannot be applied.
This suggestion has been applied or marked resolved.
Suggestions cannot be applied from pending reviews.
Suggestions cannot be applied on multi-line comments.
Suggestions cannot be applied while the pull request is queued to merge.
Suggestion cannot be applied right now. Please check back later.
Closes #845
Changes:
decorators = list(output_name = teal_transform_module(...))Decorator examples that should be working