diff --git a/DESCRIPTION b/DESCRIPTION index 68ecdd84..72507860 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -50,6 +50,7 @@ Imports: SummarizedExperiment, teal.data (>= 0.1.1), teal.logger (>= 0.1.0), + teal.reporter (>= 0.1.0), teal.widgets (>= 0.1.1), tern (>= 0.7.8) Suggests: diff --git a/NEWS.md b/NEWS.md index bef58a35..70d434ad 100644 --- a/NEWS.md +++ b/NEWS.md @@ -3,6 +3,7 @@ # teal.modules.hermes 0.1.3 * Improve the selection of sample variables in the forest module (`tm_g_forest_tte`) such that only categorical variables can be selected in the first place. +* Added the `teal.reporter` functionality to all modules. ### Miscellaneous * Added a template to the `pkgdown` site. diff --git a/R/argument_convention.R b/R/argument_convention.R index a03a9fc8..5dab615b 100644 --- a/R/argument_convention.R +++ b/R/argument_convention.R @@ -33,6 +33,7 @@ #' @param summary_funs (named `list` of functions or `NULL`)\cr functions which can be used #' in the the gene signatures. For modules that support also multiple genes without #' summary, `NULL` can be included to not summarize the genes but provide all of them. +#' @param reporter (`Reporter`) object #' @param pre_output (`shiny.tag` or `NULL`)\cr #' placed before the output to put the output into context (for example a title). #' @param post_output (`shiny.tag` or `NULL`)\cr diff --git a/R/barplot.R b/R/barplot.R index 54a1325e..40b0062b 100644 --- a/R/barplot.R +++ b/R/barplot.R @@ -76,6 +76,14 @@ ui_g_barplot <- function(id, ns <- NS(id) teal.widgets::standard_layout( encoding = div( + ### Reporter + shiny::tags$div( + teal.reporter::add_card_button_ui(ns("addReportCard")), + teal.reporter::download_report_button_ui(ns("downloadButton")), + teal.reporter::reset_report_button_ui(ns("resetButton")) + ), + shiny::tags$br(), + ### tags$label("Encodings", class = "text-primary"), helpText("Analysis of MAE:", tags$code(mae_name)), experimentSpecInput(ns("experiment"), datasets, mae_name), @@ -112,9 +120,11 @@ ui_g_barplot <- function(id, #' @export srv_g_barplot <- function(id, datasets, + reporter, mae_name, exclude_assays, summary_funs) { + with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") moduleServer(id, function(input, output, session) { experiment <- experimentSpecServer( "experiment", @@ -137,7 +147,7 @@ srv_g_barplot <- function(id, gene_choices = experiment$genes ) - output$plot <- renderPlot({ + plot_r <- reactive({ # Resolve all reactivity. experiment_data <- multi$experiment_data() facet_var <- multi$vars$facet() @@ -171,6 +181,55 @@ srv_g_barplot <- function(id, percentiles = percentiles ) }) + output$plot <- renderPlot(plot_r()) + ### REPORTER + if (with_reporter) { + card_fun <- function(comment) { + card <- teal.reporter::TealReportCard$new() + card$set_name("Barplot") + card$append_text("Barplot", "header2") + card$append_text("Filter State", "header3") + card$append_fs(datasets$get_filter_state()) + card$append_text("Selected Options", "header3") + encodings_list <- list( + "Experiment:", + input$`experiment-name`, + "\nAssay:", + input$`assay-name`, + "\nFacetting Variable:", + input$`facet-sample_var`, + "\nGenes Selected:", + paste0(input$`x-genes`, collapse = ", "), + "\nGene Summary:", + input$`x-fun_name`, + "\nQuantiles:", + paste0(input$percentiles, collapse = ", "), + "\nOptional Fill Variable:", + input$`fill-sample_var` + ) + null_encodings_indices <- which(sapply(encodings_list, function(x) is.null(x) || x == "")) + final_encodings <- if (length(null_encodings_indices) > 0) { + null_encodings_indices_1 <- c(null_encodings_indices, null_encodings_indices - 1) + paste(encodings_list[-null_encodings_indices_1], collapse = " ") + } else { + paste(encodings_list, collapse = " ") + } + + card$append_text(final_encodings, style = "verbatim") + card$append_text("Plot", "header3") + card$append_plot(plot_r()) + if (!comment == "") { + card$append_text("Comment", "header3") + card$append_text(comment) + } + card + } + + teal.reporter::add_card_button_srv("addReportCard", reporter = reporter, card_fun = card_fun) + teal.reporter::download_report_button_srv("downloadButton", reporter = reporter) + teal.reporter::reset_report_button_srv("resetButton", reporter) + } + ### }) } diff --git a/R/boxplot.R b/R/boxplot.R index 274d338e..6177c32b 100644 --- a/R/boxplot.R +++ b/R/boxplot.R @@ -78,6 +78,14 @@ ui_g_boxplot <- function(id, teal.widgets::standard_layout( encoding = div( + ### Reporter + shiny::tags$div( + teal.reporter::add_card_button_ui(ns("addReportCard")), + teal.reporter::download_report_button_ui(ns("downloadButton")), + teal.reporter::reset_report_button_ui(ns("resetButton")) + ), + shiny::tags$br(), + ### tags$label("Encodings", class = "text-primary"), helpText("Analysis of MAE:", tags$code(mae_name)), experimentSpecInput(ns("experiment"), datasets, mae_name), @@ -109,9 +117,11 @@ ui_g_boxplot <- function(id, #' @export srv_g_boxplot <- function(id, datasets, + reporter, mae_name, exclude_assays, summary_funs) { + with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") moduleServer(id, function(input, output, session) { experiment <- experimentSpecServer( "experiment", @@ -133,7 +143,7 @@ srv_g_boxplot <- function(id, funs = summary_funs, gene_choices = experiment$genes ) - output$plot <- renderPlot({ + plot_r <- reactive({ # Resolve all reactivity. experiment_data <- multi$experiment_data() strat <- multi$vars$strat() @@ -167,6 +177,62 @@ srv_g_boxplot <- function(id, violin = violin ) }) + output$plot <- renderPlot(plot_r()) + + ### REPORTER + if (with_reporter) { + card_fun <- function(comment) { + card <- teal.reporter::TealReportCard$new() + card$set_name("Boxplot") + card$append_text("Boxplot", "header2") + card$append_text("Filter State", "header3") + card$append_fs(datasets$get_filter_state()) + card$append_text("Selected Options", "header3") + encodings_list <- list( + "Experiment:", + input$`experiment-name`, + "\nAssay:", + input$`assay-name`, + "\nFacetting Variable:", + input$`facet-sample_var`, + "\nGenes Selected:", + paste0(input$`genes-genes`, collapse = ", "), + "\nGene Summary:", + input$`genes-fun_name`, + "\nJitter:", + input$jitter, + "\nViolin:", + input$violin, + "\nOptional Stratifying Variable:", + input$`strat-sample_var`, + "\nOptional Color Variable:", + input$`color-sample_var`, + "\nOptional Facet Variable:", + input$`facet-sample_var` + ) + null_encodings_indices <- which(sapply(encodings_list, function(x) is.null(x) || x == "")) + final_encodings <- if (length(null_encodings_indices) > 0) { + null_encodings_indices_1 <- c(null_encodings_indices, null_encodings_indices - 1) + paste(encodings_list[-null_encodings_indices_1], collapse = " ") + } else { + paste(encodings_list, collapse = " ") + } + + card$append_text(final_encodings, style = "verbatim") + card$append_text("Plot", "header3") + card$append_plot(plot_r()) + if (!comment == "") { + card$append_text("Comment", "header3") + card$append_text(comment) + } + card + } + + teal.reporter::add_card_button_srv("addReportCard", reporter = reporter, card_fun = card_fun) + teal.reporter::download_report_button_srv("downloadButton", reporter = reporter) + teal.reporter::reset_report_button_srv("resetButton", reporter) + } + ### }) } diff --git a/R/forestplot.R b/R/forestplot.R index 8f9ea6f8..908d5881 100644 --- a/R/forestplot.R +++ b/R/forestplot.R @@ -104,6 +104,14 @@ ui_g_forest_tte <- function(id, ns <- NS(id) teal.widgets::standard_layout( encoding = div( + ### Reporter + shiny::tags$div( + teal.reporter::add_card_button_ui(ns("addReportCard")), + teal.reporter::download_report_button_ui(ns("downloadButton")), + teal.reporter::reset_report_button_ui(ns("resetButton")) + ), + shiny::tags$br(), + ### tags$label("Encodings", class = "text-primary"), helpText("Analysis of MAE:", tags$code(mae_name)), experimentSpecInput(ns("experiment"), datasets, mae_name), @@ -132,6 +140,7 @@ ui_g_forest_tte <- function(id, #' @export srv_g_forest_tte <- function(id, datasets, + reporter, adtte_name, mae_name, adtte_vars, @@ -139,6 +148,7 @@ srv_g_forest_tte <- function(id, summary_funs, plot_height, plot_width) { + with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") moduleServer(id, function(input, output, session) { experiment <- experimentSpecServer( "experiment", @@ -210,12 +220,61 @@ srv_g_forest_tte <- function(id, tern::g_forest(result) }) - teal.widgets::plot_with_settings_srv( + pws <- teal.widgets::plot_with_settings_srv( id = "plot", plot_r = forest_plot, height = plot_height, width = plot_width ) + + ### REPORTER + if (with_reporter) { + card_fun <- function(comment) { + card <- teal.reporter::TealReportCard$new() + card$set_name("Forest Plot") + card$append_text("Forest Plot", "header2") + card$append_text("Filter State", "header3") + card$append_fs(datasets$get_filter_state()) + card$append_text("Selected Options", "header3") + encodings_list <- list( + "Experiment:", + input$`experiment-name`, + "\nAssay:", + input$`assay-name`, + "\nGenes Selected:", + paste0(input$`genes-genes`, collapse = ", "), + "\nGene Summary:", + input$`genes-fun_name`, + "\nEndpoint:", + input$`adtte-paramcd`, + "\nProbability Cutoff:", + input$probs, + "\nSubgroup Variable:", + input$`subgroups-sample_var` + ) + null_encodings_indices <- which(sapply(encodings_list, function(x) is.null(x) || x == "")) + final_encodings <- if (length(null_encodings_indices) > 0) { + null_encodings_indices_1 <- c(null_encodings_indices, null_encodings_indices - 1) + paste(encodings_list[-null_encodings_indices_1], collapse = " ") + } else { + paste(encodings_list, collapse = " ") + } + + card$append_text(final_encodings, style = "verbatim") + card$append_text("Plot", "header3") + card$append_plot(forest_plot(), dim = pws$dim()) + if (!comment == "") { + card$append_text("Comment", "header3") + card$append_text(comment) + } + card + } + + teal.reporter::add_card_button_srv("addReportCard", reporter = reporter, card_fun = card_fun) + teal.reporter::download_report_button_srv("downloadButton", reporter = reporter) + teal.reporter::reset_report_button_srv("resetButton", reporter) + } + ### }) } diff --git a/R/km.R b/R/km.R index 22f6325e..0ebc82c7 100644 --- a/R/km.R +++ b/R/km.R @@ -106,6 +106,14 @@ ui_g_km <- function(id, teal.widgets::standard_layout( encoding = div( + ### Reporter + shiny::tags$div( + teal.reporter::add_card_button_ui(ns("addReportCard")), + teal.reporter::download_report_button_ui(ns("downloadButton")), + teal.reporter::reset_report_button_ui(ns("resetButton")) + ), + shiny::tags$br(), + ### tags$label("Encodings", class = "text-primary"), helpText("Analysis of MAE:", tags$code(mae_name)), experimentSpecInput(ns("experiment"), datasets, mae_name), @@ -140,11 +148,13 @@ ui_g_km <- function(id, #' @export srv_g_km <- function(id, datasets, + reporter, adtte_name, mae_name, adtte_vars, summary_funs, exclude_assays) { + with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") moduleServer(id, function(input, output, session) { experiment <- experimentSpecServer( "experiment", @@ -190,7 +200,7 @@ srv_g_km <- function(id, probs = percentiles_without_borders ) - output$km_plot <- renderPlot({ + km_plot <- reactive({ strata_var <- strata$sample_var() binned_adtte <- adtte$binned_adtte_subset() @@ -202,6 +212,57 @@ srv_g_km <- function(id, ) tern::g_km(binned_adtte, variables = variables, annot_coxph = TRUE) }) + + output$km_plot <- renderPlot(km_plot()) + + ### REPORTER + if (with_reporter) { + card_fun <- function(comment) { + card <- teal.reporter::TealReportCard$new() + card$set_name("Kaplan-Meier Plot") + card$append_text("Kaplan-Meier Plot", "header2") + card$append_text("Filter State", "header3") + card$append_fs(datasets$get_filter_state()) + card$append_text("Selected Options", "header3") + encodings_list <- list( + "Experiment:", + input$`experiment-name`, + "\nAssay:", + input$`assay-name`, + "\nGenes Selected:", + paste0(input$`genes-genes`, collapse = ", "), + "\nGene Summary:", + input$`genes-fun_name`, + "\nEndpoint:", + input$`adtte-paramcd`, + "\nStrata Selected:", + input$`strata-sample_var`, + "\nQuantiles Displayed:", + paste0(input$percentiles, collapse = "-") + ) + null_encodings_indices <- which(sapply(encodings_list, function(x) is.null(x) || x == "")) + final_encodings <- if (length(null_encodings_indices) > 0) { + null_encodings_indices_1 <- c(null_encodings_indices, null_encodings_indices - 1) + paste(encodings_list[-null_encodings_indices_1], collapse = " ") + } else { + paste(encodings_list, collapse = " ") + } + + card$append_text(final_encodings, style = "verbatim") + card$append_text("Plot", "header3") + card$append_plot(km_plot()) + if (!comment == "") { + card$append_text("Comment", "header3") + card$append_text(comment) + } + card + } + + teal.reporter::add_card_button_srv("addReportCard", reporter = reporter, card_fun = card_fun) + teal.reporter::download_report_button_srv("downloadButton", reporter = reporter) + teal.reporter::reset_report_button_srv("resetButton", reporter) + } + ### }) } diff --git a/R/pca.R b/R/pca.R index 6fa0944d..d99843fd 100644 --- a/R/pca.R +++ b/R/pca.R @@ -69,6 +69,14 @@ ui_g_pca <- function(id, teal.widgets::standard_layout( encoding = div( + ### Reporter + shiny::tags$div( + teal.reporter::add_card_button_ui(ns("addReportCard")), + teal.reporter::download_report_button_ui(ns("downloadButton")), + teal.reporter::reset_report_button_ui(ns("resetButton")) + ), + shiny::tags$br(), + ### tags$label("Encodings", class = "text-primary"), helpText("Analysis of MAE:", tags$code(mae_name)), experimentSpecInput(ns("experiment"), datasets, mae_name), @@ -148,8 +156,10 @@ ui_g_pca <- function(id, #' @export srv_g_pca <- function(id, datasets, + reporter, mae_name, exclude_assays) { + with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") moduleServer(id, function(input, output, session) { experiment <- experimentSpecServer( "experiment", @@ -275,7 +285,7 @@ srv_g_pca <- function(id, }) # Render plot PCA output. - output$plot_pca <- renderPlot({ + plot_pca <- reactive({ # Resolve all reactivity. pca_result <- pca_result() experiment_data <- color$experiment_data() @@ -312,9 +322,10 @@ srv_g_pca <- function(id, label.show.legend = FALSE ) }) + output$plot_pca <- renderPlot(plot_pca()) # render correlation heatmap - output$plot_cor <- renderPlot({ + plot_cor <- reactive({ # Resolve all reactivity. cor_result <- cor_result() cluster_columns <- input$cluster_columns @@ -328,6 +339,93 @@ srv_g_pca <- function(id, cluster_columns = cluster_columns ) }) + output$plot_cor <- renderPlot(plot_cor()) + + ### REPORTER + if (with_reporter) { + card_fun <- function(comment) { + card <- teal.reporter::TealReportCard$new() + card$set_name("PCA") + card$append_text("PCA", "header2") + card$append_text("Filter State", "header3") + card$append_fs(datasets$get_filter_state()) + card$append_text("Selected Options", "header3") + if (input$tab_selected == "PCA") { + encodings_list <- list( + "Experiment:", + input$`experiment-name`, + "\nAssay:", + input$`assay-name`, + "\nOptional Color Variable:", + input$`color-sample_var`, + "\nX-axis PC:", + input$x_var, + "\nY-axis PC:", + input$y_var, + "\nUse Top Variance Genes:", + input$filter_top, + "\nNumber of Top Genes:", + input$n_top, + "\nShow Variance %:", + input$var_pct, + "\nShow Matrix:", + input$show_matrix, + "\nShow Label:", + input$label + ) + null_encodings_indices <- which(sapply(encodings_list, function(x) is.null(x) || x == "")) + final_encodings <- if (length(null_encodings_indices) > 0) { + null_encodings_indices_1 <- c(null_encodings_indices, null_encodings_indices - 1) + paste(encodings_list[-null_encodings_indices_1], collapse = " ") + } else { + paste(encodings_list, collapse = " ") + } + card$append_text(final_encodings, style = "verbatim") + card$append_text("Plot", "header3") + card$append_plot(plot_pca()) + card$append_text("Table", "header3") + card$append_table(show_matrix_pca()) + } else { + encodings_list <- list( + "Experiment:", + input$`experiment-name`, + "\nAssay:", + input$`assay-name`, + "\nUse Top Variance Genes:", + input$filter_top, + "\nNumber of Top Genes:", + input$top_n, + "\nCluster Columns:", + paste0(input$cluster_columns, collapse = ", "), + "\nShow Matrix:", + input$show_matrix + ) + null_encodings_indices <- which(sapply(encodings_list, function(x) is.null(x) || x == "")) + final_encodings <- if (length(null_encodings_indices) > 0) { + null_encodings_indices_1 <- c(null_encodings_indices, null_encodings_indices - 1) + paste(encodings_list[-null_encodings_indices_1], collapse = " ") + } else { + paste(encodings_list, collapse = " ") + } + + card$append_text(final_encodings, style = "verbatim") + card$append_text("Plot", "header3") + card$append_plot(plot_cor()) + card$append_text("Table", "header3") + card$append_table(show_matrix_cor()) + } + if (!comment == "") { + card$append_text("Comment", "header3") + card$append_text(comment) + } + card + } + + teal.reporter::add_card_button_srv("addReportCard", reporter = reporter, card_fun = card_fun) + teal.reporter::download_report_button_srv("downloadButton", reporter = reporter) + teal.reporter::reset_report_button_srv("resetButton", reporter) + } + ### }) } diff --git a/R/quality.R b/R/quality.R index b2b66b46..169de06a 100644 --- a/R/quality.R +++ b/R/quality.R @@ -120,6 +120,14 @@ ui_g_quality <- function(id, ns <- NS(id) teal.widgets::standard_layout( encoding = div( + ### Reporter + shiny::tags$div( + teal.reporter::add_card_button_ui(ns("addReportCard")), + teal.reporter::download_report_button_ui(ns("downloadButton")), + teal.reporter::reset_report_button_ui(ns("resetButton")) + ), + shiny::tags$br(), + ### tags$label("Encodings", class = "text-primary"), helpText("Analysis of MAE:", tags$code(mae_name)), experimentSpecInput(ns("experiment"), datasets, mae_name), @@ -193,8 +201,10 @@ ui_g_quality <- function(id, #' @export srv_g_quality <- function(id, datasets, + reporter, mae_name, exclude_assays) { + with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") moduleServer(id, function(input, output, session) { experiment <- experimentSpecServer( "experiment", @@ -320,7 +330,7 @@ srv_g_quality <- function(id, hermes::normalize(result) }) - output$plot <- renderPlot({ + plot_r <- reactive({ object_final <- object_final() plot_type <- input$plot_type assay_name <- assay() @@ -334,6 +344,65 @@ srv_g_quality <- function(id, "Correlation Heatmap" = heatmap_plot(object_final, assay_name = assay_name) ) }) + output$plot <- renderPlot(plot_r()) + + ### REPORTER + if (with_reporter) { + card_fun <- function(comment) { + card <- teal.reporter::TealReportCard$new() + card$set_name("Quality Control Plot") + card$append_text("Quality Control Plot", "header2") + card$append_text(tools::toTitleCase(input$plot_type), "header3") + card$append_text("Filter State", "header3") + card$append_fs(datasets$get_filter_state()) + card$append_text("Selected Options", "header3") + encodings_list <- list( + "Experiment:", + input$`experiment-name`, + "\nPlot Type:", + input$plot_type, + "\nAssay:", + input$`assay-name`, + "\nShow Gene Filter Settings:", + input$filter_gene, + "\nMinimum CPM:", + input$min_cpm, + "\nMinimum CPM Proportion:", + input$min_cpm_prop, + "\nRequired Annotations:", + paste(input$annotate, collapse = ", "), + "\nShow Sample Filter Settings:", + input$filter_sample, + "\nMinimum Correlation:", + input$min_corr, + "\nMinimum Depth:", + input$min_depth, + "\nMinimum Depth Value:", + input$min_depth_continuous + ) + null_encodings_indices <- which(sapply(encodings_list, function(x) is.null(x) || x == "")) + final_encodings <- if (length(null_encodings_indices) > 0) { + null_encodings_indices_1 <- c(null_encodings_indices, null_encodings_indices - 1) + paste(encodings_list[-null_encodings_indices_1], collapse = " ") + } else { + paste(encodings_list, collapse = " ") + } + + card$append_text(final_encodings, style = "verbatim") + card$append_text("Plot", "header3") + card$append_plot(plot_r()) + if (!comment == "") { + card$append_text("Comment", "header3") + card$append_text(comment) + } + card + } + + teal.reporter::add_card_button_srv("addReportCard", reporter = reporter, card_fun = card_fun) + teal.reporter::download_report_button_srv("downloadButton", reporter = reporter) + teal.reporter::reset_report_button_srv("resetButton", reporter) + } + ### }) } diff --git a/R/sampleVarSpec.R b/R/sampleVarSpec.R index f06086cf..06b413ad 100644 --- a/R/sampleVarSpec.R +++ b/R/sampleVarSpec.R @@ -476,7 +476,7 @@ sampleVarSpecServer <- function(id, #' experiment_name = reactive({ #' input$experiment_name #' }), -#' original_data = # Please update the +#' original_data = # Please update the #' ) #' # Then can extract the transformed data and selected variables later: #' experiment_data <- sample_var_specs$experiment_data() diff --git a/R/scatterplot.R b/R/scatterplot.R index b7c0f868..0de40cc1 100644 --- a/R/scatterplot.R +++ b/R/scatterplot.R @@ -83,6 +83,14 @@ ui_g_scatterplot <- function(id, teal.widgets::standard_layout( encoding = div( + ### Reporter + shiny::tags$div( + teal.reporter::add_card_button_ui(ns("addReportCard")), + teal.reporter::download_report_button_ui(ns("downloadButton")), + teal.reporter::reset_report_button_ui(ns("resetButton")) + ), + shiny::tags$br(), + ### tags$label("Encodings", class = "text-primary"), helpText("Analysis of MAE:", tags$code(mae_name)), experimentSpecInput(ns("experiment"), datasets, mae_name), @@ -111,9 +119,11 @@ ui_g_scatterplot <- function(id, #' @export srv_g_scatterplot <- function(id, datasets, + reporter, mae_name, exclude_assays, summary_funs) { + with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") moduleServer(id, function(input, output, session) { experiment <- experimentSpecServer( "experiment", @@ -133,7 +143,7 @@ srv_g_scatterplot <- function(id, x_spec <- geneSpecServer("x_spec", summary_funs, experiment$genes) y_spec <- geneSpecServer("y_spec", summary_funs, experiment$genes) - output$plot <- renderPlot({ + plot_r <- reactive({ # Resolve all reactivity. experiment_data <- sample_var_specs$experiment_data() x_spec <- x_spec() @@ -166,6 +176,60 @@ srv_g_scatterplot <- function(id, smooth_method = smooth_method ) }) + output$plot <- renderPlot(plot_r()) + + ### REPORTER + if (with_reporter) { + card_fun <- function(comment) { + card <- teal.reporter::TealReportCard$new() + card$set_name("Scatter Plot") + card$append_text("Scatter Plot", "header2") + card$append_text("Filter State", "header3") + card$append_fs(datasets$get_filter_state()) + card$append_text("Selected Options", "header3") + encodings_list <- list( + "Experiment:", + input$`experiment-name`, + "\nAssay:", + input$`assay-name`, + "\nX Genes Selected:", + paste0(input$`x_spec-genes`, collapse = ", "), + "\nX Genes Summary:", + input$`x_spec-fun_name`, + "\nY Genes Selected:", + paste0(input$`y_spec-genes`, collapse = ", "), + "\nY Genes Summary:", + input$`y_spec-fun_name`, + "\nOptional Color Variable:", + input$`color_var-sample_var`, + "\nOptional Facetting Variable:", + input$`facet_var-sample_var`, + "\nSmoother:", + input$smooth_method + ) + null_encodings_indices <- which(sapply(encodings_list, function(x) is.null(x) || x == "")) + final_encodings <- if (length(null_encodings_indices) > 0) { + null_encodings_indices_1 <- c(null_encodings_indices, null_encodings_indices - 1) + paste(encodings_list[-null_encodings_indices_1], collapse = " ") + } else { + paste(encodings_list, collapse = " ") + } + + card$append_text(final_encodings, style = "verbatim") + card$append_text("Plot", "header3") + card$append_plot(plot_r()) + if (!comment == "") { + card$append_text("Comment", "header3") + card$append_text(comment) + } + card + } + + teal.reporter::add_card_button_srv("addReportCard", reporter = reporter, card_fun = card_fun) + teal.reporter::download_report_button_srv("downloadButton", reporter = reporter) + teal.reporter::reset_report_button_srv("resetButton", reporter) + } + ### }) } diff --git a/R/volcanoplot.R b/R/volcanoplot.R index 67810a3a..9e171e7c 100644 --- a/R/volcanoplot.R +++ b/R/volcanoplot.R @@ -75,6 +75,14 @@ ui_g_volcanoplot <- function(id, pre_output = pre_output, post_output = post_output, encoding = div( + ### Reporter + shiny::tags$div( + teal.reporter::add_card_button_ui(ns("addReportCard")), + teal.reporter::download_report_button_ui(ns("downloadButton")), + teal.reporter::reset_report_button_ui(ns("resetButton")) + ), + shiny::tags$br(), + ### tags$label("Encodings", class = "text-primary"), helpText("Analysis of MAE:", tags$code(mae_name)), experimentSpecInput(ns("experiment"), datasets, mae_name), @@ -101,8 +109,10 @@ ui_g_volcanoplot <- function(id, #' @export srv_g_volcanoplot <- function(id, datasets, + reporter, mae_name, exclude_assays) { + with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") moduleServer(id, function(input, output, session) { experiment_data <- experimentSpecServer( "experiment", @@ -145,7 +155,7 @@ srv_g_volcanoplot <- function(id, ) }) - output$plot <- renderPlot({ + plot_r <- reactive({ diff_expr_result <- diff_expr() log2_fc_thresh <- input$log2_fc_thresh adj_p_val_thresh <- input$adj_p_val_thresh @@ -161,6 +171,7 @@ srv_g_volcanoplot <- function(id, log2_fc_thresh = log2_fc_thresh ) }) + output$plot <- renderPlot(plot_r()) # Display top genes if switched on. show_top_gene_diffexpr <- reactive({ @@ -189,6 +200,59 @@ srv_g_volcanoplot <- function(id, caption = "Top Differentiated Genes" ) }) + + ### REPORTER + if (with_reporter) { + card_fun <- function(comment) { + card <- teal.reporter::TealReportCard$new() + card$set_name("Scatter Plot") + card$append_text("Scatter Plot", "header2") + card$append_text("Filter State", "header3") + card$append_fs(datasets$get_filter_state()) + card$append_text("Selected Options", "header3") + encodings_list <- list( + "Experiment:", + input$`experiment-name`, + "\nAssay:", + input$`assay-name`, + "\nCompare Groups:", + input$`compare_group-sample_var`, + "\nShow Top Differentiated Genes:", + input$show_top_gene, + "\nMethod:", + input$method, + "\nLog2fold Change Threshold:", + input$log2_fc_thresh, + "\nAdjusted P-value Threshold:", + input$adj_p_val_thresh + ) + null_encodings_indices <- which(sapply(encodings_list, function(x) is.null(x) || x == "")) + final_encodings <- if (length(null_encodings_indices) > 0) { + null_encodings_indices_1 <- c(null_encodings_indices, null_encodings_indices - 1) + paste(encodings_list[-null_encodings_indices_1], collapse = " ") + } else { + paste(encodings_list, collapse = " ") + } + + card$append_text(final_encodings, style = "verbatim") + card$append_text("Plot", "header3") + card$append_plot(plot_r()) + if (isTRUE(input$show_top_gene)) { + card$append_text("Table", "header3") + card$append_table(show_top_gene_diffexpr()) + } + if (!comment == "") { + card$append_text("Comment", "header3") + card$append_text(comment) + } + card + } + + teal.reporter::add_card_button_srv("addReportCard", reporter = reporter, card_fun = card_fun) + teal.reporter::download_report_button_srv("downloadButton", reporter = reporter) + teal.reporter::reset_report_button_srv("resetButton", reporter) + } + ### }) } diff --git a/man/module_arguments.Rd b/man/module_arguments.Rd index bddcc09c..747f3c37 100644 --- a/man/module_arguments.Rd +++ b/man/module_arguments.Rd @@ -40,6 +40,8 @@ names of the assays which should not be included in choices in the teal module.} in the the gene signatures. For modules that support also multiple genes without summary, \code{NULL} can be included to not summarize the genes but provide all of them.} +\item{reporter}{(\code{Reporter}) object} + \item{pre_output}{(\code{shiny.tag} or \code{NULL})\cr placed before the output to put the output into context (for example a title).} diff --git a/man/multiSampleVarSpecServer.Rd b/man/multiSampleVarSpecServer.Rd index f70558ca..55f9f606 100644 --- a/man/multiSampleVarSpecServer.Rd +++ b/man/multiSampleVarSpecServer.Rd @@ -39,7 +39,7 @@ sample_var_specs <- multiSampleVarSpecServer( experiment_name = reactive({ input$experiment_name }), - original_data = # Please update the + original_data = # Please update the ) # Then can extract the transformed data and selected variables later: experiment_data <- sample_var_specs$experiment_data() diff --git a/man/tm_g_barplot.Rd b/man/tm_g_barplot.Rd index a6c69622..a0e90f54 100644 --- a/man/tm_g_barplot.Rd +++ b/man/tm_g_barplot.Rd @@ -19,7 +19,7 @@ tm_g_barplot( ui_g_barplot(id, datasets, mae_name, summary_funs, pre_output, post_output) -srv_g_barplot(id, datasets, mae_name, exclude_assays, summary_funs) +srv_g_barplot(id, datasets, reporter, mae_name, exclude_assays, summary_funs) sample_tm_g_barplot() } @@ -49,6 +49,8 @@ elements can be useful).} \item{datasets}{(\code{Datasets})\cr teal specific argument which is automatically passed to the UI and server functions, holding all the data sets provided in the app initialization.} + +\item{reporter}{(\code{Reporter}) object} } \value{ Shiny module to be used in the teal app. diff --git a/man/tm_g_boxplot.Rd b/man/tm_g_boxplot.Rd index 092c4498..685c7bff 100644 --- a/man/tm_g_boxplot.Rd +++ b/man/tm_g_boxplot.Rd @@ -19,7 +19,7 @@ tm_g_boxplot( ui_g_boxplot(id, datasets, mae_name, summary_funs, pre_output, post_output) -srv_g_boxplot(id, datasets, mae_name, exclude_assays, summary_funs) +srv_g_boxplot(id, datasets, reporter, mae_name, exclude_assays, summary_funs) sample_tm_g_boxplot() } @@ -49,6 +49,8 @@ elements can be useful).} \item{datasets}{(\code{Datasets})\cr teal specific argument which is automatically passed to the UI and server functions, holding all the data sets provided in the app initialization.} + +\item{reporter}{(\code{Reporter}) object} } \value{ Shiny module to be used in the teal app. diff --git a/man/tm_g_forest_tte.Rd b/man/tm_g_forest_tte.Rd index 94119f27..40d62d63 100644 --- a/man/tm_g_forest_tte.Rd +++ b/man/tm_g_forest_tte.Rd @@ -35,6 +35,7 @@ ui_g_forest_tte( srv_g_forest_tte( id, datasets, + reporter, adtte_name, mae_name, adtte_vars, @@ -94,6 +95,8 @@ and maximum plot width.} \item{datasets}{(\code{Datasets})\cr teal specific argument which is automatically passed to the UI and server functions, holding all the data sets provided in the app initialization.} + +\item{reporter}{(\code{Reporter}) object} } \value{ Shiny module to be used in the teal app. diff --git a/man/tm_g_km.Rd b/man/tm_g_km.Rd index db34ebe2..b646d392 100644 --- a/man/tm_g_km.Rd +++ b/man/tm_g_km.Rd @@ -33,6 +33,7 @@ ui_g_km( srv_g_km( id, datasets, + reporter, adtte_name, mae_name, adtte_vars, @@ -84,6 +85,8 @@ elements can be useful).} \item{datasets}{(\code{Datasets})\cr teal specific argument which is automatically passed to the UI and server functions, holding all the data sets provided in the app initialization.} + +\item{reporter}{(\code{Reporter}) object} } \value{ Shiny module to be used in the teal app. diff --git a/man/tm_g_pca.Rd b/man/tm_g_pca.Rd index 6f969c19..01145020 100644 --- a/man/tm_g_pca.Rd +++ b/man/tm_g_pca.Rd @@ -17,7 +17,7 @@ tm_g_pca( ui_g_pca(id, datasets, mae_name, pre_output, post_output) -srv_g_pca(id, datasets, mae_name, exclude_assays) +srv_g_pca(id, datasets, reporter, mae_name, exclude_assays) sample_tm_g_pca() } @@ -43,6 +43,8 @@ elements can be useful).} \item{datasets}{(\code{Datasets})\cr teal specific argument which is automatically passed to the UI and server functions, holding all the data sets provided in the app initialization.} + +\item{reporter}{(\code{Reporter}) object} } \value{ Shiny module to be used in the teal app. diff --git a/man/tm_g_quality.Rd b/man/tm_g_quality.Rd index 66e4d35f..6d2485fb 100644 --- a/man/tm_g_quality.Rd +++ b/man/tm_g_quality.Rd @@ -17,7 +17,7 @@ tm_g_quality( ui_g_quality(id, datasets, mae_name, pre_output, post_output) -srv_g_quality(id, datasets, mae_name, exclude_assays) +srv_g_quality(id, datasets, reporter, mae_name, exclude_assays) sample_tm_g_quality() } @@ -43,6 +43,8 @@ elements can be useful).} \item{datasets}{(\code{Datasets})\cr teal specific argument which is automatically passed to the UI and server functions, holding all the data sets provided in the app initialization.} + +\item{reporter}{(\code{Reporter}) object} } \value{ Shiny module to be used in the teal app. diff --git a/man/tm_g_scatterplot.Rd b/man/tm_g_scatterplot.Rd index 79dc56d5..5030eebb 100644 --- a/man/tm_g_scatterplot.Rd +++ b/man/tm_g_scatterplot.Rd @@ -19,7 +19,14 @@ tm_g_scatterplot( ui_g_scatterplot(id, datasets, mae_name, summary_funs, pre_output, post_output) -srv_g_scatterplot(id, datasets, mae_name, exclude_assays, summary_funs) +srv_g_scatterplot( + id, + datasets, + reporter, + mae_name, + exclude_assays, + summary_funs +) sample_tm_g_scatterplot() } @@ -49,6 +56,8 @@ elements can be useful).} \item{datasets}{(\code{Datasets})\cr teal specific argument which is automatically passed to the UI and server functions, holding all the data sets provided in the app initialization.} + +\item{reporter}{(\code{Reporter}) object} } \value{ Shiny module to be used in the teal app. diff --git a/man/tm_g_volcanoplot.Rd b/man/tm_g_volcanoplot.Rd index b1b3aef3..c89d366f 100644 --- a/man/tm_g_volcanoplot.Rd +++ b/man/tm_g_volcanoplot.Rd @@ -17,7 +17,7 @@ tm_g_volcanoplot( ui_g_volcanoplot(id, datasets, mae_name, pre_output, post_output) -srv_g_volcanoplot(id, datasets, mae_name, exclude_assays) +srv_g_volcanoplot(id, datasets, reporter, mae_name, exclude_assays) sample_tm_g_volcanoplot() } @@ -43,6 +43,8 @@ elements can be useful).} \item{datasets}{(\code{Datasets})\cr teal specific argument which is automatically passed to the UI and server functions, holding all the data sets provided in the app initialization.} + +\item{reporter}{(\code{Reporter}) object} } \value{ Shiny module to be used in the teal app. diff --git a/staged_dependencies.yaml b/staged_dependencies.yaml index ecdc8bb6..099daef9 100644 --- a/staged_dependencies.yaml +++ b/staged_dependencies.yaml @@ -14,6 +14,9 @@ upstream_repos: insightsengineering/teal.data: repo: insightsengineering/teal.data host: https://github.com + insightsengineering/teal.reporter: + repo: insightsengineering/teal.reporter + host: https://github.com insightsengineering/teal.widgets: repo: insightsengineering/teal.widgets host: https://github.com diff --git a/tests/testthat/_snaps/barplot.md b/tests/testthat/_snaps/barplot.md index 0ab6d643..be998c5e 100644 --- a/tests/testthat/_snaps/barplot.md +++ b/tests/testthat/_snaps/barplot.md @@ -196,7 +196,7 @@ -
+
diff --git a/tests/testthat/_snaps/barplot/final_plot.png b/tests/testthat/_snaps/barplot/final_plot.png index c62c9eb8..7c34af40 100644 Binary files a/tests/testthat/_snaps/barplot/final_plot.png and b/tests/testthat/_snaps/barplot/final_plot.png differ diff --git a/tests/testthat/_snaps/boxplot/boxplot.png b/tests/testthat/_snaps/boxplot/boxplot.png index 6ec322f2..26672d90 100644 Binary files a/tests/testthat/_snaps/boxplot/boxplot.png and b/tests/testthat/_snaps/boxplot/boxplot.png differ diff --git a/tests/testthat/_snaps/forest_tte/initial_plot.png b/tests/testthat/_snaps/forest_tte/initial_plot.png index 2b338851..b8f7c64b 100644 Binary files a/tests/testthat/_snaps/forest_tte/initial_plot.png and b/tests/testthat/_snaps/forest_tte/initial_plot.png differ diff --git a/tests/testthat/_snaps/geneSpec.md b/tests/testthat/_snaps/geneSpec.md index 9f73e29d..062dcecf 100644 --- a/tests/testthat/_snaps/geneSpec.md +++ b/tests/testthat/_snaps/geneSpec.md @@ -151,7 +151,7 @@
-
+
diff --git a/tests/testthat/_snaps/km.md b/tests/testthat/_snaps/km.md index 05c57502..8e47763e 100644 --- a/tests/testthat/_snaps/km.md +++ b/tests/testthat/_snaps/km.md @@ -178,7 +178,7 @@
-
+
diff --git a/tests/testthat/_snaps/km/initial_plot.png b/tests/testthat/_snaps/km/initial_plot.png index eba8f08d..166ab6a8 100644 Binary files a/tests/testthat/_snaps/km/initial_plot.png and b/tests/testthat/_snaps/km/initial_plot.png differ diff --git a/tests/testthat/_snaps/pca/initial_cor_plot.png b/tests/testthat/_snaps/pca/initial_cor_plot.png index af5d2ef5..4a281efb 100644 Binary files a/tests/testthat/_snaps/pca/initial_cor_plot.png and b/tests/testthat/_snaps/pca/initial_cor_plot.png differ diff --git a/tests/testthat/_snaps/pca/initial_cor_table.png b/tests/testthat/_snaps/pca/initial_cor_table.png index 254c2571..1736bdfe 100644 Binary files a/tests/testthat/_snaps/pca/initial_cor_table.png and b/tests/testthat/_snaps/pca/initial_cor_table.png differ diff --git a/tests/testthat/_snaps/pca/initial_pca_plot.png b/tests/testthat/_snaps/pca/initial_pca_plot.png index 2d90f6ca..d41160f4 100644 Binary files a/tests/testthat/_snaps/pca/initial_pca_plot.png and b/tests/testthat/_snaps/pca/initial_pca_plot.png differ diff --git a/tests/testthat/_snaps/pca/initial_pca_table.png b/tests/testthat/_snaps/pca/initial_pca_table.png index 757ac697..78f005d7 100644 Binary files a/tests/testthat/_snaps/pca/initial_pca_table.png and b/tests/testthat/_snaps/pca/initial_pca_table.png differ diff --git a/tests/testthat/_snaps/pca/update1_cor_plot.png b/tests/testthat/_snaps/pca/update1_cor_plot.png index 661d01eb..b54d8ac4 100644 Binary files a/tests/testthat/_snaps/pca/update1_cor_plot.png and b/tests/testthat/_snaps/pca/update1_cor_plot.png differ diff --git a/tests/testthat/_snaps/pca/update2_pca_plot.png b/tests/testthat/_snaps/pca/update2_pca_plot.png index 3b5c4451..677d5b95 100644 Binary files a/tests/testthat/_snaps/pca/update2_pca_plot.png and b/tests/testthat/_snaps/pca/update2_pca_plot.png differ diff --git a/tests/testthat/_snaps/pca/update3_pca_plot.png b/tests/testthat/_snaps/pca/update3_pca_plot.png index 46429d3d..0cb15d48 100644 Binary files a/tests/testthat/_snaps/pca/update3_pca_plot.png and b/tests/testthat/_snaps/pca/update3_pca_plot.png differ diff --git a/tests/testthat/_snaps/pca/update5_cor_table.png b/tests/testthat/_snaps/pca/update5_cor_table.png index 93ce1923..9464ead7 100644 Binary files a/tests/testthat/_snaps/pca/update5_cor_table.png and b/tests/testthat/_snaps/pca/update5_cor_table.png differ diff --git a/tests/testthat/_snaps/pca/update5_pca_plot.png b/tests/testthat/_snaps/pca/update5_pca_plot.png index 34b4ea32..bd6a0458 100644 Binary files a/tests/testthat/_snaps/pca/update5_pca_plot.png and b/tests/testthat/_snaps/pca/update5_pca_plot.png differ diff --git a/tests/testthat/_snaps/pca/update5_pca_table.png b/tests/testthat/_snaps/pca/update5_pca_table.png index 941b5231..ddac2bc9 100644 Binary files a/tests/testthat/_snaps/pca/update5_pca_table.png and b/tests/testthat/_snaps/pca/update5_pca_table.png differ diff --git a/tests/testthat/_snaps/pca/update6_pca_table.png b/tests/testthat/_snaps/pca/update6_pca_table.png index d909140a..de23c677 100644 Binary files a/tests/testthat/_snaps/pca/update6_pca_table.png and b/tests/testthat/_snaps/pca/update6_pca_table.png differ diff --git a/tests/testthat/_snaps/pca/update7_pca_table.png b/tests/testthat/_snaps/pca/update7_pca_table.png index 2d2fb130..897292c1 100644 Binary files a/tests/testthat/_snaps/pca/update7_pca_table.png and b/tests/testthat/_snaps/pca/update7_pca_table.png differ diff --git a/tests/testthat/_snaps/quality/final_plot.png b/tests/testthat/_snaps/quality/final_plot.png index 5c9fed2c..ffba00fb 100644 Binary files a/tests/testthat/_snaps/quality/final_plot.png and b/tests/testthat/_snaps/quality/final_plot.png differ diff --git a/tests/testthat/_snaps/quality/initial_plot.png b/tests/testthat/_snaps/quality/initial_plot.png index bf9c9677..38b20938 100644 Binary files a/tests/testthat/_snaps/quality/initial_plot.png and b/tests/testthat/_snaps/quality/initial_plot.png differ diff --git a/tests/testthat/_snaps/quality/top_genes_plot.png b/tests/testthat/_snaps/quality/top_genes_plot.png index aeb74549..3a3a12a0 100644 Binary files a/tests/testthat/_snaps/quality/top_genes_plot.png and b/tests/testthat/_snaps/quality/top_genes_plot.png differ diff --git a/tests/testthat/_snaps/scatterplot.md b/tests/testthat/_snaps/scatterplot.md index 01ab6fc2..cdb104d6 100644 --- a/tests/testthat/_snaps/scatterplot.md +++ b/tests/testthat/_snaps/scatterplot.md @@ -178,7 +178,7 @@
-
+
@@ -239,7 +239,7 @@
-
+
diff --git a/tests/testthat/_snaps/scatterplot/final_plot.png b/tests/testthat/_snaps/scatterplot/final_plot.png index d4bc53a2..ea99cc68 100644 Binary files a/tests/testthat/_snaps/scatterplot/final_plot.png and b/tests/testthat/_snaps/scatterplot/final_plot.png differ diff --git a/tests/testthat/_snaps/volcanoplot/final_plot.png b/tests/testthat/_snaps/volcanoplot/final_plot.png index be482732..fbc1cf04 100644 Binary files a/tests/testthat/_snaps/volcanoplot/final_plot.png and b/tests/testthat/_snaps/volcanoplot/final_plot.png differ diff --git a/tests/testthat/_snaps/volcanoplot/initial_plot.png b/tests/testthat/_snaps/volcanoplot/initial_plot.png index 22bf8a69..a3017a95 100644 Binary files a/tests/testthat/_snaps/volcanoplot/initial_plot.png and b/tests/testthat/_snaps/volcanoplot/initial_plot.png differ diff --git a/tests/testthat/test-barplot.R b/tests/testthat/test-barplot.R index c9c961ff..613c03f0 100644 --- a/tests/testthat/test-barplot.R +++ b/tests/testthat/test-barplot.R @@ -57,7 +57,7 @@ test_that("tm_g_barplot works as expected in the sample app", { # Check that gene list is updated now_x_spec_gene <- app$waitForValue(ns("x-genes"), ignore = "") - expect_null(now_x_spec_gene) + expect_identical(now_x_spec_gene, "GeneID:8086") # Check that assay list is updated now_assay <- app$waitForValue(ns("assay"), ignore = "")