diff --git a/DESCRIPTION b/DESCRIPTION
index 6605b16..2c9db9e 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -36,7 +36,9 @@ Imports:
tippy,
knitr,
duckdb,
- flexdashboard
+ flexdashboard,
+ fontawesome,
+ htmltools
Remotes:
OHDSI/DataQualityDashboard
Depends:
diff --git a/R/buildStatusDashboard.R b/R/buildStatusDashboard.R
index 3c5f5f8..99c1d8b 100644
--- a/R/buildStatusDashboard.R
+++ b/R/buildStatusDashboard.R
@@ -29,9 +29,7 @@ buildStatusDashboard <- function(
connectionDetails,
vocabularyDatabaseSchema,
outputFolderPath = tempdir(),
- fileIssueRepo = ""
- ) {
-
+ fileIssueRepo = "") {
#
# Validate parameters
#
@@ -62,7 +60,7 @@ buildStatusDashboard <- function(
targetVocabularyIds <- vocabulariesCoverageTibble$target_vocabulary_ids[i]
targetVocabularyIds <- stringr::str_split(targetVocabularyIds, "\\|") |> unlist()
mantainedBy <- vocabulariesCoverageTibble$mantained_by[i]
-
+
vocabularyTibble <- vocabulariesTibble |>
dplyr::filter(source_vocabulary_id == sourceVocabularyId)
@@ -96,14 +94,14 @@ buildStatusDashboard <- function(
# build page for coverage of all databases
.pageCoverageVocabularyDatabases(
- summaryTableForVocabularyAndDatabaseList = summaryTableForVocabularyAndDatabaseList,
- usagiTibble = usagiTibble,
- sourceVocabularyId = sourceVocabularyId,
- outputFolderPath = outputFolderPath,
- pathToNewsFile = pathToNewsFile,
- fileIssueRepo = fileIssueRepo
+ summaryTableForVocabularyAndDatabaseList = summaryTableForVocabularyAndDatabaseList,
+ usagiTibble = usagiTibble,
+ sourceVocabularyId = sourceVocabularyId,
+ outputFolderPath = outputFolderPath,
+ pathToNewsFile = pathToNewsFile,
+ fileIssueRepo = fileIssueRepo
)
-
+
# create summary for all databases
summaryVocabulary <- tibble::tibble(
vocabularyId = sourceVocabularyId,
@@ -113,7 +111,7 @@ buildStatusDashboard <- function(
for (databaseName in names(summaryTableForVocabularyAndDatabaseList)) {
message("Processing database: ", databaseName)
-
+
summaryTableForVocabularyAndDatabase <- summaryTableForVocabularyAndDatabaseList[[databaseName]]
nMapped <- summaryTableForVocabularyAndDatabase |>
@@ -137,7 +135,6 @@ buildStatusDashboard <- function(
strCoverage <- paste0(nMapped, "-", nUnmapped, "-", nInvalid)
summaryVocabulary[[databaseName]] <- strCoverage
-
}
# add summary for all databases to summary for all vocabularies
@@ -195,7 +192,7 @@ buildStatusDashboard <- function(
columns_list <- list(
vocabularyId = reactable::colDef(
name = "Vocabulary",
- maxWidth = 150,
+ maxWidth = 150,
cell = function(value) {
paste0("", value, "")
},
@@ -382,9 +379,8 @@ buildStatusDashboard <- function(
usagiTibble,
sourceVocabularyId,
outputFolderPath,
- pathToNewsFile,
- fileIssueRepo = ""
- ) {
+ pathToNewsFile,
+ fileIssueRepo = "") {
summaryTableForVocabularyAndDatabaseList |> checkmate::assert_list()
usagiTibble |> checkmate::assert_tibble(null.ok = TRUE)
sourceVocabularyId |> checkmate::assert_string()
@@ -418,7 +414,7 @@ buildStatusDashboard <- function(
append(("```\n")) |>
append(("### Coverage\n")) |>
append(("```{r}\n")) |>
- append((".plotTableForVocabularyAndDatabase(summaryTableForVocabularyAndDatabase, fileIssueRepo = fileIssueRepo)\n")) |>
+ append(paste0(".plotTableForVocabularyAndDatabase(summaryTableForVocabularyAndDatabase, databaseName = '", database, "', vocabularyId = '", sourceVocabularyId, "', fileIssueRepo = '", fileIssueRepo, "')\n")) |>
append(("```\n"))
}
@@ -429,11 +425,11 @@ buildStatusDashboard <- function(
# read news file
if (!is.null(pathToNewsFile)) {
newsFile <- readLines(pathToNewsFile) |>
- paste0(collapse = "\n")
+ paste0(collapse = "\n")
} else {
newsFile <- NULL
}
-
+
rmarkdown::render(
input = tempTemplatePath,
params = list(
@@ -462,8 +458,7 @@ buildStatusDashboard <- function(
unmapped = "#F1AE4A",
mapsTo = "#51A350",
grey = "#AAAAAA"
- )
- ) {
+ )) {
toPlot <- summaryTableForVocabularyAndDatabase |>
dplyr::mutate(
statusColor = dplyr::case_when(
@@ -543,20 +538,23 @@ buildStatusDashboard <- function(
#' Plot detailed table for a vocabulary and database
#'
#' @param summaryTableForVocabularyAndDatabase Tibble with summary
+#' @param databaseName Database name
+#' @param vocabularyId Vocabulary ID
#' @param colors List of colors
#' @param fileIssueRepo The repository to file issues to
#' @return A reactable table object
#' @importFrom reactable reactable colDef colFormat
.plotTableForVocabularyAndDatabase <- function(
summaryTableForVocabularyAndDatabase,
+ databaseName,
+ vocabularyId,
colors = list(
invalid = "#EC6173",
unmapped = "#F1AE4A",
mapsTo = "#51A350",
grey = "#AAAAAA"
),
- fileIssueRepo = ""
- ) {
+ fileIssueRepo = "") {
athenaUrl <- "https://athena.ohdsi.org/search-terms/terms/"
toPlot <- summaryTableForVocabularyAndDatabase |>
@@ -591,13 +589,16 @@ buildStatusDashboard <- function(
targetCode = targetCode,
equivalence = equivalence,
targetVocabularyId = targetVocabularyId,
- targetName = dplyr::if_else(!is.na(targetConceptName), paste0("", targetConceptName, ""), ""),
+ targetConceptId = targetConceptId,
+ targetName = targetConceptName,
nEvents = nEvents,
pEvents = pEvents,
- statusSetBy = statusSetBy,
- fileIssue = paste0("File issue")
+ statusSetBy = statusSetBy,
+ fileIssue = paste0(
+ "File issue"
+ )
) |>
dplyr::arrange(dplyr::desc(nEvents))
@@ -657,10 +658,23 @@ buildStatusDashboard <- function(
targetVocabularyId = reactable::colDef(
show = FALSE
),
+ # Target Concept Id
+ targetConceptId = reactable::colDef(
+ show = FALSE
+ ),
# Target Name
targetName = reactable::colDef(
name = "Target Name",
- html = TRUE
+ html = TRUE,
+ cell = function(value, index){
+ targetConceptId <- toPlot$targetConceptId[index]
+ targetName <- toPlot$targetName[index]
+ if (!is.na(targetConceptId)) {
+ paste0("", targetName, "")
+ } else {
+ targetName
+ }
+ }
),
# N Events
nEvents = reactable::colDef(
@@ -701,7 +715,7 @@ buildStatusDashboard <- function(
columns$fileIssue <- reactable::colDef(
show = FALSE
)
- }else{
+ } else {
columns$fileIssue <- reactable::colDef(
name = "File issue",
maxWidth = 100,
@@ -709,12 +723,23 @@ buildStatusDashboard <- function(
)
}
- reactable::reactable(
- toPlot,
- columns = columns,
- resizable = TRUE,
- filterable = TRUE,
- defaultPageSize = 10
+ elementId <- paste0(vocabularyId, "_for_", databaseName, "_mappings_status")
+
+ htmltools::browsable(
+ htmltools::tagList(
+ htmltools::tags$button(
+ htmltools::tagList(fontawesome::fa("download"), "Download as CSV"),
+ onclick = paste0("Reactable.downloadDataCSV('", elementId, "', '", elementId, ".csv')")
+ ),
+ reactable::reactable(
+ toPlot,
+ columns = columns,
+ resizable = TRUE,
+ filterable = TRUE,
+ defaultPageSize = 10,
+ elementId = elementId
+ )
+ )
)
}
@@ -782,7 +807,9 @@ buildStatusDashboard <- function(
)) {
usagiTibble |> checkmate::assert_tibble()
colors |> checkmate::assert_list()
- colors |> names() |> checkmate::assert_subset(c("flagged", "unchecked", "approved", "inexact"))
+ colors |>
+ names() |>
+ checkmate::assert_subset(c("flagged", "unchecked", "approved", "inexact"))
toPlot <- usagiTibble |>
dplyr::group_by(mappingStatus, statusSetBy) |>
@@ -904,7 +931,7 @@ buildStatusDashboard <- function(
sourceVocabularyId |> checkmate::assert_string()
targetVocabularyIds |> checkmate::assert_character()
databaseName |> checkmate::assert_string()
-
+
codeCounts <- .getCodeCountsForVocabularyAndDatabase(
pathToCodeCountsFolder = pathToCodeCountsFolder,
sourceVocabularyId = sourceVocabularyId,
@@ -925,7 +952,7 @@ buildStatusDashboard <- function(
pathToVocabularyFolder = pathToVocabularyFolder,
sourceVocabularyId = sourceVocabularyId
)
-
+
summaryTableForVocabularyAndDatabase <- codeCounts |>
dplyr::full_join(databaseSummary |> dplyr::select(-sourceVocabularyId), by = c("sourceCode" = "sourceCode")) |>
dplyr::left_join(usagiSummary, by = c("sourceConceptId" = "sourceConceptId", "targetConceptId" = "targetConceptId")) |>
@@ -953,7 +980,6 @@ buildStatusDashboard <- function(
pathToCodeCountsFolder,
sourceVocabularyId,
databaseName) {
-
pathToCodeCountsFolder |> checkmate::assert_directory()
sourceVocabularyId |> checkmate::assert_string()
databaseName |> checkmate::assert_string()
@@ -992,7 +1018,7 @@ buildStatusDashboard <- function(
targetVocabularyIds) {
connection <- DatabaseConnector::connect(connectionDetails)
- connectionDetails |> checkmate::assert_class("ConnectionDetails")
+ connectionDetails |> checkmate::assert_class("ConnectionDetails")
vocabularyDatabaseSchema |> checkmate::assert_string()
targetVocabularyIds |> checkmate::assert_character()
@@ -1018,7 +1044,7 @@ buildStatusDashboard <- function(
LEFT JOIN @vocabulary_database_schema.CONCEPT AS c2
ON cr.concept_id_2 = c2.concept_id
"
-
+
sql <- SqlRender::render(
sql = sql,
vocabulary_database_schema = vocabularyDatabaseSchema,
diff --git a/man/dot-plotTableForVocabularyAndDatabase.Rd b/man/dot-plotTableForVocabularyAndDatabase.Rd
index c4d6e1c..7542839 100644
--- a/man/dot-plotTableForVocabularyAndDatabase.Rd
+++ b/man/dot-plotTableForVocabularyAndDatabase.Rd
@@ -6,6 +6,8 @@
\usage{
.plotTableForVocabularyAndDatabase(
summaryTableForVocabularyAndDatabase,
+ databaseName,
+ vocabularyId,
colors = list(invalid = "#EC6173", unmapped = "#F1AE4A", mapsTo = "#51A350", grey =
"#AAAAAA"),
fileIssueRepo = ""
@@ -14,6 +16,10 @@
\arguments{
\item{summaryTableForVocabularyAndDatabase}{Tibble with summary}
+\item{databaseName}{Database name}
+
+\item{vocabularyId}{Vocabulary ID}
+
\item{colors}{List of colors}
\item{fileIssueRepo}{The repository to file issues to}