diff --git a/R/tm_g_distribution.R b/R/tm_g_distribution.R index b6c32d019..2c7c6598d 100644 --- a/R/tm_g_distribution.R +++ b/R/tm_g_distribution.R @@ -638,6 +638,7 @@ srv_distribution <- function(id, sd = round(stats::sd(dist_var_name, na.rm = TRUE), roundn), count = dplyr::n() ) + summary_table # used to display table when running show-r-code code }, env = list( dist_var_name = dist_var_name, @@ -647,8 +648,6 @@ srv_distribution <- function(id, ) ) } - - qenv }) # distplot qenv ---- @@ -1141,7 +1140,9 @@ srv_distribution <- function(id, ) ) } - qenv + qenv %>% + # used to display table when running show-r-code code + teal.code::eval_code(quote(test_stats)) } ) diff --git a/R/tm_g_scatterplot.R b/R/tm_g_scatterplot.R index 029f57071..f7aea4ff2 100644 --- a/R/tm_g_scatterplot.R +++ b/R/tm_g_scatterplot.R @@ -475,7 +475,8 @@ srv_g_scatterplot <- function(id, 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)) + 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 }) merged <- list( diff --git a/R/tm_outliers.R b/R/tm_outliers.R index 28f06fd33..fba0c5ceb 100644 --- a/R/tm_outliers.R +++ b/R/tm_outliers.R @@ -313,6 +313,9 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, sum(is.na(ANL[[outlier_var]])) }) + # Used to create outlier table and the dropdown with additional columns + dataname_first <- names(data)[[1]] + common_code_q <- reactive({ shiny::req(iv_r()$is_valid()) @@ -405,7 +408,6 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, ungroup_expr %>% # styler: off dplyr::filter(is_outlier | is_outlier_selected) %>% dplyr::select(-is_outlier) - ANL_OUTLIER # used to display table when running show-r-code code }, env = list( calculate_outliers = if (method == "IQR") { @@ -456,6 +458,27 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, remove_pipe_null() ) + # ANL_OUTLIER_EXTENDED is the base table + qenv <- teal.code::eval_code( + qenv, + substitute( + expr = { + ANL_OUTLIER_EXTENDED <- dplyr::left_join( # nolint object_name_linter + ANL_OUTLIER, + dplyr::select( + dataname, + dplyr::setdiff(names(dataname), dplyr::setdiff(names(ANL_OUTLIER), join_keys)) + ), + by = join_keys + ) + }, + env = list( + dataname = as.name(dataname_first), + join_keys = as.character(get_join_keys(data)$get(dataname_first)[[dataname_first]]) + ) + ) + ) + if (length(categorical_var) > 0) { qenv <- teal.code::eval_code( qenv, @@ -839,13 +862,31 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, final_q <- reactive({ req(input$tabs) tab_type <- input$tabs - if (tab_type == "Boxplot") { + result_q <- if (tab_type == "Boxplot") { boxplot_q() } else if (tab_type == "Density Plot") { density_plot_q() } else if (tab_type == "Cumulative Distribution Plot") { cumulative_plot_q() } + # used to display table when running show-r-code code + # added after the plots so that a change in selected columns doesn't affect + # brush selection. + teal.code::eval_code( + result_q, + substitute( + expr = { + columns_index <- union( + setdiff(names(ANL_OUTLIER), "is_outlier_selected"), + table_columns + ) + ANL_OUTLIER_EXTENDED[ANL_OUTLIER_EXTENDED$is_outlier_selected, columns_index] + }, + env = list( + table_columns = input$table_ui_columns + ) + ) + ) }) # slider text @@ -933,9 +974,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, brushing = TRUE ) - dataname <- names(data)[[1]] - - choices <- teal.transform::variable_choices(data[[dataname]]()) + choices <- teal.transform::variable_choices(data[[dataname_first]]()) observeEvent(common_code_q(), { ANL_OUTLIER <- common_code_q()[["ANL_OUTLIER"]] # nolint @@ -955,6 +994,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, categorical_var <- as.vector(merged$anl_input_r()$columns_source$categorical_var) ANL_OUTLIER <- common_code_q()[["ANL_OUTLIER"]] # nolint + ANL_OUTLIER_EXTENDED <- common_code_q()[["ANL_OUTLIER_EXTENDED"]] # nolint ANL <- common_code_q()[["ANL"]] # nolint plot_brush <- if (tab == "Boxplot") { boxplot_r() @@ -1026,12 +1066,12 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, } display_table$is_outlier_selected <- NULL - keys <- get_join_keys(data)$get(dataname)[[dataname]] - datas <- data[[dataname]]() + + # Extend the brushed ANL_OUTLIER with additional columns dplyr::left_join( display_table, - dplyr::select(datas, dplyr::setdiff(names(datas), dplyr::setdiff(names(display_table), keys))), - by = keys + dplyr::select(ANL_OUTLIER_EXTENDED, -"is_outlier_selected"), + by = names(display_table) ) %>% dplyr::select(union(names(display_table), input$table_ui_columns)) },