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.

Sign up for GitHub

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 custom card functions in modules #737

Open
wants to merge 15 commits into
base: main
Choose a base branch
from
Open

736 Allow custom card functions in modules #737

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
15 commits
Select commit Hold shift + click to select a range
59da2e1
add hydrate_function
chlebowa Apr 19, 2024
55dc29e
upgrade rlang dependency
chlebowa Apr 19, 2024
e2a1a40
isolate card function and add arguments in tm_g_distribution
chlebowa Apr 19, 2024
676b2af
amend documentation
chlebowa Apr 19, 2024
180be37
amend NEWS
chlebowa Apr 19, 2024
d13fb79
add missing roxygen tag
chlebowa Apr 19, 2024
377da56
Merge branch 'main' into custom_card_functions@main
chlebowa Apr 19, 2024
e33a666
Merge branch 'main' into custom_card_functions@main
chlebowa Apr 22, 2024
e2f51bb
improve argument name
chlebowa Apr 22, 2024
ae91503
Merge branch 'main' into custom_card_functions@main
chlebowa Apr 23, 2024
5282405
Merge branch 'main' into custom_card_functions@main
chlebowa Apr 24, 2024
76c118d
fix documentation
chlebowa Apr 24, 2024
54b5e09
Merge branch 'main' into custom_card_functions@main
chlebowa May 2, 2024
3023fb2
Merge branch 'main' into custom_card_functions@main
chlebowa May 27, 2024
1df517c
Merge branch 'main' into custom_card_functions@main
m7pr Jul 1, 2024
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
4 changes: 3 additions & 1 deletion DESCRIPTION
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -35,6 +35,8 @@ Imports:
DT (>= 0.13),
forcats (>= 1.0.0),
grid,
logger (>= 0.3.0),
Copy link
Contributor

Choose a reason for hiding this comment

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

Suggested change
logger (>= 0.3.0),

rlang (>= 1.0.0),
scales,
shinyjs,
shinyTree (>= 0.2.8),
Expand Down Expand Up @@ -82,7 +84,7 @@ VignetteBuilder:
Config/Needs/verdepcheck: haleyjeppson/ggmosaic, tidyverse/ggplot2,
rstudio/shiny, insightsengineering/teal,
insightsengineering/teal.transform, mllg/checkmate, tidyverse/dplyr,
rstudio/DT, tidyverse/forcats, r-lib/scales, daattali/shinyjs,
rstudio/DT, tidyverse/forcats, r-lib/rlang, r-lib/scales, daattali/shinyjs,
Copy link
Contributor

Choose a reason for hiding this comment

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

As rlang was introduced as a dependency, it also needs to be added here and in .pre-commit-config.yaml

shinyTree/shinyTree, rstudio/shinyvalidate, dreamRs/shinyWidgets,
tidyverse/stringr, insightsengineering/teal.code,
insightsengineering/teal.data, insightsengineering/teal.logger,
Expand Down
2 changes: 2 additions & 0 deletions NEWS.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,8 @@
### Enhancements
* Added `teal.logger` functionality for logging changes in shiny inputs in all modules.

* 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
79 changes: 45 additions & 34 deletions R/tm_g_distribution.R
View file
Open in desktop
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) {
Copy link
Contributor

Choose a reason for hiding this comment

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

Suggested change
card_function) {
card_function = tm_g_distribution_card_function) {

I would expose this so that it's visible which function is used. However that would require exposing N reporting cards for N modules

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)
}
Comment on lines +174 to +178
Copy link
Contributor

Choose a reason for hiding this comment

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

Then this can only be limited to an assert_function if we go with this approach https://github.com/insightsengineering/teal.modules.general/pull/737/files#r1671978213

# 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 @@ -350,7 +357,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 @@ -1276,37 +1284,40 @@ 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)
card_function <- hydrate_function(card_function, with_filter, filter_panel_api)
teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_function)
}
###
})
}

