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(\"",
+ "",
+ "\");"
+ ))
)
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