-
-
Notifications
You must be signed in to change notification settings - Fork 15
{teal}
module returns a teal_report
object that extends from teal_data
#884
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
base: main
Are you sure you want to change the base?
Changes from 41 commits
78d35c9
38ee62e
9c498c1
334509b
61ab554
2d091a5
8162a8c
e734d5c
f0600dc
ad5299c
c283343
ba0e71e
38eb4a5
c8f488a
719fdaa
6ed5cbd
3db8aaa
1384b90
0ef73eb
c0a2880
d61561f
6773637
0f74447
630204b
e3b5a0b
fdd9f89
0f82001
9b324b0
83e41a5
229def2
6fc9beb
6d86ebc
508e3b2
3f82dca
45b9080
52b4d59
162b917
df02409
7c2dc13
85f15de
5ad53e9
3bbf228
b64c3d7
16c525b
File filter
Filter by extension
Conversations
Jump to
Diff view
Diff view
There are no files selected for viewing
Original file line number | Diff line number | Diff line change | ||||
---|---|---|---|---|---|---|
|
@@ -47,6 +47,8 @@ | |||||
#' To learn more please refer to the vignette | ||||||
#' `vignette("transform-module-output", package = "teal")` or the [`teal::teal_transform_module()`] documentation. | ||||||
#' | ||||||
#' @inheritSection teal::example_module Reporting | ||||||
#' | ||||||
#' @examplesShinylive | ||||||
#' library(teal.modules.general) | ||||||
#' interactive <- function() TRUE | ||||||
|
@@ -235,9 +237,6 @@ ui_a_pca <- function(id, ...) { | |||||
uiOutput(ns("all_plots")) | ||||||
), | ||||||
encoding = tags$div( | ||||||
### Reporter | ||||||
teal.reporter::simple_reporter_ui(ns("simple_reporter")), | ||||||
### | ||||||
tags$label("Encodings", class = "text-primary"), | ||||||
teal.transform::datanames_input(args["dat"]), | ||||||
teal.transform::data_extract_ui( | ||||||
|
@@ -353,9 +352,7 @@ ui_a_pca <- function(id, ...) { | |||||
} | ||||||
|
||||||
# Server function for the PCA module | ||||||
srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, plot_width, ggplot2_args, decorators) { | ||||||
with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") | ||||||
with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") | ||||||
srv_a_pca <- function(id, data, dat, plot_height, plot_width, ggplot2_args, decorators) { | ||||||
checkmate::assert_class(data, "reactive") | ||||||
checkmate::assert_class(isolate(data()), "teal_data") | ||||||
moduleServer(id, function(input, output, session) { | ||||||
|
@@ -436,9 +433,16 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl | |||||
selector_list = selector_list, | ||||||
datasets = data | ||||||
) | ||||||
qenv <- reactive( | ||||||
teal.code::eval_code(data(), 'library("ggplot2");library("dplyr");library("tidyr")') # nolint quotes | ||||||
) | ||||||
qenv <- reactive({ | ||||||
obj <- data() | ||||||
teal.reporter::teal_card(obj) <- | ||||||
c( | ||||||
teal.reporter::teal_card("# Principal Component Analysis"), | ||||||
teal.reporter::teal_card(obj), | ||||||
teal.reporter::teal_card("## Module's code") | ||||||
) | ||||||
teal.code::eval_code(obj, 'library("ggplot2");library("dplyr");library("tidyr")') # nolint: quotes. | ||||||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. What do you think about this change? If you like it, I can find and replace all of these.
Suggested change
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. This is done in other modules There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. thanks |
||||||
}) | ||||||
anl_merged_q <- reactive({ | ||||||
req(anl_merged_input()) | ||||||
qenv() %>% | ||||||
|
@@ -514,6 +518,8 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl | |||||
) | ||||||
) | ||||||
|
||||||
teal.reporter::teal_card(qenv) <- c(teal.reporter::teal_card(qenv), "## Principal Components Table") | ||||||
|
||||||
qenv <- teal.code::eval_code( | ||||||
qenv, | ||||||
quote({ | ||||||
|
@@ -522,6 +528,8 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl | |||||
}) | ||||||
) | ||||||
|
||||||
teal.reporter::teal_card(qenv) <- c(teal.reporter::teal_card(qenv), "## Eigenvectors Table") | ||||||
|
||||||
teal.code::eval_code( | ||||||
qenv, | ||||||
quote({ | ||||||
|
@@ -602,7 +610,7 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl | |||||
), | ||||||
ggtheme = ggtheme | ||||||
) | ||||||
|
||||||
teal.reporter::teal_card(base_q) <- c(teal.reporter::teal_card(base_q), "## Elbow plot") | ||||||
teal.code::eval_code( | ||||||
base_q, | ||||||
substitute( | ||||||
|
@@ -679,6 +687,7 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl | |||||
ggtheme = ggtheme | ||||||
) | ||||||
|
||||||
teal.reporter::teal_card(base_q) <- c(teal.reporter::teal_card(base_q), "## Circle plot") | ||||||
teal.code::eval_code( | ||||||
base_q, | ||||||
substitute( | ||||||
|
@@ -737,6 +746,7 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl | |||||
size <- input$size | ||||||
font_size <- input$font_size | ||||||
|
||||||
teal.reporter::teal_card(base_q) <- c(teal.reporter::teal_card(base_q), "## Biplot") | ||||||
qenv <- teal.code::eval_code( | ||||||
qenv, | ||||||
substitute( | ||||||
|
@@ -997,6 +1007,7 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl | |||||
parsed_ggplot2_args$theme | ||||||
) | ||||||
|
||||||
teal.reporter::teal_card(base_q) <- c(teal.reporter::teal_card(base_q), "## Eigenvector plot") | ||||||
teal.code::eval_code( | ||||||
base_q, | ||||||
substitute( | ||||||
|
@@ -1038,9 +1049,8 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl | |||||
data = q, | ||||||
decorators = select_decorators(decorators, obj_name), | ||||||
expr = reactive({ | ||||||
substitute(print(.plot), env = list(.plot = as.name(obj_name))) | ||||||
}), | ||||||
expr_is_reactive = TRUE | ||||||
substitute(.plot, env = list(.plot = as.name(obj_name))) | ||||||
}) | ||||||
) | ||||||
}, | ||||||
names(output_q), | ||||||
|
@@ -1132,31 +1142,6 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl | |||||
verbatim_content = source_code_r, | ||||||
title = "R Code for PCA" | ||||||
) | ||||||
|
||||||
### REPORTER | ||||||
if (with_reporter) { | ||||||
card_fun <- function(comment, label) { | ||||||
card <- teal::report_card_template( | ||||||
title = "Principal Component Analysis Plot", | ||||||
label = label, | ||||||
with_filter = with_filter, | ||||||
filter_panel_api = filter_panel_api | ||||||
) | ||||||
card$append_text("Principal Components Table", "header3") | ||||||
card$append_table(computation()[["tbl_importance"]]) | ||||||
card$append_text("Eigenvectors Table", "header3") | ||||||
card$append_table(computation()[["tbl_eigenvector"]]) | ||||||
card$append_text("Plot", "header3") | ||||||
card$append_plot(plot_r(), dim = pws$dim()) | ||||||
if (!comment == "") { | ||||||
card$append_text("Comment", "header3") | ||||||
card$append_text(comment) | ||||||
} | ||||||
card$append_src(source_code_r()) | ||||||
card | ||||||
} | ||||||
teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) | ||||||
} | ||||||
### | ||||||
decorated_output_q | ||||||
}) | ||||||
} |
Original file line number | Diff line number | Diff line change |
---|---|---|
|
@@ -67,6 +67,8 @@ | |
#' To learn more please refer to the vignette | ||
#' `vignette("transform-module-output", package = "teal")` or the [`teal::teal_transform_module()`] documentation. | ||
#' | ||
#' @inheritSection teal::example_module Reporting | ||
#' | ||
#' @examplesShinylive | ||
#' library(teal.modules.general) | ||
#' interactive <- function() TRUE | ||
|
@@ -285,9 +287,6 @@ ui_a_regression <- function(id, ...) { | |
tags$div(verbatimTextOutput(ns("text"))) | ||
)), | ||
encoding = tags$div( | ||
### Reporter | ||
teal.reporter::simple_reporter_ui(ns("simple_reporter")), | ||
### | ||
tags$label("Encodings", class = "text-primary"), tags$br(), | ||
teal.transform::datanames_input(args[c("response", "regressor")]), | ||
teal.transform::data_extract_ui( | ||
|
@@ -386,17 +385,13 @@ ui_a_regression <- function(id, ...) { | |
# Server function for the regression module | ||
srv_a_regression <- function(id, | ||
data, | ||
reporter, | ||
filter_panel_api, | ||
response, | ||
regressor, | ||
plot_height, | ||
plot_width, | ||
ggplot2_args, | ||
default_outlier_label, | ||
decorators) { | ||
with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") | ||
with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") | ||
checkmate::assert_class(data, "reactive") | ||
checkmate::assert_class(isolate(data()), "teal_data") | ||
moduleServer(id, function(input, output, session) { | ||
|
@@ -462,9 +457,16 @@ srv_a_regression <- function(id, | |
) | ||
}) | ||
|
||
qenv <- reactive( | ||
teal.code::eval_code(data(), 'library("ggplot2");library("dplyr")') # nolint quotes | ||
) | ||
qenv <- reactive({ | ||
obj <- data() | ||
teal.reporter::teal_card(obj) <- | ||
c( | ||
teal.reporter::teal_card("# Linear Regression Plot"), | ||
teal.reporter::teal_card(obj), | ||
teal.reporter::teal_card("## Module's code") | ||
) | ||
teal.code::eval_code(obj, 'library("ggplot2");library("dplyr")') # nolint: quotes. | ||
}) | ||
|
||
anl_merged_q <- reactive({ | ||
req(anl_merged_input()) | ||
|
@@ -526,7 +528,7 @@ srv_a_regression <- function(id, | |
) | ||
} | ||
|
||
anl_merged_q() %>% | ||
anl_fit <- anl_merged_q() %>% | ||
teal.code::eval_code(substitute(fit <- stats::lm(form, data = ANL), env = list(form = form))) %>% | ||
teal.code::eval_code(quote({ | ||
for (regressor in names(fit$contrasts)) { | ||
|
@@ -536,7 +538,12 @@ srv_a_regression <- function(id, | |
) | ||
} | ||
})) %>% | ||
teal.code::eval_code(quote(summary(fit))) | ||
teal.code::eval_code(quote({ | ||
fit_summary <- summary(fit) | ||
fit_summary | ||
})) | ||
teal.reporter::teal_card(anl_fit) <- c(teal.reporter::teal_card(anl_fit), "## Plot") | ||
anl_fit | ||
}) | ||
|
||
label_col <- reactive({ | ||
|
@@ -982,7 +989,7 @@ srv_a_regression <- function(id, | |
|
||
output_q <- reactive({ | ||
teal::validate_inputs(iv_r()) | ||
switch(input$plot_type, | ||
obj <- switch(input$plot_type, | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Result will be the switch, why use There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Yeah, instead of obj <- switch(input$plot_type,
"Response vs Regressor" = output_plot_0(),
"Residuals vs Fitted" = output_plot_1(),
"Normal Q-Q" = output_plot_2(),
"Scale-Location" = output_plot_3(),
"Cook's distance" = output_plot_4(),
"Residuals vs Leverage" = output_plot_5(),
"Cook's dist vs Leverage" = output_plot_6()
)
obj we can go with switch(input$plot_type,
"Response vs Regressor" = output_plot_0(),
"Residuals vs Fitted" = output_plot_1(),
"Normal Q-Q" = output_plot_2(),
"Scale-Location" = output_plot_3(),
"Cook's distance" = output_plot_4(),
"Residuals vs Leverage" = output_plot_5(),
"Cook's dist vs Leverage" = output_plot_6()
) |
||
"Response vs Regressor" = output_plot_0(), | ||
"Residuals vs Fitted" = output_plot_1(), | ||
"Normal Q-Q" = output_plot_2(), | ||
|
@@ -991,21 +998,22 @@ srv_a_regression <- function(id, | |
"Residuals vs Leverage" = output_plot_5(), | ||
"Cook's dist vs Leverage" = output_plot_6() | ||
) | ||
obj | ||
}) | ||
|
||
decorated_output_q <- srv_decorate_teal_data( | ||
"decorator", | ||
data = output_q, | ||
decorators = select_decorators(decorators, "plot"), | ||
expr = plot | ||
expr = quote(plot) | ||
) | ||
|
||
fitted <- reactive({ | ||
req(output_q()) | ||
req(decorated_output_q()) | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. ❤️ good catch on both of these |
||
decorated_output_q()[["fit"]] | ||
}) | ||
plot_r <- reactive({ | ||
req(output_q()) | ||
req(decorated_output_q()) | ||
decorated_output_q()[["plot"]] | ||
}) | ||
|
||
|
@@ -1032,26 +1040,6 @@ srv_a_regression <- function(id, | |
title = "R code for the regression plot", | ||
) | ||
|
||
### REPORTER | ||
if (with_reporter) { | ||
card_fun <- function(comment, label) { | ||
card <- teal::report_card_template( | ||
title = "Linear Regression Plot", | ||
label = label, | ||
with_filter = with_filter, | ||
filter_panel_api = filter_panel_api | ||
) | ||
card$append_text("Plot", "header3") | ||
card$append_plot(plot_r(), dim = pws$dim()) | ||
if (!comment == "") { | ||
card$append_text("Comment", "header3") | ||
card$append_text(comment) | ||
} | ||
card$append_src(source_code_r()) | ||
card | ||
} | ||
teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) | ||
} | ||
### | ||
decorated_output_q | ||
}) | ||
} |
Uh oh!
There was an error while loading. Please reload this page.