From 986891a13490bfb900d3c6b7af4182493ff5c916 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dawid=20Ka=C5=82=C4=99dkowski?= <6959016+gogonzo@users.noreply.github.com> Date: Fri, 8 Dec 2023 14:37:17 +0100 Subject: [PATCH] tdata to teal_data (#603) Signed-off-by: kartikeya kirar Co-authored-by: Aleksander Chlebowski Co-authored-by: Aleksander Chlebowski <114988527+chlebowa@users.noreply.github.com> Co-authored-by: kartikeya kirar Co-authored-by: vedhav --- DESCRIPTION | 10 +-- NEWS.md | 2 +- R/tm_a_pca.R | 14 ++-- R/tm_a_regression.R | 10 +-- R/tm_data_table.R | 109 ++++++++++++++-------------- R/tm_front_page.R | 9 ++- R/tm_g_association.R | 12 ++-- R/tm_g_bivariate.R | 10 +-- R/tm_g_distribution.R | 10 +-- R/tm_g_response.R | 10 +-- R/tm_g_scatterplot.R | 8 +-- R/tm_g_scatterplotmatrix.R | 8 +-- R/tm_missing_data.R | 125 +++++++++++++++++--------------- R/tm_outliers.R | 14 ++-- R/tm_t_crosstable.R | 8 +-- R/tm_variable_browser.R | 141 ++++++++++++++----------------------- man/get_var_description.Rd | 22 ------ man/tm_front_page.Rd | 1 + 18 files changed, 238 insertions(+), 285 deletions(-) delete mode 100644 man/get_var_description.Rd diff --git a/DESCRIPTION b/DESCRIPTION index b3fbcda35..800d0d8ad 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -21,7 +21,7 @@ Depends: R (>= 3.6), shiny (>= 1.6.0), shinyTree, - teal (>= 0.14.0.9019) + teal (>= 0.14.0.9027) Imports: checkmate (>= 2.1.0), dplyr (>= 1.0.5), @@ -36,11 +36,11 @@ Imports: shinyWidgets (>= 0.5.1), stats, stringr (>= 1.4.1), - teal.code (>= 0.4.0), + teal.code (>= 0.4.1.9009), teal.logger (>= 0.1.1), teal.reporter (>= 0.2.0), - teal.slice (>= 0.4.0.9023), - teal.transform (>= 0.4.0.9007), + teal.slice (>= 0.4.0.9028), + teal.transform (>= 0.4.0.9011), teal.widgets (>= 0.4.0), tern (>= 0.7.10), tibble (>= 2.0.0), @@ -65,7 +65,7 @@ Suggests: rlang (>= 1.0.0), rtables (>= 0.5.1), sparkline, - teal.data (>= 0.3.0.9010), + teal.data (>= 0.3.0.9018), testthat (>= 3.0.4) VignetteBuilder: knitr diff --git a/NEWS.md b/NEWS.md index 2688dd5bf..316befc2a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# teal.modules.general 0.2.16.9012 +# teal.modules.general 0.2.16.9013 ### Enhancements diff --git a/R/tm_a_pca.R b/R/tm_a_pca.R index 692b32748..1606862a8 100644 --- a/R/tm_a_pca.R +++ b/R/tm_a_pca.R @@ -246,7 +246,8 @@ ui_a_pca <- function(id, ...) { srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, plot_width, ggplot2_args) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") - checkmate::assert_class(data, "tdata") + checkmate::assert_class(data, "reactive") + checkmate::assert_class(isolate(data()), "teal_data") moduleServer(id, function(input, output, session) { response <- dat @@ -254,10 +255,10 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl response[[i]]$select$multiple <- FALSE response[[i]]$select$always_selected <- NULL response[[i]]$select$selected <- NULL - response[[i]]$select$choices <- var_labels(data[[response[[i]]$dataname]]()) + response[[i]]$select$choices <- var_labels(isolate(data())[[response[[i]]$dataname]]) response[[i]]$select$choices <- setdiff( response[[i]]$select$choices, - unlist(teal.data::join_keys(data)[[response[[i]]$dataname]]) + unlist(teal.data::join_keys(isolate(data()))[[response[[i]]$dataname]]) ) } @@ -322,13 +323,12 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl anl_merged_input <- teal.transform::merge_expression_srv( selector_list = selector_list, - datasets = data, - join_keys = teal.data::join_keys(data) + datasets = data ) anl_merged_q <- reactive({ req(anl_merged_input()) - teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>% + data() %>% teal.code::eval_code(as.expression(anl_merged_input()$expr)) }) @@ -1016,7 +1016,7 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(paste(teal.code::get_code(output_q()), collapse = "\n")) + card$append_src(teal.code::get_code(output_q())) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_a_regression.R b/R/tm_a_regression.R index 775fbbca2..34e25eee3 100644 --- a/R/tm_a_regression.R +++ b/R/tm_a_regression.R @@ -246,7 +246,8 @@ srv_a_regression <- function(id, default_outlier_label) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") - checkmate::assert_class(data, "tdata") + checkmate::assert_class(data, "reactive") + checkmate::assert_class(isolate(data()), "teal_data") moduleServer(id, function(input, output, session) { rule_rvr1 <- function(value) { if (isTRUE(input$plot_type == "Response vs Regressor")) { @@ -294,8 +295,7 @@ srv_a_regression <- function(id, anl_merged_input <- teal.transform::merge_expression_srv( selector_list = selector_list, - datasets = data, - join_keys = teal.data::join_keys(data) + datasets = data ) regression_var <- reactive({ @@ -309,7 +309,7 @@ srv_a_regression <- function(id, anl_merged_q <- reactive({ req(anl_merged_input()) - teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>% + data() %>% teal.code::eval_code(as.expression(anl_merged_input()$expr)) }) @@ -886,7 +886,7 @@ srv_a_regression <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(paste(teal.code::get_code(output_q()), collapse = "\n")) + card$append_src(teal.code::get_code(output_q())) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_data_table.R b/R/tm_data_table.R index 6fbe64df5..96421f9a9 100644 --- a/R/tm_data_table.R +++ b/R/tm_data_table.R @@ -85,14 +85,13 @@ tm_data_table <- function(label = "Data Table", ui = ui_page_data_table, datanames = if (length(datasets_selected) == 0) "all" else datasets_selected, server_args = list( + variables_selected = variables_selected, datasets_selected = datasets_selected, dt_args = dt_args, dt_options = dt_options, server_rendering = server_rendering ), ui_args = list( - selected = variables_selected, - datasets_selected = datasets_selected, pre_output = pre_output, post_output = post_output ) @@ -102,20 +101,10 @@ tm_data_table <- function(label = "Data Table", # ui page module ui_page_data_table <- function(id, - data, - selected, - datasets_selected, pre_output = NULL, post_output = NULL) { ns <- NS(id) - datanames <- names(data) - - if (!identical(datasets_selected, character(0))) { - stopifnot(all(datasets_selected %in% datanames)) - datanames <- datasets_selected - } - shiny::tagList( include_css_files("custom"), teal.widgets::standard_layout( @@ -134,45 +123,7 @@ ui_page_data_table <- function(id, class = "mb-8", column( width = 12, - do.call( - tabsetPanel, - lapply( - datanames, - function(x) { - dataset <- isolate(data[[x]]()) - choices <- names(dataset) - labels <- vapply( - dataset, - function(x) ifelse(is.null(attr(x, "label")), "", attr(x, "label")), - character(1) - ) - names(choices) <- ifelse( - is.na(labels) | labels == "", - choices, - paste(choices, labels, sep = ": ") - ) - selected <- if (!is.null(selected[[x]])) { - selected[[x]] - } else { - utils::head(choices) - } - tabPanel( - title = x, - column( - width = 12, - div( - class = "mt-4", - ui_data_table( - id = ns(x), - choices = choices, - selected = selected - ) - ) - ) - ) - } - ) - ) + uiOutput(ns("dataset_table")) ) ) ), @@ -187,15 +138,63 @@ ui_page_data_table <- function(id, srv_page_data_table <- function(id, data, datasets_selected, + variables_selected, dt_args, dt_options, server_rendering) { - checkmate::assert_class(data, "tdata") + checkmate::assert_class(data, "reactive") + checkmate::assert_class(isolate(data()), "teal_data") moduleServer(id, function(input, output, session) { if_filtered <- reactive(as.logical(input$if_filtered)) if_distinct <- reactive(as.logical(input$if_distinct)) - datanames <- names(data) + datanames <- teal.data::datanames(isolate(data())) + if (!identical(datasets_selected, character(0))) { + checkmate::assert_subset(datasets_selected, datanames) + datanames <- datasets_selected + } + + output$dataset_table <- renderUI({ + do.call( + tabsetPanel, + lapply( + datanames, + function(x) { + dataset <- isolate(data()[[x]]) + choices <- names(dataset) + labels <- vapply( + dataset, + function(x) ifelse(is.null(attr(x, "label")), "", attr(x, "label")), + character(1) + ) + names(choices) <- ifelse( + is.na(labels) | labels == "", + choices, + paste(choices, labels, sep = ": ") + ) + variables_selected <- if (!is.null(variables_selected[[x]])) { + variables_selected[[x]] + } else { + utils::head(choices) + } + tabPanel( + title = x, + column( + width = 12, + div( + class = "mt-4", + ui_data_table( + id = session$ns(x), + choices = choices, + selected = variables_selected + ) + ) + ) + ) + } + ) + ) + }) lapply( datanames, @@ -256,14 +255,14 @@ srv_data_table <- function(id, iv <- shinyvalidate::InputValidator$new() iv$add_rule("variables", shinyvalidate::sv_required("Please select valid variable names")) iv$add_rule("variables", shinyvalidate::sv_in_set( - set = names(data[[dataname]]()), message_fmt = "Not all selected variables exist in the data" + set = names(data()[[dataname]]), message_fmt = "Not all selected variables exist in the data" )) iv$enable() output$data_table <- DT::renderDataTable(server = server_rendering, { teal::validate_inputs(iv) - df <- data[[dataname]]() + df <- data()[[dataname]] variables <- input$variables teal::validate_has_data(df, min_nrow = 1L, msg = paste("data", dataname, "is empty")) diff --git a/R/tm_front_page.R b/R/tm_front_page.R index 75616ae3d..aa755d64f 100644 --- a/R/tm_front_page.R +++ b/R/tm_front_page.R @@ -21,6 +21,7 @@ #' data <- within(data, { #' library(nestcolor) #' ADSL <- teal.modules.general::rADSL +#' attr(ADSL, "metadata") <- list("Author" = "NEST team", "data_source" = "synthetic data") #' }) #' datanames <- c("ADSL") #' datanames(data) <- datanames @@ -167,7 +168,8 @@ get_footer_tags <- function(footnotes) { } srv_front_page <- function(id, data, tables, show_metadata) { - checkmate::assert_class(data, "tdata") + checkmate::assert_class(data, "reactive") + checkmate::assert_class(isolate(data()), "teal_data") moduleServer(id, function(input, output, session) { ns <- session$ns @@ -193,9 +195,10 @@ srv_front_page <- function(id, data, tables, show_metadata) { ) metadata_data_frame <- reactive({ + datanames <- teal.data::datanames(data()) convert_metadata_to_dataframe( - lapply(names(data), function(dataname) get_metadata(data, dataname)), - names(data) + lapply(datanames, function(dataname) attr(data()[[dataname]], "metadata")), + datanames ) }) diff --git a/R/tm_g_association.R b/R/tm_g_association.R index 5907f4cda..2a4bf5625 100644 --- a/R/tm_g_association.R +++ b/R/tm_g_association.R @@ -222,7 +222,9 @@ srv_tm_g_association <- function(id, ggplot2_args) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") - checkmate::assert_class(data, "tdata") + checkmate::assert_class(data, "reactive") + checkmate::assert_class(isolate(data()), "teal_data") + moduleServer(id, function(input, output, session) { selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list(ref = ref, vars = vars), @@ -250,14 +252,12 @@ srv_tm_g_association <- function(id, anl_merged_input <- teal.transform::merge_expression_srv( datasets = data, - selector_list = selector_list, - join_keys = teal.data::join_keys(data) + selector_list = selector_list ) anl_merged_q <- reactive({ req(anl_merged_input()) - teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>% - teal.code::eval_code(as.expression(anl_merged_input()$expr)) + data() %>% teal.code::eval_code(as.expression(anl_merged_input()$expr)) }) merged <- list( @@ -474,7 +474,7 @@ srv_tm_g_association <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(paste(teal.code::get_code(output_q()), collapse = "\n")) + card$append_src(teal.code::get_code(output_q())) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_g_bivariate.R b/R/tm_g_bivariate.R index 444ad2733..2ec66c397 100644 --- a/R/tm_g_bivariate.R +++ b/R/tm_g_bivariate.R @@ -383,7 +383,8 @@ srv_g_bivariate <- function(id, ggplot2_args) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") - checkmate::assert_class(data, "tdata") + checkmate::assert_class(data, "reactive") + checkmate::assert_class(isolate(data()), "teal_data") moduleServer(id, function(input, output, session) { data_extract <- list( x = x, y = y, row_facet = row_facet, col_facet = col_facet, @@ -440,13 +441,12 @@ srv_g_bivariate <- function(id, anl_merged_input <- teal.transform::merge_expression_srv( selector_list = selector_list, - datasets = data, - join_keys = teal.data::join_keys(data) + datasets = data ) anl_merged_q <- reactive({ req(anl_merged_input()) - teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>% + data() %>% teal.code::eval_code(as.expression(anl_merged_input()$expr)) }) @@ -637,7 +637,7 @@ srv_g_bivariate <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(paste(teal.code::get_code(output_q()), collapse = "\n")) + card$append_src(teal.code::get_code(output_q())) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_g_distribution.R b/R/tm_g_distribution.R index 9afa58d09..310b95cfd 100644 --- a/R/tm_g_distribution.R +++ b/R/tm_g_distribution.R @@ -330,7 +330,8 @@ srv_distribution <- function(id, ggplot2_args) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") - checkmate::assert_class(data, "tdata") + checkmate::assert_class(data, "reactive") + checkmate::assert_class(isolate(data()), "teal_data") moduleServer(id, function(input, output, session) { rule_req <- function(value) { if (isTRUE(input$dist_tests %in% c( @@ -446,13 +447,12 @@ srv_distribution <- function(id, anl_merged_input <- teal.transform::merge_expression_srv( selector_list = selector_list, - datasets = data, - join_keys = teal.data::join_keys(data) + datasets = data ) anl_merged_q <- reactive({ req(anl_merged_input()) - teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>% + data() %>% teal.code::eval_code(as.expression(anl_merged_input()$expr)) }) @@ -1263,7 +1263,7 @@ srv_distribution <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(paste(teal.code::get_code(output_q()), collapse = "\n")) + card$append_src(teal.code::get_code(output_q())) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_g_response.R b/R/tm_g_response.R index fe3ecd43c..ce0c60a86 100644 --- a/R/tm_g_response.R +++ b/R/tm_g_response.R @@ -232,7 +232,8 @@ srv_g_response <- function(id, ggplot2_args) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") - checkmate::assert_class(data, "tdata") + checkmate::assert_class(data, "reactive") + checkmate::assert_class(isolate(data()), "teal_data") moduleServer(id, function(input, output, session) { data_extract <- list(response = response, x = x, row_facet = row_facet, col_facet = col_facet) @@ -276,13 +277,12 @@ srv_g_response <- function(id, anl_merged_input <- teal.transform::merge_expression_srv( selector_list = selector_list, - datasets = data, - join_keys = teal.data::join_keys(data) + datasets = data ) anl_merged_q <- reactive({ req(anl_merged_input()) - teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>% + data() %>% teal.code::eval_code(as.expression(anl_merged_input()$expr)) }) @@ -494,7 +494,7 @@ srv_g_response <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(paste(teal.code::get_code(output_q()), collapse = "\n")) + card$append_src(teal.code::get_code(output_q())) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_g_scatterplot.R b/R/tm_g_scatterplot.R index cdaea83fe..cae83d74d 100644 --- a/R/tm_g_scatterplot.R +++ b/R/tm_g_scatterplot.R @@ -414,7 +414,8 @@ srv_g_scatterplot <- function(id, ggplot2_args) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") - checkmate::assert_class(data, "tdata") + checkmate::assert_class(data, "reactive") + checkmate::assert_class(isolate(data()), "teal_data") moduleServer(id, function(input, output, session) { data_extract <- list( x = x, @@ -471,13 +472,12 @@ srv_g_scatterplot <- function(id, anl_merged_input <- teal.transform::merge_expression_srv( selector_list = selector_list, datasets = data, - join_keys = teal.data::join_keys(data), merge_function = "dplyr::inner_join" ) anl_merged_q <- reactive({ req(anl_merged_input()) - teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>% + data() %>% teal.code::eval_code(as.expression(anl_merged_input()$expr)) %>% teal.code::eval_code(quote(ANL)) # used to display table when running show-r-code code }) @@ -964,7 +964,7 @@ srv_g_scatterplot <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(paste(teal.code::get_code(output_q()), collapse = "\n")) + card$append_src(teal.code::get_code(output_q())) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_g_scatterplotmatrix.R b/R/tm_g_scatterplotmatrix.R index 1f3b57d15..f7c26eddf 100644 --- a/R/tm_g_scatterplotmatrix.R +++ b/R/tm_g_scatterplotmatrix.R @@ -163,7 +163,8 @@ ui_g_scatterplotmatrix <- function(id, ...) { srv_g_scatterplotmatrix <- function(id, data, reporter, filter_panel_api, variables, plot_height, plot_width) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") - checkmate::assert_class(data, "tdata") + checkmate::assert_class(data, "reactive") + checkmate::assert_class(isolate(data()), "teal_data") moduleServer(id, function(input, output, session) { selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list(variables = variables), @@ -180,13 +181,12 @@ srv_g_scatterplotmatrix <- function(id, data, reporter, filter_panel_api, variab anl_merged_input <- teal.transform::merge_expression_srv( datasets = data, - join_keys = teal.data::join_keys(data), selector_list = selector_list ) anl_merged_q <- reactive({ req(anl_merged_input()) - teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>% + data() %>% teal.code::eval_code(as.expression(anl_merged_input()$expr)) }) @@ -368,7 +368,7 @@ srv_g_scatterplotmatrix <- function(id, data, reporter, filter_panel_api, variab card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(paste(teal.code::get_code(output_q()), collapse = "\n")) + card$append_src(teal.code::get_code(output_q())) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_missing_data.R b/R/tm_missing_data.R index 1931e2362..15e19cbcf 100644 --- a/R/tm_missing_data.R +++ b/R/tm_missing_data.R @@ -85,23 +85,16 @@ tm_missing_data <- function(label = "Missing data", server = srv_page_missing_data, server_args = list( parent_dataname = parent_dataname, plot_height = plot_height, - plot_width = plot_width, ggplot2_args = ggplot2_args + plot_width = plot_width, ggplot2_args = ggplot2_args, ggtheme = ggtheme ), ui = ui_page_missing_data, datanames = "all", - ui_args = list( - parent_dataname = parent_dataname, pre_output = pre_output, - post_output = post_output, ggtheme = ggtheme - ) + ui_args = list(pre_output = pre_output, post_output = post_output) ) } -ui_page_missing_data <- function(id, data, parent_dataname, pre_output = NULL, post_output = NULL, ggtheme) { +ui_page_missing_data <- function(id, pre_output = NULL, post_output = NULL) { ns <- NS(id) - datanames <- names(data) - - if_subject_plot <- length(parent_dataname) > 0 && parent_dataname %in% datanames - shiny::tagList( include_css_files("custom"), teal.widgets::standard_layout( @@ -110,49 +103,72 @@ ui_page_missing_data <- function(id, data, parent_dataname, pre_output = NULL, p class = "flex", column( width = 12, - do.call( - tabsetPanel, - c( - id = ns("dataname_tab"), - lapply( - datanames, - function(x) { - tabPanel( - title = x, - column( - width = 12, - div( - class = "mt-4", - ui_missing_data(id = ns(x), by_subject_plot = if_subject_plot) - ) - ) - ) - } - ) - ) - ) + uiOutput(ns("dataset_tabs")) ) ) ), encoding = div( - tagList( + uiOutput(ns("dataset_encodings")) + ), + uiOutput(ns("dataset_reporter")), + pre_output = pre_output, + post_output = post_output + ) + ) +} + +srv_page_missing_data <- function(id, data, reporter, filter_panel_api, parent_dataname, + plot_height, plot_width, ggplot2_args, ggtheme) { + moduleServer(id, function(input, output, session) { + datanames <- isolate(teal.data::datanames(data())) + if_subject_plot <- length(parent_dataname) > 0 && parent_dataname %in% datanames + ns <- session$ns + + output$dataset_tabs <- renderUI({ + do.call( + tabsetPanel, + c( + id = ns("dataname_tab"), lapply( datanames, function(x) { - conditionalPanel( - is_tab_active_js(ns("dataname_tab"), x), - encoding_missing_data( - id = ns(x), - summary_per_patient = if_subject_plot, - ggtheme = ggtheme, - datanames = datanames + tabPanel( + title = x, + column( + width = 12, + div( + class = "mt-4", + ui_missing_data(id = ns(x), by_subject_plot = if_subject_plot) + ) ) ) } ) ) - ), - forms <- lapply(datanames, function(x) { + ) + }) + + output$dataset_encodings <- renderUI({ + tagList( + lapply( + datanames, + function(x) { + conditionalPanel( + is_tab_active_js(ns("dataname_tab"), x), + encoding_missing_data( + id = ns(x), + summary_per_patient = if_subject_plot, + ggtheme = ggtheme, + datanames = datanames + ) + ) + } + ) + ) + }) + + output$dataset_reporter <- renderUI({ + lapply(datanames, function(x) { dataname_ns <- NS(ns(x)) conditionalPanel( @@ -162,18 +178,11 @@ ui_page_missing_data <- function(id, data, parent_dataname, pre_output = NULL, p teal.widgets::verbatim_popup_ui(dataname_ns("rcode"), "Show R code") ) ) - }), - pre_output = pre_output, - post_output = post_output - ) - ) -} + }) + }) -srv_page_missing_data <- function(id, data, reporter, filter_panel_api, parent_dataname, - plot_height, plot_width, ggplot2_args) { - moduleServer(id, function(input, output, session) { lapply( - names(data), + datanames, function(x) { srv_missing_data( id = x, @@ -352,11 +361,12 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par plot_height, plot_width, ggplot2_args) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") - checkmate::assert_class(data, "tdata") + checkmate::assert_class(data, "reactive") + checkmate::assert_class(isolate(data()), "teal_data") moduleServer(id, function(input, output, session) { prev_group_by_var <- reactiveVal("") - data_r <- data[[dataname]] - data_keys <- reactive(unlist(teal.data::join_keys(data)[[dataname]])) + data_r <- reactive(data()[[dataname]]) + data_keys <- reactive(unlist(teal.data::join_keys(data())[[dataname]])) iv_r <- reactive({ iv <- shinyvalidate::InputValidator$new() @@ -411,11 +421,10 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par group_var <- input$group_by_var anl <- data_r() - qenv <- teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) qenv <- if (!is.null(selected_vars()) && length(selected_vars()) != ncol(anl)) { teal.code::eval_code( - qenv, + data(), substitute( expr = ANL <- anl_name[, selected_vars, drop = FALSE], # nolint env = list(anl_name = as.name(dataname), selected_vars = selected_vars()) @@ -423,7 +432,7 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par ) } else { teal.code::eval_code( - qenv, + data(), substitute(expr = ANL <- anl_name, env = list(anl_name = as.name(dataname))) # nolint ) } @@ -1232,7 +1241,7 @@ srv_missing_data <- function(id, data, reporter, filter_panel_api, dataname, par card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(paste(teal.code::get_code(final_q()), collapse = "\n")) + card$append_src(teal.code::get_code(final_q())) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_outliers.R b/R/tm_outliers.R index 937d7338d..42b5976ef 100644 --- a/R/tm_outliers.R +++ b/R/tm_outliers.R @@ -250,7 +250,8 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, categorical_var, plot_height, plot_width, ggplot2_args) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") - checkmate::assert_class(data, "tdata") + checkmate::assert_class(data, "reactive") + checkmate::assert_class(isolate(data()), "teal_data") moduleServer(id, function(input, output, session) { vars <- list(outlier_var = outlier_var, categorical_var = categorical_var) @@ -293,13 +294,12 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, anl_merged_input <- teal.transform::merge_expression_srv( selector_list = reactive_select_input, datasets = data, - join_keys = teal.data::join_keys(data), merge_function = "dplyr::inner_join" ) anl_merged_q <- reactive({ req(anl_merged_input()) - teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>% + data() %>% teal.code::eval_code(as.expression(anl_merged_input()$expr)) }) @@ -316,7 +316,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, }) # Used to create outlier table and the dropdown with additional columns - dataname_first <- names(data)[[1]] + dataname_first <- isolate(teal.data::datanames(data())[[1]]) common_code_q <- reactive({ shiny::req(iv_r()$is_valid()) @@ -476,7 +476,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, }, env = list( dataname = as.name(dataname_first), - join_keys = as.character(teal.data::join_keys(data)[dataname_first, dataname_first]) + join_keys = as.character(teal.data::join_keys(data())[dataname_first, dataname_first]) ) ) ) @@ -976,7 +976,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, brushing = TRUE ) - choices <- teal.transform::variable_choices(data[[dataname_first]]()) + choices <- teal.transform::variable_choices(data()[[dataname_first]]) observeEvent(common_code_q(), { ANL_OUTLIER <- common_code_q()[["ANL_OUTLIER"]] # nolint @@ -1174,7 +1174,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(paste(teal.code::get_code(final_q()), collapse = "\n")) + card$append_src(teal.code::get_code(final_q())) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_t_crosstable.R b/R/tm_t_crosstable.R index f4efb3169..49ba6afd2 100644 --- a/R/tm_t_crosstable.R +++ b/R/tm_t_crosstable.R @@ -168,7 +168,8 @@ ui_t_crosstable <- function(id, x, y, show_percentage, show_total, pre_output, p srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y, basic_table_args) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") - checkmate::assert_class(data, "tdata") + checkmate::assert_class(data, "reactive") + checkmate::assert_class(isolate(data()), "teal_data") moduleServer(id, function(input, output, session) { selector_list <- teal.transform::data_extract_multiple_srv( data_extract = list(x = x, y = y), @@ -215,14 +216,13 @@ srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y, anl_merged_input <- teal.transform::merge_expression_srv( datasets = data, - join_keys = teal.data::join_keys(data), selector_list = selector_list, merge_function = merge_function ) anl_merged_q <- reactive({ req(anl_merged_input()) - teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>% + data() %>% teal.code::eval_code(as.expression(anl_merged_input()$expr)) }) @@ -366,7 +366,7 @@ srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(paste(teal.code::get_code(output_q()), collapse = "\n")) + card$append_src(teal.code::get_code(output_q())) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_variable_browser.R b/R/tm_variable_browser.R index c4b7a19f8..c0288ce9b 100644 --- a/R/tm_variable_browser.R +++ b/R/tm_variable_browser.R @@ -87,8 +87,6 @@ tm_variable_browser <- function(label = "Variable Browser", ggplot2_args = ggplot2_args ), ui_args = list( - datasets_selected = datasets_selected, - parent_dataname = parent_dataname, pre_output = pre_output, post_output = post_output ) @@ -97,20 +95,10 @@ tm_variable_browser <- function(label = "Variable Browser", # ui function ui_variable_browser <- function(id, - data, - datasets_selected, - parent_dataname, pre_output = NULL, post_output = NULL) { ns <- NS(id) - datanames <- names(data) - - if (!identical(datasets_selected, character(0))) { - stopifnot(all(datasets_selected %in% datanames)) - datanames <- datasets_selected - } - shiny::tagList( include_css_files("custom"), shinyjs::useShinyjs(), @@ -121,38 +109,7 @@ ui_variable_browser <- function(id, 6, # variable browser teal.widgets::white_small_well( - do.call( - tabsetPanel, - c( - id = ns("tabset_panel"), - do.call( - tagList, - lapply(datanames, function(dataname) { - tabPanel( - dataname, - div( - class = "mt-4", - textOutput(ns(paste0("dataset_summary_", dataname))) - ), - div( - class = "mt-4", - teal.widgets::get_dt_rows( - ns(paste0( - "variable_browser_", dataname - )), - ns( - paste0("variable_browser_", dataname, "_rows") - ) - ), - DT::dataTableOutput(ns(paste0( - "variable_browser_", dataname - )), width = "100%") - ) - ) - }) - ) - ) - ), + uiOutput(ns("ui_variable_browser")), shinyjs::hidden({ checkboxInput(ns("show_parent_vars"), "Show parent dataset variables", value = FALSE) }) @@ -216,7 +173,8 @@ srv_variable_browser <- function(id, datasets_selected, parent_dataname, ggplot2_args) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") - checkmate::assert_class(data, "tdata") + checkmate::assert_class(data, "reactive") + checkmate::assert_class(isolate(data()), "teal_data") moduleServer(id, function(input, output, session) { # if there are < this number of unique records then a numeric # variable can be treated as a factor and all factors with < this groups @@ -226,7 +184,7 @@ srv_variable_browser <- function(id, # variable is by default treated as a factor .unique_records_default_as_factor <- 6 # nolint - datanames <- names(data) + datanames <- isolate(teal.data::datanames(data())) checkmate::assert_character(datasets_selected) checkmate::assert_subset(datasets_selected, datanames) @@ -234,6 +192,36 @@ srv_variable_browser <- function(id, datanames <- datasets_selected } + output$ui_variable_browser <- renderUI({ + ns <- session$ns + do.call( + tabsetPanel, + c( + id = ns("tabset_panel"), + do.call( + tagList, + lapply(datanames, function(dataname) { + tabPanel( + dataname, + div( + class = "mt-4", + textOutput(ns(paste0("dataset_summary_", dataname))) + ), + div( + class = "mt-4", + teal.widgets::get_dt_rows( + ns(paste0("variable_browser_", dataname)), + ns(paste0("variable_browser_", dataname, "_rows")) + ), + DT::dataTableOutput(ns(paste0("variable_browser_", dataname)), width = "100%") + ) + ) + }) + ) + ) + ) + }) + # conditionally display checkbox shinyjs::toggle( id = "show_parent_vars", @@ -298,11 +286,10 @@ srv_variable_browser <- function(id, }) output$ui_numeric_display <- renderUI({ + validation_checks() dataname <- input$tabset_panel - varname <- plot_var$variable[[input$tabset_panel]] - req(data, varname) - - df <- data[[dataname]]() + varname <- plot_var$variable[[dataname]] + df <- data()[[dataname]] numeric_ui <- tagList( fluidRow( @@ -366,11 +353,10 @@ srv_variable_browser <- function(id, }) output$ui_histogram_display <- renderUI({ + validation_checks() dataname <- input$tabset_panel - varname <- plot_var$variable[[input$tabset_panel]] - req(data, varname) - - df <- data[[dataname]]() + varname <- plot_var$variable[[dataname]] + df <- data()[[dataname]] numeric_ui <- tagList(fluidRow( div( @@ -1036,28 +1022,6 @@ plot_var_summary <- function(var, plot_main } -#' Returns a short variable description. -#' -#' @description -#' The format of the variable description is: -#' `" [.]"` -#' -#' Example: `"Study Identifier [ADSL.STUDYID]"` -#' -#' @param data (`tdata`) the object containing the dataset -#' @param dataset_name (`character`) the name of the dataset containing the variable -#' @param var_name (`character`) the name of the variable -#' @keywords internal -get_var_description <- function(data, dataset_name, var_name) { - varlabel <- var_labels(data[[dataset_name]]())[[var_name]] - sprintf( - "%s [%s.%s]", - if (is.na(varlabel)) var_name else varlabel, - dataset_name, - var_name - ) -} - is_num_var_short <- function(.unique_records_for_factor, input, data_for_analysis) { length(unique(data_for_analysis()$data)) < .unique_records_for_factor && !is.null(input$numeric_as_factor) } @@ -1072,13 +1036,12 @@ is_num_var_short <- function(.unique_records_for_factor, input, data_for_analysi #' @keywords internal validate_input <- function(input, plot_var, data) { reactive({ - dataset_name <- input$tabset_panel - varname <- plot_var$variable[[input$tabset_panel]] + dataset_name <- req(input$tabset_panel) + varname <- plot_var$variable[[dataset_name]] validate(need(dataset_name, "No data selected")) validate(need(varname, "No variable selected")) - - df <- data[[dataset_name]]() + df <- data()[[dataset_name]] teal::validate_has_data(df, 1) teal::validate_has_variable(varname = varname, data = df, "Variable not available") @@ -1088,8 +1051,8 @@ validate_input <- function(input, plot_var, data) { get_plotted_data <- function(input, plot_var, data) { dataset_name <- input$tabset_panel - varname <- plot_var$variable[[input$tabset_panel]] - df <- data[[dataset_name]]() + varname <- plot_var$variable[[dataset_name]] + df <- data()[[dataset_name]] var_description <- var_labels(df)[[varname]] list(data = df[[varname]], var_description = var_description) @@ -1148,10 +1111,10 @@ render_single_tab <- function(dataset_name, parent_dataname, output, data, input render_tab_header <- function(dataset_name, output, data) { dataset_ui_id <- paste0("dataset_summary_", dataset_name) output[[dataset_ui_id]] <- renderText({ - df <- data[[dataset_name]]() - join_keys <- join_keys(data) + df <- data()[[dataset_name]] + join_keys <- join_keys(data()) if (!is.null(join_keys)) { - key <- join_keys(data)[dataset_name, dataset_name] + key <- join_keys(data())[dataset_name, dataset_name] } else { key <- NULL } @@ -1177,14 +1140,14 @@ render_tab_table <- function(dataset_name, parent_dataname, output, data, input, table_ui_id <- paste0("variable_browser_", dataset_name) output[[table_ui_id]] <- DT::renderDataTable({ - df <- data[[dataset_name]]() + df <- data()[[dataset_name]] get_vars_df <- function(input, dataset_name, parent_name, data) { - data_cols <- colnames(data[[dataset_name]]()) + data_cols <- colnames(df) if (isTRUE(input$show_parent_vars)) { data_cols } else if (dataset_name != parent_name && parent_name %in% names(data)) { - setdiff(data_cols, colnames(data[[parent_name]]())) + setdiff(data_cols, colnames(data()[[parent_name]])) } else { data_cols } @@ -1222,7 +1185,7 @@ render_tab_table <- function(dataset_name, parent_dataname, output, data, input, # get icons proper for the data types icons <- stats::setNames(teal.slice:::variable_types(df), colnames(df)) - join_keys <- join_keys(data) + join_keys <- join_keys(data()) if (!is.null(join_keys)) { icons[intersect(join_keys[dataset_name, dataset_name], colnames(df))] <- "primary_key" } diff --git a/man/get_var_description.Rd b/man/get_var_description.Rd deleted file mode 100644 index 7889f453d..000000000 --- a/man/get_var_description.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/tm_variable_browser.R -\name{get_var_description} -\alias{get_var_description} -\title{Returns a short variable description.} -\usage{ -get_var_description(data, dataset_name, var_name) -} -\arguments{ -\item{data}{(\code{tdata}) the object containing the dataset} - -\item{dataset_name}{(\code{character}) the name of the dataset containing the variable} - -\item{var_name}{(\code{character}) the name of the variable} -} -\description{ -The format of the variable description is: -\code{" [.]"} - -Example: \code{"Study Identifier [ADSL.STUDYID]"} -} -\keyword{internal} diff --git a/man/tm_front_page.Rd b/man/tm_front_page.Rd index 0a12da77e..ceb61fb3f 100644 --- a/man/tm_front_page.Rd +++ b/man/tm_front_page.Rd @@ -44,6 +44,7 @@ data <- teal_data() data <- within(data, { library(nestcolor) ADSL <- teal.modules.general::rADSL + attr(ADSL, "metadata") <- list("Author" = "NEST team", "data_source" = "synthetic data") }) datanames <- c("ADSL") datanames(data) <- datanames