diff --git a/R/evaluateStandard.R b/R/evaluateStandard.R index 55c8a128..0b7c78b9 100644 --- a/R/evaluateStandard.R +++ b/R/evaluateStandard.R @@ -46,7 +46,7 @@ evaluateStandard <- function(data, meta, domain, standard){ compare_summary<-list() compare_summary[["standard"]]<-standard - domainMeta<-meta %>% filter(domain==!!domain) + domainMeta<-meta %>% filter(tolower(domain)==!!domain) standardMap <- domainMeta%>%pull(paste0("standard_",!!standard)) names(standardMap)<-domainMeta%>%pull(.data$text_key) compare_summary[["mapping"]] <- domainMeta %>% diff --git a/R/mod_filterTab.R b/R/mod_filterTab.R index a2266fe3..0eb8040e 100644 --- a/R/mod_filterTab.R +++ b/R/mod_filterTab.R @@ -96,18 +96,27 @@ filterTab <- function(input, output, session, domainData, filterDomain, current_ ) } + n <- nrow(res_filter$filtered()) + N <- nrow(raw()) + shinyjs::html( "header-count", - nrow(res_filter$filtered()), + n, asis=TRUE ) shinyjs::html( "header-total", - nrow(raw()), + N, asis=TRUE ) + # Emphasize population header when subset is applied. + shinyjs::toggleClass( + selector = "#population-header", + class = "subset", + condition = n < N + ) }) observe({ diff --git a/R/mod_safetyGraphicsUI.R b/R/mod_safetyGraphicsUI.R index 81a55b9b..523b0a22 100644 --- a/R/mod_safetyGraphicsUI.R +++ b/R/mod_safetyGraphicsUI.R @@ -20,10 +20,16 @@ safetyGraphicsUI <- function(id, meta, domainData, mapping, standards){ #script to append population badge nav bar participant_badge<-tags$script( - HTML( - "var header = $('.navbar> .container-fluid'); - header.append('
/
');" - ) + HTML(paste0( + "var header = $('.navbar > .container-fluid');", + "header.append(\"", + "
", + "", + "/", + " participants", + "
", + "\");" + )) ) if(isNamespaceLoaded("shinybusy")){ spinner<-shinybusy::add_busy_spinner(spin = "atom", position="bottom-right") diff --git a/inst/report/safetyGraphicsReport.Rmd b/inst/report/safetyGraphicsReport.Rmd index a9c64bc1..09f84d56 100644 --- a/inst/report/safetyGraphicsReport.Rmd +++ b/inst/report/safetyGraphicsReport.Rmd @@ -50,7 +50,7 @@ chart<-params$chart header <- makeChartSummary(chart, class="chart-md") chart_params <- makeChartParams(data, chart, mapping) -mapping_list<-generateMappingList(mapping %>% filter(domain %in% chart$domain)) +mapping_list<-generateMappingList(mapping %>% dplyr::filter(domain %in% chart$domain)) if(length(mapping_list)==1){ mapping_list <- mapping_list[[1]] } diff --git a/inst/www/index.css b/inst/www/index.css index efdc5f3c..ded3585c 100644 --- a/inst/www/index.css +++ b/inst/www/index.css @@ -64,6 +64,10 @@ table.metatable.dataTable tr > td:last-of-type, table.metatable.trdataTable tr > margin-top:1em; } +#population-header.subset { + background: blue; +} + #dataSettings-previews .nav-tabs{ margin-bottom: 1em; } diff --git a/tests/testthat/test_evaluateStandard.R b/tests/testthat/test_evaluateStandard.R index a446b6ed..32489521 100644 --- a/tests/testthat/test_evaluateStandard.R +++ b/tests/testthat/test_evaluateStandard.R @@ -42,4 +42,10 @@ test_that("invalid options throw errors",{ expect_error(evaluateStandard(data=safetyData::adam_adlbc,domain="labs", meta=safetyCharts::meta_labs, standard="adam", includeFieldsIsNotAnOptionNow="yesPlease")) expect_error(evaluateStandard(data=safetyData::adam_adlbc,domain="labs", meta=list(), standard="sdtm")) expect_error(evaluateStandard(data=safetyData::adam_adlbc,domain="labs", meta=safetyData::adam_adlbc, standard="sdtm")) +}) + + +test_that("upper case domain names are supported",{ + uppermeta <- safetyCharts::meta_labs %>% mutate(domain="LaBs") + expect_equal(evaluateStandard(data=safetyData::adam_adlbc, domain="lAbS", meta= uppermeta, standard="adam")[["match"]],"full") }) \ No newline at end of file