Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

736 Allow pure custom card functions in modules #742

Open
wants to merge 18 commits into
base: main
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from 17 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -35,6 +35,7 @@ Imports:
DT (>= 0.13),
forcats (>= 1.0.0),
grid,
rlang (>= 1.0.0),
scales,
shinyjs,
shinyTree (>= 0.2.8),
Expand Down Expand Up @@ -69,7 +70,6 @@ Suggests:
MASS,
nestcolor (>= 0.1.0),
pkgload,
rlang (>= 1.0.0),
rtables (>= 0.6.6),
rvest,
shinytest2,
Expand Down
2 changes: 2 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -1,5 +1,7 @@
# teal.modules.general 0.3.0.9029

* Users can now provide their own card functions to specify the content that modules send to reports.

# teal.modules.general 0.3.0

### Enhancements
Expand Down
81 changes: 47 additions & 34 deletions R/tm_g_distribution.R
Original file line number Diff line number Diff line change
Expand Up @@ -39,7 +39,7 @@
#'
#' app <- init(
#' data = data,
#' modules = list(
#' modules = modules(
#' tm_g_distribution(
#' dist_var = data_extract_spec(
#' dataname = "iris",
Expand Down Expand Up @@ -118,7 +118,8 @@ tm_g_distribution <- function(label = "Distribution Module",
plot_height = c(600, 200, 2000),
plot_width = NULL,
pre_output = NULL,
post_output = NULL) {
post_output = NULL,
card_function) {
message("Initializing tm_g_distribution")

# Requires Suggested packages
Expand Down Expand Up @@ -169,6 +170,12 @@ tm_g_distribution <- function(label = "Distribution Module",

checkmate::assert_multi_class(pre_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)
checkmate::assert_multi_class(post_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)

if (missing(card_function)) {
card_function <- tm_g_distribution_card_function
} else {
checkmate::assert_function(card_function)
}
# End of assertions

# Make UI args
Expand All @@ -185,7 +192,7 @@ tm_g_distribution <- function(label = "Distribution Module",
server = srv_distribution,
server_args = c(
data_extract_list,
list(plot_height = plot_height, plot_width = plot_width, ggplot2_args = ggplot2_args)
list(plot_height = plot_height, plot_width = plot_width, ggplot2_args = ggplot2_args, card_function = card_function) # nolint: line_length.
),
ui = ui_distribution,
ui_args = args,
Expand Down Expand Up @@ -351,7 +358,8 @@ srv_distribution <- function(id,
group_var,
plot_height,
plot_width,
ggplot2_args) {
ggplot2_args,
card_function) {
with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
checkmate::assert_class(data, "reactive")
Expand Down Expand Up @@ -1282,37 +1290,42 @@ srv_distribution <- function(id,

### REPORTER
if (with_reporter) {
card_fun <- function(comment, label) {
card <- teal::report_card_template(
title = "Distribution Plot",
label = label,
with_filter = with_filter,
filter_panel_api = filter_panel_api
)
card$append_text("Plot", "header3")
if (input$tabs == "Histogram") {
card$append_plot(dist_r(), dim = pws1$dim())
} else if (input$tabs == "QQplot") {
card$append_plot(qq_r(), dim = pws2$dim())
}
card$append_text("Statistics table", "header3")

card$append_table(common_q()[["summary_table"]])
tests_error <- tryCatch(expr = tests_r(), error = function(e) "error")
if (inherits(tests_error, "data.frame")) {
card$append_text("Tests table", "header3")
card$append_table(tests_r())
}

if (!comment == "") {
card$append_text("Comment", "header3")
card$append_text(comment)
}
card$append_src(teal.code::get_code(output_q()))
card
}
teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
env <- environment()
env$with_filter <- with_filter
env$filter_panel_api <- filter_panel_api
teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_function, env = env)
}
###
})
}

#' @keywords internal
tm_g_distribution_card_function <- function(comment, label, env) { # nolint: object_length.
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think this is something we need to rethink (the way how to handle custom reporting)


I think there are two ways to handle this:

  1. One you described above where custom function passed through argument is executed in the srv environment, or
  2. module returns reporter card (and other elements) and one can wrap function around srv to bypass and edit reporter card on the fly. (I guess this is not possible now and require some refactoring)

(1) is related with the idea we are currently exploring which is called "preprocessing", where app developer can pass any code/function to the srv and "postprocess" existing items in that environment.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It seems to me the solution you are proposing involves a significant rewrite of the modules as well as the framework. In the long run it is probably superior but I imagine it would take time to properly design and implement.
The solution proposed here is quicker to implement and introduces the feature of custom reporting without changing the framework in a meaningful way. It can be used as a temporary measure. I imagine that if a module returns something (be it a TealReportCard object or a list of its possible contents), the way to specify its handling would be to pass a function.

I will be happy to discuss further.

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I agree with @chlebowa that this is temporary solution that is quick an easy to apply. We can have a broader discussion on how to improve that in the future, but I think for now this is ready to go and can be extended to other modules (and other packages teal.modules.clinical, teal.osprey etc).

card <- teal::report_card_template(
title = "Distribution Plot",
label = label,
with_filter = env$with_filter,
filter_panel_api = env$filter_panel_api
)
card$append_text("Plot", "header3")
if (env$input$tabs == "Histogram") {
card$append_plot(env$dist_r(), dim = env$pws1$dim())
} else if (env$input$tabs == "QQplot") {
card$append_plot(env$qq_r(), dim = env$pws2$dim())
}
card$append_text("Statistics table", "header3")

card$append_table(env$common_q()[["summary_table"]])
tests_error <- tryCatch(expr = env$tests_r(), error = function(e) "error")
if (inherits(tests_error, "data.frame")) {
card$append_text("Tests table", "header3")
card$append_table(env$tests_r())
}

if (!comment == "") {
card$append_text("Comment", "header3")
card$append_text(comment)
}
card$append_src(teal.code::get_code(env$output_q()))
card
}
4 changes: 4 additions & 0 deletions R/utils.R
Original file line number Diff line number Diff line change
Expand Up @@ -35,6 +35,10 @@
#' - When the length of `size` is three: the plot points size are dynamically adjusted based on
#' vector of `value`, `min`, and `max`.
#'
#' @param card_function (`function`) optional, custom function to create a report card.
#' See [this vignette](https://insightsengineering.github.io/teal/latest-tag/articles/adding-support-for-reporting.html)
#' for details.
#'
#' @return Object of class `teal_module` to be used in `teal` applications.
#'
#' @name shared_params
Expand Down
4 changes: 4 additions & 0 deletions man/shared_params.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

13 changes: 9 additions & 4 deletions man/tm_g_distribution.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Loading