From 1375386725350f712f4c6eedb0682058ccf0c150 Mon Sep 17 00:00:00 2001 From: Luis Moris Fernandez Date: Mon, 23 Sep 2024 18:13:31 +0200 Subject: [PATCH 01/11] working poc of several filters --- R/app_server.R | 54 ++++++++++++++++++++++++++++++++---- R/app_ui.R | 27 +++++++++++++++--- R/pharmaverse_data.R | 27 ++++++++++++++++-- R/testing_module.R | 25 ++++++++++++++++- R/utils_helpers.R | 27 ++++++++++++++++++ inst/app/www/css/custom.scss | 2 +- 6 files changed, 149 insertions(+), 13 deletions(-) diff --git a/R/app_server.R b/R/app_server.R index 0bc4e92..8655b4d 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -90,6 +90,8 @@ app_server_ <- function(input, output, session, opts) { startup_msg <- opts[["startup_msg"]] reload_period <- opts[["reload_period"]] + datasets_filters_info <- get_dataset_filters_info(data, filter_data) + # Check if dataset must be reloaded in the next session check_data_reload(reload_period) @@ -121,20 +123,62 @@ app_server_ <- function(input, output, session, opts) { } }) - filtered_values <- dv.filter::data_filter_server( + global_filtered_values <- dv.filter::data_filter_server( "global_filter", shiny::reactive(unfiltered_dataset()[[filter_data]]) ) + dataset_filters <- local({ + l <- vector(mode = "list", length = length(datasets_filters_info)) + names(l) <- names(datasets_filters_info) + for (idx in seq_along(datasets_filters_info)) { + l[[idx]] <- local({ + curr_dataset_filter_info <- datasets_filters_info[[idx]] + dv.filter::data_filter_server( + curr_dataset_filter_info[["id"]], + shiny::reactive({unfiltered_dataset()[[curr_dataset_filter_info[["name"]]]] %||% data.frame()}) + ) + }) + } + + l + }) + filtered_dataset <- shinymeta::metaReactive({ # dv.filter returns a logical vector. This contemplates the case of empty lists - shiny::req(is.logical(filtered_values())) + shiny::req(is.logical(global_filtered_values())) + + # Check dataset filters check all datafilters are initialized + purrr::walk( + dataset_filters, ~shiny::req(is.logical(.x())) + ) + + curr_dataset_filters <- dataset_filters[intersect(names(dataset_filters), names(unfiltered_dataset()))] + + # Current dataset must be logical with length above 0 + purrr::walk(curr_dataset_filters, ~shiny::req(checkmate::test_logical(.x(), min.len = 1))) + log_inform("New filter applied") - filtered_key_values <- unfiltered_dataset()[[filter_data]][[filter_key]][filtered_values()] # nolint - purrr::map( - unfiltered_dataset(), + filtered_key_values <- unfiltered_dataset()[[filter_data]][[filter_key]][global_filtered_values()] # nolint + + filtered_dataset <- unfiltered_dataset() + + # First we apply filtered datasets + filtered_dataset[names(curr_dataset_filters)] <- purrr::imap( + filtered_dataset[names(curr_dataset_filters)], + function(val, nm) { + filtered_dataset[[nm]][dataset_filters[[nm]](), , drop = FALSE] + } + ) + + + # Then we apply global + global_filtered <- purrr::map( + filtered_dataset, ~ dplyr::filter(.x, .data[[filter_key]] %in% filtered_key_values) # nolint ) + + }) diff --git a/R/app_ui.R b/R/app_ui.R index 86ad9aa..dba38f3 100644 --- a/R/app_ui.R +++ b/R/app_ui.R @@ -22,6 +22,7 @@ app_ui <- function(id) { data <- get_config("data") module_list <- get_config("module_list") + filter_data <- get_config("filter_data") log_inform("Initializing HTML template UI") log_inform(glue::glue( @@ -30,6 +31,20 @@ app_ui <- function(id) { log_inform(glue::glue("Available modules (N): {length(module_list)}")) log_inform(glue::glue("Dataset options (N): {length(data)}")) + + dataset_filters_ui <- local({ + datasets_filters_info <- get_dataset_filters_info(data, filter_data) + purrr::map( + datasets_filters_info, + function(entry) { + shiny::div( + entry[["name"]], + dv.filter::data_filter_ui(ns(entry[["id"]])) + ) + } + ) + }) + collapsable_ui <- shiny::div( class = "menu-contents", @@ -43,11 +58,15 @@ app_ui <- function(id) { ), shiny::selectInput(ns("selector"), label = NULL, choices = names(data)) )), - shiny::div( - id = ns("shiny_filter"), - class = "c-well", - shiny::tags$label("Filters", class = "text-primary"), + shiny::div( + class = "c-well shiny_filter", + shiny::tags$label("Global Filter", class = "text-primary"), dv.filter::data_filter_ui(ns("global_filter")) + ), + shiny::div( + class = "c-well shiny_filter", + shiny::tags$label("Dataset Filters", class = "text-primary"), + dataset_filters_ui ) ) ) diff --git a/R/pharmaverse_data.R b/R/pharmaverse_data.R index 5607d1d..1c01e7b 100644 --- a/R/pharmaverse_data.R +++ b/R/pharmaverse_data.R @@ -1,10 +1,33 @@ get_pharmaverse_data <- function(dataset) { if (!rlang::is_installed("pharmaverseadam")) stop("Please, install.package('pharmaverseadam')") + + chr2fct <- function(x){ + x[] <- purrr::map(x, ~if(is.character(.x)) factor(.x) else .x) + x + } + + cd2fct <- function(x){ + x[] <- purrr::imap(x, ~if(endsWith(.y, "CD")) factor(.x) else .x) + x + } + if (dataset == "adsl") { - return(pharmaverseadam::adsl) + res <- pharmaverseadam::adsl |> + chr2fct() |> + cd2fct() + return(res) } if (dataset == "adae") { - return(pharmaverseadam::adae) + res <- pharmaverseadam::adae |> + chr2fct() |> + cd2fct() + return(res) + } + if (dataset == "adlb") { + res <- pharmaverseadam::adlb |> + chr2fct() |> + cd2fct() + return(res) } stop("Unknown dataset") } diff --git a/R/testing_module.R b/R/testing_module.R index 34752b3..09f86e2 100644 --- a/R/testing_module.R +++ b/R/testing_module.R @@ -125,7 +125,7 @@ mod_simple <- function(dataset, module_id) { run_mock_app <- function() { run_app( - data = list("D1" = list(adsl = get_pharmaverse_data("adsl"))), + data = list("D1" = list(adsl = get_pharmaverse_data("adsl"), adae = get_pharmaverse_data("adae"))), module_list = list( "Simple" = mod_simple(mm_dispatch("filtered_dataset", "adsl"), "mod1"), "Simple2" = mod_simple(mm_dispatch("unfiltered_dataset", "adsl"), "mod2") @@ -135,6 +135,29 @@ run_mock_app <- function() { ) } +run_mock_app_two_datasets <- function() { + run_app( + data = list( + "D1" = list( + adsl = get_pharmaverse_data("adsl"), + adae = get_pharmaverse_data("adae") + ), + "D2" = list( + adsl = get_pharmaverse_data("adsl"), + adae = get_pharmaverse_data("adae"), + adlb = get_pharmaverse_data("adlb") + ) + ), + module_list = list( + "Simple" = mod_simple(mm_dispatch("filtered_dataset", "adsl"), "mod1"), + "Simple2" = mod_simple(mm_dispatch("unfiltered_dataset", "adsl"), "mod2"), + "Simple3" = mod_simple(mm_dispatch("filtered_dataset", "adae"), "mod3") + ), + filter_data = "adsl", + filter_key = "USUBJID" + ) +} + ########## URL READING url_reader_UI <- function(id) { # nolint diff --git a/R/utils_helpers.R b/R/utils_helpers.R index 60b71c0..bca28c8 100644 --- a/R/utils_helpers.R +++ b/R/utils_helpers.R @@ -51,3 +51,30 @@ create_options_modal <- function(session, input, ns) { easyClose = TRUE ) } + +#' Get the set of all possible data table names for filtering +get_data_tables_names <- function(data) { + nm <- character(0) + for (idx in seq_along(data)) { + curr_data <- if (is.function(data[[idx]])) data[[idx]]() else data[[idx]] + nm <- union(nm, names(curr_data)) + } + return(nm) +} + +get_dataset_filters_info <- function(data, filter_data) { + dataset_filter_names <- setdiff(get_data_tables_names(data), filter_data) + purrr::map( + dataset_filter_names, + function(nm) { + name <- nm + hash <- digest::digest(nm, "murmur32") + id <- sprintf("dataset_filter_%s", hash) + list(name = nm, id = id, hash = hash) + } + ) |> purrr::set_names(dataset_filter_names) +} + +`%||%` <- function(x,y){ + if (!is.null(x)) x else y +} diff --git a/inst/app/www/css/custom.scss b/inst/app/www/css/custom.scss index e588f08..d927771 100644 --- a/inst/app/www/css/custom.scss +++ b/inst/app/www/css/custom.scss @@ -218,7 +218,7 @@ input[type="checkbox"]#click { flex-direction: column; justify-content: flex-start; - #shiny_filter { + .shiny_filter { flex: 1 0 auto; display: flex; flex-direction: column; From da6919ff955949c4634849602e8c3b6f62dd9062 Mon Sep 17 00:00:00 2001 From: Luis Moris Fernandez Date: Sun, 29 Sep 2024 20:33:18 +0200 Subject: [PATCH 02/11] fix css to avoid overlap of filters --- R/app_ui.R | 28 ++++++++++++----- R/utils_helpers.R | 3 +- inst/www/css/custom.scss | 67 +++++++++++----------------------------- inst/www/js/init.js | 20 ++++++++++++ 4 files changed, 61 insertions(+), 57 deletions(-) diff --git a/R/app_ui.R b/R/app_ui.R index dba38f3..c4917dd 100644 --- a/R/app_ui.R +++ b/R/app_ui.R @@ -38,8 +38,11 @@ app_ui <- function(id) { datasets_filters_info, function(entry) { shiny::div( - entry[["name"]], - dv.filter::data_filter_ui(ns(entry[["id"]])) + id = entry[["id_cont"]], + class = "filter-control filter-filters", + shiny::tags[["label"]](entry[["name"]]), + dv.filter::data_filter_ui(ns(entry[["id"]])), + shiny::hr(style = "border-top: 2px solid gray; height: 10px;") ) } ) @@ -61,12 +64,23 @@ app_ui <- function(id) { shiny::div( class = "c-well shiny_filter", shiny::tags$label("Global Filter", class = "text-primary"), - dv.filter::data_filter_ui(ns("global_filter")) + # shiny::tags$button( + # id = ns("global_button"), + # class = "btn btn-primary filter_button", + # shiny::span("Global Filter"), + # # shiny::span("TAG", class = "dv_hidden badge"), + # # shiny::span(class = "caret"), + # # onclick = sprintf("dv_manager.hide_filters('%s')", ns("global_button")) + # ), + shiny::div( + class = "filter-control filter-filters", + dv.filter::data_filter_ui(ns("global_filter")) + ) ), - shiny::div( + shiny::div( class = "c-well shiny_filter", - shiny::tags$label("Dataset Filters", class = "text-primary"), - dataset_filters_ui + shiny::tags$label("Dataset Filter", class = "text-primary"), + dataset_filters_ui ) ) ) @@ -129,4 +143,4 @@ app_ui <- function(id) { )), dataset_name ) -} +} diff --git a/R/utils_helpers.R b/R/utils_helpers.R index bca28c8..b8e7708 100644 --- a/R/utils_helpers.R +++ b/R/utils_helpers.R @@ -70,7 +70,8 @@ get_dataset_filters_info <- function(data, filter_data) { name <- nm hash <- digest::digest(nm, "murmur32") id <- sprintf("dataset_filter_%s", hash) - list(name = nm, id = id, hash = hash) + cont_id <- paste0(id, "_cont") + list(name = nm, id = id, hash = hash, id_cont = cont_id) } ) |> purrr::set_names(dataset_filter_names) } diff --git a/inst/www/css/custom.scss b/inst/www/css/custom.scss index 4ce7388..8c36e2f 100644 --- a/inst/www/css/custom.scss +++ b/inst/www/css/custom.scss @@ -213,18 +213,25 @@ input[type="checkbox"]#click { opacity: 1; } -#shiny_filter_panel { +#shiny_filter_panel { height: 94vh; - display: flex; - flex-direction: column; - justify-content: flex-start; - - #shiny_filter { - flex: 1 0 auto; - display: flex; - flex-direction: column; - justify-content: flex-start; + overflow-y: auto; + overflow-x: hidden; + + .shiny_filter{ + .dropdown-menu.open{ + min-width: min-content; + position: fixed; + left: $sidebar-width-open; + top: 25vh; + max-height: 75vh !important; + .inner.open{ + max-height: 75vh !important; + } + } + } + .c-well { min-height: 20px; padding: 15px; @@ -234,45 +241,7 @@ input[type="checkbox"]#click { #dataset_selector { flex: 0 0 auto; - } -} - -#global_filter-filters { - margin-top: 1rem; - .dropdown-menu { - left: $sidebar-width-open; - } -} - -#global_filter-controls { - overflow-y: auto; - overflow-x: hidden; - scrollbar-width: thin; - margin-right: -15px; - flex: 1 10 1vh; - min-height: 7.5rem; - padding: 25px 15px 15px !important; - margin-right: -15px !important; - margin-left: -15px !important; - - .dropdown-menu { - position: fixed; - top: 25vh; - left: $sidebar-width-open; - min-width: min-content; - - &.open { - left: 320px; - min-height: max-content; - height: max-content; - } - - &.inner { - position: inherit; - min-height: max-content; - overflow-x: hidden; - overflow-y: auto; - } + max-height: 200px; } } diff --git a/inst/www/js/init.js b/inst/www/js/init.js index fc35a61..e0bb149 100644 --- a/inst/www/js/init.js +++ b/inst/www/js/init.js @@ -13,3 +13,23 @@ $(document).ready(function () { } }); }); + +// const dv_manager = { +// hide_filters: function(button_id) { +// var button = document.getElementById(button_id); +// var tag = button.querySelectorAll("span")[1]; +// var container = button.nextElementSibling; +// var hidden = container.classList.toggle("dv_hidden"); +// var controls_container = container.querySelectorAll(":scope > div")[2]; +// var active_filters = controls_container.querySelectorAll(":scope > div").length; + +// tag.textContent=active_filters; + +// if (hidden) { +// tag.classList.remove("dv_hidden"); +// } else { +// tag.classList.add("dv_hidden"); +// } +// } +// }; + From 012fe8e9fa8dd80fa3e272b3e5a6a17e573c80b9 Mon Sep 17 00:00:00 2001 From: Luis Moris Fernandez Date: Thu, 3 Oct 2024 17:29:38 +0200 Subject: [PATCH 03/11] add specs and tests --- inst/validation/specs.R | 8 ++++--- tests/testthat/test-shiny_general.R | 36 ++++++++++++++++++++++++----- 2 files changed, 35 insertions(+), 9 deletions(-) diff --git a/inst/validation/specs.R b/inst/validation/specs.R index 4da917c..30ef068 100644 --- a/inst/validation/specs.R +++ b/inst/validation/specs.R @@ -18,8 +18,10 @@ fs_spec <- specs_list( "modification_dates_display" = "The earliest and latest modification dates of all the data tables are displayed for the active dataset", "date_unavailability_message" = "If no date is available for any of the data tables in the loaded dataset the system displays a 'Date unavailable' message", "data_reloading" = "dv.manager allows the reloading of the data after a specific amount of time.", - "filtering_menu_display" = "The sidebar menu will display a filtering menu using the datafilter module (GUI).", - "active_dataset_filtering" = "The active dataset can be filtered through the datafilter module.", + "filtering_menu_display" = "The sidebar menu will display a filtering menu/s using the datafilter module (GUI).", + "active_dataset_filtering" = "The active dataset can be filtered.", + "global_filtering" = "A global filter will be available in dv.manager. One table of the dataset will be used to filter all other tables in the dataset and itself by using a common field among them.", + "single_filtering" = "All data tables, with exception of the one used in the global filter, will have its own independent filter that only affects itself. These filters will not influence other datasets.", "bookmarking_features" = "Bookmarking will include: - the identity of the loaded dataset - the set of filters applied to the loaded dataset @@ -75,7 +77,7 @@ or a positive numeric value which is then interpreted as a lubridate duration ob - ids of the modules in module_list are not repeated. Otherwise it throws an informative error.", "startup_message_check" = "- startup_message is null or a shiny::modalDialog. Otherwise it throws an informative error.", "azure_options_check" = "-azure_options: must be a list with all the required fields or NULL. Otherwise an error is thrown.", - "filtering_menu" = "- A filtering menu that is an instance of datafilter", + "filtering_menus" = "- A filtering menu that is an/several instances of datafilter", "dataset_selector" = "- A dataset selector that: - contains one entry per entry in the data parameters list - when changed will load the selected dataset in the application diff --git a/tests/testthat/test-shiny_general.R b/tests/testthat/test-shiny_general.R index 1a1a59a..af225c6 100644 --- a/tests/testthat/test-shiny_general.R +++ b/tests/testthat/test-shiny_general.R @@ -91,7 +91,11 @@ local({ dv.manager::mm_dispatch("unfiltered_dataset", "mpg"), "mod4" ), - "Name And Dataset" = dv.manager:::mod_dataset_name_date("mod_dataset_name_date") + "Name And Dataset" = dv.manager:::mod_dataset_name_date("mod_dataset_name_date"), + "Filtered Carb" = dv.manager:::mod_simple( + dv.manager::mm_dispatch("filtered_dataset", "carb"), + "mod5" + ) ) datasets <- list( @@ -106,7 +110,6 @@ local({ Sys.setenv("LC_TIME" = "en_US.UTF-8") do.call(dv.manager::run_app, !!args) }) - root_app <- start_app_driver(app_expr) # We store these values for using while testing @@ -221,14 +224,13 @@ local({ ) test_that( - "active dataset can be filtered using the filtered menu" |> - vdoc[["add_spec"]](c(specs$active_dataset_filtering, specs$filter_key)), + "active dataset can be filtered using the global filter" |> + vdoc[["add_spec"]](c(specs$active_dataset_filtering, specs$filter_key, specs$global_filtering)), { skip_if_not_running_shiny_tests() skip_if_suspect_check() app <- shinytest2::AppDriver$new(root_app$get_url()) - # TODO: brittle too coupled with dv.filters app$set_inputs("global_filter-vars" = "car") @@ -240,6 +242,28 @@ local({ } ) + test_that( + "single data table from active dataset can be filtered using the single data table filter menu" |> + vdoc[["add_spec"]](c(specs$active_dataset_filtering, specs$single_filtering)), + { + skip_if_not_running_shiny_tests() + skip_if_suspect_check() + + app <- shinytest2::AppDriver$new(root_app$get_url()) + + # TODO: brittle too coupled with dv.filters + + app$set_inputs("dataset_filter_46ab8635-vars" = "carb") + app$wait_for_idle() + app$set_inputs("dataset_filter_46ab8635-carb" = c(1,1)) + app$wait_for_idle() + app$set_inputs("main_tab_panel" = "Filtered Carb") + app$wait_for_idle() + val <- app$wait_for_value(output = "mod5-text", ignore = list("4"), timeout = 10000) + expect_identical(val, "2") + } + ) + test_that( "dv.manager can bookmark identity of loaded dataset" |> vdoc[["add_spec"]](c(specs$bookmarking_features, specs$bookmark_button, specs$bookmarking_button_display)), @@ -442,7 +466,7 @@ local({ expect_equal(mpg_no_date[["current"]], mpg_no_date[["expected"]]) }) - test_that(vdoc[["add_spec"]]("filtering and dataset switching", c(specs$filtering_menu, specs$dataset_selector)), { + test_that(vdoc[["add_spec"]]("filtering and dataset switching", c(specs$filtering_menus, specs$dataset_selector)), { skip_if_not_running_shiny_tests() skip_if_suspect_check() From 77f774c334aa3b89f499c40967c45bbe900b4f63 Mon Sep 17 00:00:00 2001 From: Luis Moris Fernandez Date: Thu, 3 Oct 2024 18:59:23 +0200 Subject: [PATCH 04/11] update dependency to new dv.filer --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 288ddee..90168db 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -16,7 +16,7 @@ Imports: bslib (>= 0.3.0), purrr (>= 0.3.4), dplyr (>= 1.0.3), - dv.filter (>= 1.0.0), + dv.filter (>= 3.0.1), lubridate (>= 1.7.9.2), shinymeta (>= 0.2.0.1), shinyjs (>= 2.0.0), From 6c203fe381fec75edbe0160c9e083b9fb2e1df4e Mon Sep 17 00:00:00 2001 From: Luis Moris Fernandez Date: Thu, 3 Oct 2024 18:59:51 +0200 Subject: [PATCH 05/11] reworks dependency on filters. Otherwise incorrect states were read --- R/app_server.R | 39 ++++++++++++++++++++++++++------------- 1 file changed, 26 insertions(+), 13 deletions(-) diff --git a/R/app_server.R b/R/app_server.R index 8655b4d..fcc133d 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -144,37 +144,50 @@ app_server_ <- function(input, output, session, opts) { l }) - filtered_dataset <- shinymeta::metaReactive({ - # dv.filter returns a logical vector. This contemplates the case of empty lists + shiny::observeEvent(global_filtered_values(),{ + message(length(global_filtered_values())) + }) + + filtered_dataset <- shinymeta::metaReactive({ + # dv.filter returns a logical vector. This contemplates the case of empty lists shiny::req(is.logical(global_filtered_values())) - # Check dataset filters check all datafilters are initialized + # Depend on all datasets purrr::walk( dataset_filters, ~shiny::req(is.logical(.x())) ) - curr_dataset_filters <- dataset_filters[intersect(names(dataset_filters), names(unfiltered_dataset()))] + # We do not react to changed in unfiltered dataset, otherwise when a dataset changes + # We filter the previous dataset which in the best case produces and extra reactive beat + # and in the worst case produces an error in (mvbc) + # We don't want to control the error in (mvbc) because filtered dataset only changes when filter changes + ufds <- shiny::isolate(unfiltered_dataset()) + + curr_dataset_filters <- dataset_filters[intersect(names(dataset_filters), names(ufds))] + shiny::req(all(purrr::map_lgl(curr_dataset_filters, ~is.logical(.x())))) # Current dataset must be logical with length above 0 + # Check dataset filters check all datafilters are initialized purrr::walk(curr_dataset_filters, ~shiny::req(checkmate::test_logical(.x(), min.len = 1))) log_inform("New filter applied") - filtered_key_values <- unfiltered_dataset()[[filter_data]][[filter_key]][global_filtered_values()] # nolint - - filtered_dataset <- unfiltered_dataset() + filtered_key_values <- ufds[[filter_data]][[filter_key]][global_filtered_values()] # nolint + fds <- ufds + # First we apply filtered datasets - filtered_dataset[names(curr_dataset_filters)] <- purrr::imap( - filtered_dataset[names(curr_dataset_filters)], - function(val, nm) { - filtered_dataset[[nm]][dataset_filters[[nm]](), , drop = FALSE] + + fds[names(curr_dataset_filters)] <- purrr::imap( + fds[names(curr_dataset_filters)], + function(val, nm) { + # (mvbc) + fds[[nm]][dataset_filters[[nm]](), , drop = FALSE] } ) - # Then we apply global global_filtered <- purrr::map( - filtered_dataset, + fds, ~ dplyr::filter(.x, .data[[filter_key]] %in% filtered_key_values) # nolint ) From 460275e03df51774f103919c489f1ce38d11ffce Mon Sep 17 00:00:00 2001 From: Luis Moris Fernandez Date: Thu, 3 Oct 2024 18:59:57 +0200 Subject: [PATCH 06/11] update broken test --- tests/testthat/test-shiny_general.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-shiny_general.R b/tests/testthat/test-shiny_general.R index af225c6..3d775d8 100644 --- a/tests/testthat/test-shiny_general.R +++ b/tests/testthat/test-shiny_general.R @@ -407,7 +407,7 @@ local({ # TODO: Split test expect_identical( val <- app$get_values(output = "mod_dataset_name_date-text")[["output"]][["mod_dataset_name_date-text"]], - "dataset_name: mpg_one_date ; dataset_date_range: 2021-01-13 2021-01-13 ; module_name: Filtered Tab,Returned Filtered,Read Output,Unfiltered Tab,Name And Dataset" + "dataset_name: mpg_one_date ; dataset_date_range: 2021-01-13 2021-01-13 ; module_name: Filtered Tab,Returned Filtered,Read Output,Unfiltered Tab,Name And Dataset,Filtered Carb" ) } ) From 13006fb666f9372af9c7fc9eba2828be96bc67e4 Mon Sep 17 00:00:00 2001 From: Luis Moris Fernandez Date: Thu, 3 Oct 2024 19:08:04 +0200 Subject: [PATCH 07/11] update package documentation --- vignettes/data_filtering.Rmd | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/vignettes/data_filtering.Rmd b/vignettes/data_filtering.Rmd index 8cb80a5..c837cb2 100644 --- a/vignettes/data_filtering.Rmd +++ b/vignettes/data_filtering.Rmd @@ -15,11 +15,13 @@ knitr::opts_chunk$set( ) ``` -**dv.manager** include in all applications a filter for the input data. +# Population filter + +**dv.manager** include in all applications a population filter for the input data. ![](../man/figures/mod_manager_filter.png){width=100%} -In the `run_app()` call we specify which dataset will be passed to dv.filter in the `filter_data` parameter. The fields of this dataset will be displayed in the filter. +In the `run_app()` call we specify which dataset will be used for filtering the population in the `filter_data` parameter. The fields of this dataset will be displayed in the filter. ```{r, eval=FALSE} dv.manager::run_app( @@ -37,5 +39,10 @@ The figure below depicts the steps of the filtering process when using the defau In a first step (1), `filter_data` makes a subselection of all subjects in the study according to the criteria selected by the user (in the case of the figure only female participants above 30 years). In a second step (2), we filter the rest of the datasets in `data` and only those subjects that survived the filtering in step 1 will remain. +# Single filter + +**dv.manager** includes a filter for each of the datasets, with the exception of the one used in the population filter, that allows filtering the rows in that specific dataset. As opposed to the population filter +this filter only affects the dataset itself and not the other datasets in the input data. + From 6e16235ca4b92953ee31cbc06252dd74c1879a08 Mon Sep 17 00:00:00 2001 From: Luis Moris Fernandez Date: Fri, 4 Oct 2024 09:26:10 +0200 Subject: [PATCH 08/11] remove debug statetment --- R/app_server.R | 4 ---- 1 file changed, 4 deletions(-) diff --git a/R/app_server.R b/R/app_server.R index fcc133d..c201d73 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -144,10 +144,6 @@ app_server_ <- function(input, output, session, opts) { l }) - shiny::observeEvent(global_filtered_values(),{ - message(length(global_filtered_values())) - }) - filtered_dataset <- shinymeta::metaReactive({ # dv.filter returns a logical vector. This contemplates the case of empty lists shiny::req(is.logical(global_filtered_values())) From 4eec4c2b8ed20709cc80047292e6562027f30db0 Mon Sep 17 00:00:00 2001 From: Luis Moris Fernandez Date: Fri, 4 Oct 2024 09:42:46 +0200 Subject: [PATCH 09/11] streamline reactive dependency --- R/app_server.R | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/R/app_server.R b/R/app_server.R index c201d73..b264dbe 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -149,9 +149,7 @@ app_server_ <- function(input, output, session, opts) { shiny::req(is.logical(global_filtered_values())) # Depend on all datasets - purrr::walk( - dataset_filters, ~shiny::req(is.logical(.x())) - ) + purrr::walk(dataset_filters, ~.x()) # We do not react to changed in unfiltered dataset, otherwise when a dataset changes # We filter the previous dataset which in the best case produces and extra reactive beat @@ -160,7 +158,6 @@ app_server_ <- function(input, output, session, opts) { ufds <- shiny::isolate(unfiltered_dataset()) curr_dataset_filters <- dataset_filters[intersect(names(dataset_filters), names(ufds))] - shiny::req(all(purrr::map_lgl(curr_dataset_filters, ~is.logical(.x())))) # Current dataset must be logical with length above 0 # Check dataset filters check all datafilters are initialized From c67371dc362c5d37255116ff8eb177e968518b9d Mon Sep 17 00:00:00 2001 From: Luis Moris Fernandez Date: Fri, 4 Oct 2024 09:42:58 +0200 Subject: [PATCH 10/11] improves doc --- R/app_server.R | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/R/app_server.R b/R/app_server.R index b264dbe..913ccea 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -163,13 +163,11 @@ app_server_ <- function(input, output, session, opts) { # Check dataset filters check all datafilters are initialized purrr::walk(curr_dataset_filters, ~shiny::req(checkmate::test_logical(.x(), min.len = 1))) - log_inform("New filter applied") - filtered_key_values <- ufds[[filter_data]][[filter_key]][global_filtered_values()] # nolint + filtered_key_values <- ufds[[filter_data]][[filter_key]][global_filtered_values()] fds <- ufds - # First we apply filtered datasets - + # Single dataset filtering fds[names(curr_dataset_filters)] <- purrr::imap( fds[names(curr_dataset_filters)], function(val, nm) { @@ -178,13 +176,11 @@ app_server_ <- function(input, output, session, opts) { } ) - # Then we apply global + # Global dataset filtering global_filtered <- purrr::map( fds, ~ dplyr::filter(.x, .data[[filter_key]] %in% filtered_key_values) # nolint ) - - }) From 7dced15eba779f8f4c28050a7db0409bc544c759 Mon Sep 17 00:00:00 2001 From: Luis Moris Fernandez Date: Mon, 7 Oct 2024 21:44:18 +0200 Subject: [PATCH 11/11] styling --- R/app_server.R | 32 +++++++++++++++-------------- R/app_ui.R | 16 +++++++-------- R/pharmaverse_data.R | 14 ++++++------- R/utils_helpers.R | 6 +++--- tests/testthat/test-shiny_general.R | 4 ++-- 5 files changed, 37 insertions(+), 35 deletions(-) diff --git a/R/app_server.R b/R/app_server.R index 913ccea..04559e1 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -133,23 +133,25 @@ app_server_ <- function(input, output, session, opts) { names(l) <- names(datasets_filters_info) for (idx in seq_along(datasets_filters_info)) { l[[idx]] <- local({ - curr_dataset_filter_info <- datasets_filters_info[[idx]] + curr_dataset_filter_info <- datasets_filters_info[[idx]] dv.filter::data_filter_server( - curr_dataset_filter_info[["id"]], - shiny::reactive({unfiltered_dataset()[[curr_dataset_filter_info[["name"]]]] %||% data.frame()}) - ) + curr_dataset_filter_info[["id"]], + shiny::reactive({ + unfiltered_dataset()[[curr_dataset_filter_info[["name"]]]] %||% data.frame() + }) + ) }) } l }) - filtered_dataset <- shinymeta::metaReactive({ - # dv.filter returns a logical vector. This contemplates the case of empty lists + filtered_dataset <- shinymeta::metaReactive({ + # dv.filter returns a logical vector. This contemplates the case of empty lists shiny::req(is.logical(global_filtered_values())) # Depend on all datasets - purrr::walk(dataset_filters, ~.x()) + purrr::walk(dataset_filters, ~ .x()) # We do not react to changed in unfiltered dataset, otherwise when a dataset changes # We filter the previous dataset which in the best case produces and extra reactive beat @@ -157,25 +159,25 @@ app_server_ <- function(input, output, session, opts) { # We don't want to control the error in (mvbc) because filtered dataset only changes when filter changes ufds <- shiny::isolate(unfiltered_dataset()) - curr_dataset_filters <- dataset_filters[intersect(names(dataset_filters), names(ufds))] - + curr_dataset_filters <- dataset_filters[intersect(names(dataset_filters), names(ufds))] + # Current dataset must be logical with length above 0 # Check dataset filters check all datafilters are initialized - purrr::walk(curr_dataset_filters, ~shiny::req(checkmate::test_logical(.x(), min.len = 1))) - + purrr::walk(curr_dataset_filters, ~ shiny::req(checkmate::test_logical(.x(), min.len = 1))) + filtered_key_values <- ufds[[filter_data]][[filter_key]][global_filtered_values()] fds <- ufds - + # Single dataset filtering fds[names(curr_dataset_filters)] <- purrr::imap( fds[names(curr_dataset_filters)], - function(val, nm) { + function(val, nm) { # (mvbc) - fds[[nm]][dataset_filters[[nm]](), , drop = FALSE] + fds[[nm]][dataset_filters[[nm]](), , drop = FALSE] } ) - + # Global dataset filtering global_filtered <- purrr::map( fds, diff --git a/R/app_ui.R b/R/app_ui.R index c4917dd..f626e06 100644 --- a/R/app_ui.R +++ b/R/app_ui.R @@ -31,20 +31,20 @@ app_ui <- function(id) { log_inform(glue::glue("Available modules (N): {length(module_list)}")) log_inform(glue::glue("Dataset options (N): {length(data)}")) - + dataset_filters_ui <- local({ datasets_filters_info <- get_dataset_filters_info(data, filter_data) purrr::map( datasets_filters_info, - function(entry) { + function(entry) { shiny::div( id = entry[["id_cont"]], class = "filter-control filter-filters", shiny::tags[["label"]](entry[["name"]]), dv.filter::data_filter_ui(ns(entry[["id"]])), shiny::hr(style = "border-top: 2px solid gray; height: 10px;") - ) - } + ) + } ) }) @@ -61,7 +61,7 @@ app_ui <- function(id) { ), shiny::selectInput(ns("selector"), label = NULL, choices = names(data)) )), - shiny::div( + shiny::div( class = "c-well shiny_filter", shiny::tags$label("Global Filter", class = "text-primary"), # shiny::tags$button( @@ -73,13 +73,13 @@ app_ui <- function(id) { # # onclick = sprintf("dv_manager.hide_filters('%s')", ns("global_button")) # ), shiny::div( - class = "filter-control filter-filters", + class = "filter-control filter-filters", dv.filter::data_filter_ui(ns("global_filter")) ) ), shiny::div( class = "c-well shiny_filter", - shiny::tags$label("Dataset Filter", class = "text-primary"), + shiny::tags$label("Dataset Filter", class = "text-primary"), dataset_filters_ui ) ) @@ -143,4 +143,4 @@ app_ui <- function(id) { )), dataset_name ) -} +} diff --git a/R/pharmaverse_data.R b/R/pharmaverse_data.R index 1c01e7b..1efc582 100644 --- a/R/pharmaverse_data.R +++ b/R/pharmaverse_data.R @@ -1,30 +1,30 @@ get_pharmaverse_data <- function(dataset) { if (!rlang::is_installed("pharmaverseadam")) stop("Please, install.package('pharmaverseadam')") - chr2fct <- function(x){ - x[] <- purrr::map(x, ~if(is.character(.x)) factor(.x) else .x) + chr2fct <- function(x) { + x[] <- purrr::map(x, ~ if (is.character(.x)) factor(.x) else .x) x } - cd2fct <- function(x){ - x[] <- purrr::imap(x, ~if(endsWith(.y, "CD")) factor(.x) else .x) + cd2fct <- function(x) { + x[] <- purrr::imap(x, ~ if (endsWith(.y, "CD")) factor(.x) else .x) x } if (dataset == "adsl") { - res <- pharmaverseadam::adsl |> + res <- pharmaverseadam::adsl |> chr2fct() |> cd2fct() return(res) } if (dataset == "adae") { - res <- pharmaverseadam::adae |> + res <- pharmaverseadam::adae |> chr2fct() |> cd2fct() return(res) } if (dataset == "adlb") { - res <- pharmaverseadam::adlb |> + res <- pharmaverseadam::adlb |> chr2fct() |> cd2fct() return(res) diff --git a/R/utils_helpers.R b/R/utils_helpers.R index b8e7708..5ca3ad0 100644 --- a/R/utils_helpers.R +++ b/R/utils_helpers.R @@ -57,13 +57,13 @@ get_data_tables_names <- function(data) { nm <- character(0) for (idx in seq_along(data)) { curr_data <- if (is.function(data[[idx]])) data[[idx]]() else data[[idx]] - nm <- union(nm, names(curr_data)) + nm <- union(nm, names(curr_data)) } return(nm) } get_dataset_filters_info <- function(data, filter_data) { - dataset_filter_names <- setdiff(get_data_tables_names(data), filter_data) + dataset_filter_names <- setdiff(get_data_tables_names(data), filter_data) purrr::map( dataset_filter_names, function(nm) { @@ -76,6 +76,6 @@ get_dataset_filters_info <- function(data, filter_data) { ) |> purrr::set_names(dataset_filter_names) } -`%||%` <- function(x,y){ +`%||%` <- function(x, y) { if (!is.null(x)) x else y } diff --git a/tests/testthat/test-shiny_general.R b/tests/testthat/test-shiny_general.R index 3d775d8..452f41e 100644 --- a/tests/testthat/test-shiny_general.R +++ b/tests/testthat/test-shiny_general.R @@ -255,11 +255,11 @@ local({ app$set_inputs("dataset_filter_46ab8635-vars" = "carb") app$wait_for_idle() - app$set_inputs("dataset_filter_46ab8635-carb" = c(1,1)) + app$set_inputs("dataset_filter_46ab8635-carb" = c(1, 1)) app$wait_for_idle() app$set_inputs("main_tab_panel" = "Filtered Carb") app$wait_for_idle() - val <- app$wait_for_value(output = "mod5-text", ignore = list("4"), timeout = 10000) + val <- app$wait_for_value(output = "mod5-text", ignore = list("4"), timeout = 10000) expect_identical(val, "2") } )