#' @keywords internal
tm_g_distribution_card_function <- function(comment, label) { #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.

my main concern is that this is not a true list of required arguments. We are using with_filter and filter_panel_api. Moreover, we are using dist_r(), pws1 and many more object from the parent environment.
You have addressed this with hydrate_function but I think it would be better not to be in need of such functionality. I can think of a few ways how to do this:

  • extend function arguments
  • pass data as environment
  • this being a module?

(I really hope that there is no strict check for these and only these argument somewhere in the teal.reporter).

Each has its pros and cons and we probably need to think more which one would be best for this task. Glad you stopped early to allow for a discussion like this.

Looking at the changes - this is how it was written in the past so I definitely not blaming you for this. This PR is a great opportunity to make it right.

Copy link
Contributor Author

Choose a reason for hiding this comment

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

(I really hope that there is no strict check for these and only these argument somewhere in the teal.reporter).

There is one, actually. I considered just adding ... to the card function's formals but that is forbidden. I think it would work but I am not sure about resolving conflicts between the variables passed to the ellipsis and bindings in the card function's parent environment. If we can figure out a way for the card functions to be pure, this would not be a problem.

I tried to limit the proposed changes to the module packages because I assumed modifying teal.reporter is off the table.

Note that passing the caller environment is not sufficient, at least in this module (I assume in others as well). with_filter and filter_panel_api are also required but they exist in the caller's parent frame, not in the caller itself.

I will be happy to discuss a satisfactory solution.

Note also that with the proposed solution the if (with_reporter) chunk would be the same in every module, which means _all code added to the module to enable reporting _would be the same in every module. The only difference would be the default card function, which is separate.

This in turn opens another possibility: have a function called with_reporter that would modify any module object by adding the code required for reporting into the module functions. Then adding support for reporting would be limited to something like modules(tm_g_distribution(...) |> with_reporter(card_fun = foo)). But that's a separate conversation.

Copy link
Contributor

Choose a reason for hiding this comment

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

Ahh that's bad :( Then I would say that please feel free to modify this in teal.reporter. I feel that this is the true root-cause of the issue. I also think that this (relaxing this check on formals) would make creating card-factory-fun much simpler and also encapsulated so that it can be run without any additional steps - just provide what's required.
That's exactly what I'm looking for - more simplicity. I'm a little bit afraid of introducing a requirement of hydrating a card-factory-fun. I don't think that most of our users (in particular: not developers) would handle this.

Copy link
Contributor Author

@chlebowa chlebowa Apr 23, 2024 •
edited
Loading

Choose a reason for hiding this comment

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

Have a look at this alternative: #742

I don't think it is full proof because of the way teal.reporter checks and handles formal arguments of card_fun:
https://github.com/insightsengineering/teal.reporter/blob/ad7fd2041f0d7cac83d0d97dbbe3ed7914a197ea/R/AddCardModule.R#L166

Note that environment shenanigans are already built into teal.reporter:
https://github.com/insightsengineering/teal.reporter/blob/ad7fd2041f0d7cac83d0d97dbbe3ed7914a197ea/R/AddCardModule.R#L173

EDIT: I had got a little bit of tunnel vision, with an added env argument wrapping the card function is not necessary. The alternative is not that bad now. Card functions are pure, though it may be tedious to reference env$ for all added bindings.

Copy link
Contributor

Choose a reason for hiding this comment

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

Haven't yet checked the alternative, but in this case I would opt for relaxing teal.reporter checks to allow passing ellipsis which would simply the process and would not require the usage of hydrating in this case.

Copy link
Contributor

Choose a reason for hiding this comment

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

passing env instead of ... also works!

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
}
57 changes: 57 additions & 0 deletions R/utils.R
View file
Open in desktop
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 Expand Up @@ -278,3 +282,56 @@ assert_single_selection <- function(x,
}
invisible(TRUE)
}

#' Hydrate a function's enclosing environment
#'
#' Add bindings of an environment to a function's parent environment.
#'
#' This allows any funciton to use bindings present in any environment
Copy link
Contributor

Choose a reason for hiding this comment

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

Suggested change
#' This allows any funciton to use bindings present in any environment
#' This allows any function to use bindings present in any environment

#' as if the funciton were defined there.
Copy link
Contributor

Choose a reason for hiding this comment

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

Suggested change
#' as if the funciton were defined there.
#' as if the function were defined there.

#' All bindings of the additional environment are added to the function's enclosure,
#' except bindings existing in the enclosure are _not_ overwritten.
#'
#' One may also want to add variables that are not bound in the caller
#' but are accessible from the caller, e.g. they exist in the caller's parent frame.
#' This may happen in `shiny` modules because `moduleServer` is called
#' by the module server function so the server funciton's arguments are in scope
Copy link
Contributor

Choose a reason for hiding this comment

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

Suggested change
#' by the module server function so the server funciton's arguments are in scope
#' by the module server function so the server function's arguments are in scope

#' of `moduleServer` but are not bindings in its environment.
#' Such variables should be passed to `...`.
#' As in the case of calling environment bindings, no overwriting will occur.
#'
#' Variables passed to `...` ass `name:value` pairs will be assigned with `value` under `name`.
#' Variables passed directly will be assigned under the same name.
#'
#' Note that the `added_env` argument must be passed named, otherwise it will be captured by `...`.
#'
#' @param fun (`function`)
#' @param ... additional variables to add to the new enclosure, see `Details`
#' @param added_env (`environment`) environment to hydrate `fun`'s enclosure with
#'
#' @return A `function` which will work just like `fun` but in a different scope.
#'
#' @keywords internal
#'
hydrate_function <- function(fun, ..., added_env = parent.frame()) {
enclos_env <- environment(fun)
env_new <- rlang::env_clone(enclos_env)

added_vars <- setdiff(names(added_env), names(enclos_env))
lapply(added_vars, function(nm) {
assign(nm, get0(nm, envir = added_env, inherits = FALSE), envir = env_new)
})

args <- list(...)
arg_names <- vapply(as.list(substitute(list(...)))[-1L], as.character, character(1L))
names(arg_names)[names(arg_names) == ""] <- arg_names[names(arg_names) == ""]
names(args) <- arg_names

extras <- setdiff(arg_names, names(enclos_env))
lapply(extras, function(nm) {
assign(nm, args[[nm]], envir = env_new)
})

environment(fun) <- env_new
fun
}
41 changes: 41 additions & 0 deletions man/hydrate_function.Rd
View file
Open in desktop

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

4 changes: 4 additions & 0 deletions man/shared_params.Rd
View file
Open in desktop

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
View file
Open in desktop

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

Loading