diff --git a/.gitignore b/.gitignore
index f6a14aa3..559ca9b5 100644
--- a/.gitignore
+++ b/.gitignore
@@ -5,3 +5,4 @@
/.idea/
rsconnect/rconnect.jnj.com/NHall6/phevaluator_v01.dcf
errorReportSql.txt
+tests/testthat/Rplots.pdf
diff --git a/DESCRIPTION b/DESCRIPTION
index 435a7e89..02eff0e2 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,7 +1,7 @@
Package: OhdsiShinyModules
Type: Package
Title: Repository of Shiny Modules for OHDSI Result Viewers
-Version: 3.0.2
+Version: 3.1.0
Authors@R: c(
person("Jenna", "Reps", email = "jreps@its.jnj.com", role = c("aut", "cre")),
person("Nathan", "Hall", role = c("aut")),
diff --git a/NEWS.md b/NEWS.md
index 47bfb716..cb3823d9 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,3 +1,10 @@
+OhdsiShinyModules v3.1.0
+========================
+- Removed percentage calculation from records field in CohortDiagnostics
+- Updated the About module to reflect new module names and structure
+- Updated module description vignette files to reflect new module names and structure
+- Added interactive scatterplots for binary covariates when doing database and cohort comparisons in Characterization
+
OhdsiShinyModules v3.0.2
========================
- Fixed bug with orphan concepts not loading
diff --git a/R/about-main.R b/R/about-main.R
index f5225ad7..2c0c9a4d 100644
--- a/R/about-main.R
+++ b/R/about-main.R
@@ -65,10 +65,12 @@ aboutViewer <- function(id = 'homepage') {
shinydashboard::valueBoxOutput(ns("cohortDiagnosticsBox"), width = 3)
),
shiny::fluidRow(
- shinydashboard::valueBoxOutput(ns("cohortMethodBox"), width = 3),
+ shinydashboard::valueBoxOutput(ns("estimationBox"), width = 3),
shinydashboard::valueBoxOutput(ns("predictionBox"), width = 3),
- shinydashboard::valueBoxOutput(ns("sccsBox"), width = 3),
- shinydashboard::valueBoxOutput(ns("evidenceSynthesisBox"), width = 3)
+ shinydashboard::valueBoxOutput(ns("reportGeneratorBox"), width = 3)
+ # ,
+ # shinydashboard::valueBoxOutput(ns("sccsBox"), width = 3),
+ # shinydashboard::valueBoxOutput(ns("evidenceSynthesisBox"), width = 3)
)
)
}
@@ -127,7 +129,7 @@ aboutServer <- function(id = 'homepage',
value = "Data Sources",
subtitle = "Data sources used in this analysis",
icon = shiny::icon("database"),
- color = "aqua",
+ color = "olive",
href = "https://ohdsi.github.io/OhdsiShinyModules/articles/DataSources.html"
)
} else {
@@ -169,7 +171,7 @@ aboutServer <- function(id = 'homepage',
value = "Characterization",
subtitle = "Characterization results for this analysis",
icon = shiny::icon("table"),
- color = "teal",
+ color = "red",
href = "https://ohdsi.github.io/OhdsiShinyModules/articles/Characterization.html"
)
} else {
@@ -205,23 +207,23 @@ aboutServer <- function(id = 'homepage',
})
- output$cohortMethodBox <-
+ output$estimationBox <-
shinydashboard::renderValueBox({
- if ("CohortMethod" %in% tab_names) {
+ if ("Estimation" %in% tab_names) {
targetedValueBox(
- value = "Cohort Method",
- subtitle = "Cohort Method results for this analysis",
+ value = "Estimation",
+ subtitle = "Population-level effect estimation results for this analysis",
icon = shiny::icon("chart-column"),
color = "maroon",
- href = "https://ohdsi.github.io/OhdsiShinyModules/articles/CohortMethod.html"
+ href = "https://ohdsi.github.io/OhdsiShinyModules/articles/Estimation.html"
)
} else {
targetedValueBox(
- value = "Cohort Method",
+ value = "Estimation",
subtitle = "This module was not included in this analysis",
icon = shiny::icon("chart-column"),
color = "black",
- href = "https://ohdsi.github.io/OhdsiShinyModules/articles/CohortMethod.html"
+ href = "https://ohdsi.github.io/OhdsiShinyModules/articles/Estimation.html"
)
}
})
@@ -231,7 +233,7 @@ aboutServer <- function(id = 'homepage',
if ("Prediction" %in% tab_names) {
targetedValueBox(
value = "Prediction",
- subtitle = "Patient-level Prediction results for this analysis",
+ subtitle = "Patient-level prediction results for this analysis",
icon = shiny::icon("chart-line"),
color = "blue",
href = "https://ohdsi.github.io/OhdsiShinyModules/articles/Prediction.html"
@@ -290,5 +292,27 @@ aboutServer <- function(id = 'homepage',
}
})
+ output$reportGeneratorBox <-
+ shinydashboard::renderValueBox({
+ if ("Report" %in% tab_names) {
+ targetedValueBox(
+ value = "Report",
+ subtitle = "Report Generator for this analysis",
+ icon = shiny::icon("book"),
+ color = "teal",
+ href = "https://ohdsi.github.io/OhdsiShinyModules/articles/ReportGenerator.html"
+ )
+ } else {
+ targetedValueBox(
+ value = "Report",
+ subtitle =
+ "This module was not included in this analysis",
+ icon = shiny::icon("book"),
+ color = "black",
+ href = "https://ohdsi.github.io/OhdsiShinyModules/articles/ReportGenerator.html"
+ )
+ }
+ })
+
})
}
diff --git a/R/characterization-cohorts.R b/R/characterization-cohorts.R
index 5ce7ccdc..69fb4f6a 100644
--- a/R/characterization-cohorts.R
+++ b/R/characterization-cohorts.R
@@ -49,7 +49,20 @@ characterizationCohortComparisonViewer <- function(id) {
),
shiny::tabPanel(
title = 'Binary',
- resultTableViewer(id = ns('mainTable'), boxTitle = 'Binary')
+ shiny::tabsetPanel(
+ type = 'pills',
+ id = ns('binaryPanel'),
+ shiny::tabPanel(
+ title = "Table",
+ resultTableViewer(id = ns('mainTable'), boxTitle = 'Binary')
+ ),
+ shiny::tabPanel(
+ title = "Plot",
+ shinycssloaders::withSpinner(
+ plotly::plotlyOutput(ns('scatterPlot'))
+ )
+ )
+ )
),
shiny::tabPanel(
title = 'Continuous',
@@ -281,9 +294,80 @@ characterizationCohortComparisonServer <- function(
elementId = session$ns('count-table-filter')
),
elementId = session$ns('count-table-filter')
- )}
+ )
+
+ }
+
+ #scatterplots
+
+ plotDf <- shiny::reactive({
+
+ # Get the filtered and processed plot data
+ plotData <- resultTable %>%
+ replace(is.na(.), 0) %>%
+ dplyr::mutate(domain = dplyr::case_when(
+ grepl("condition_", covariateName) | sub("\\s.*", "", covariateName) == "condition" ~ "Condition",
+ grepl("drug_", covariateName) | sub("\\s.*", "", covariateName) == "drug" ~ "Drug",
+ grepl("procedure_", covariateName) | sub("\\s.*", "", covariateName) == "procedure" ~ "Procedure",
+ grepl("measurement_", covariateName) | sub("\\s.*", "", covariateName) == "measurement" ~ "Measurement",
+ grepl("observation_", covariateName) | sub("\\s.*", "", covariateName) == "observation" ~ "Observation",
+ grepl("device_", covariateName) | sub("\\s.*", "", covariateName) == "device" ~ "Device",
+ grepl("cohort_", covariateName) | sub("\\s.*", "", covariateName) == "cohort" ~ "Cohort",
+ grepl("visit_", covariateName) | sub("\\s.*", "", covariateName) == "visit" ~ "Visit",
+ .default = "Demographic"
+ ))
+
+ # Create hover text for plotly
+ plotData$hoverText <- paste(
+ "Covariate Name:", plotData$covariateName,
+ "
", "Target", ":", scales::percent(plotData$averageValue_1),
+ "
", "Comparator", ":", scales::percent(plotData$averageValue_2)
+ )
+
+ #removing negatives, which come from "< min threshold"
+ plotData$averageValue_1[plotData$averageValue_1 < 0] <- 0
+ plotData$averageValue_2[plotData$averageValue_2 < 0] <- 0
+
+ return(plotData)
+
+ })
+
+ shiny::observe({
+ output$scatterPlot <- plotly::renderPlotly({
+
+ plotData <- plotDf()
+
+ # Create the scatter plot with the diagonal line (x = y)
+ p <- ggplot2::ggplot(plotData, ggplot2::aes( x = .data$averageValue_1,
+ y = .data$averageValue_2,
+ color = .data$domain,
+ text = .data$hoverText)) + # Use hoverText for hover labels
+ ggplot2::geom_point(size = 2) + # Smaller point size
+ ggplot2::geom_abline(slope = 1, intercept = 0, linetype = "dashed", color = "black") + # Diagonal x=y line in black
+ ggplot2::labs(
+ x = paste0("Target", " %"),
+ y = paste0("Comparator", " %"),
+ color = "Domain",
+ title = paste0("Database: ", names(inputVals()$databaseIds)[input$databaseId == inputVals()$databaseIds])
+ ) +
+ ggplot2::theme_minimal() + # Optional: use a clean theme
+ ggplot2::theme(
+ plot.title = ggplot2::element_text(margin = ggplot2::margin(b = 10), hjust = 0.5, size = 25, face="bold"),
+ legend.position = "right", # Position legend as needed
+ axis.title = ggplot2::element_text(size = 12), # Adjust axis title size
+ axis.text = ggplot2::element_text(size = 10) # Adjust axis text size
+ ) +
+ ggplot2::scale_x_continuous(labels = scales::percent_format()) + # Format x-axis as percentage
+ ggplot2::scale_y_continuous(labels = scales::percent_format()) # Format y-axis as percentage
+
+ # Convert to a plotly object for interactivity
+ plotly::ggplotly(p, tooltip = "text") # Use the custom hover text
+ })
+ })
})
+
+
return(invisible(NULL))
@@ -777,7 +861,7 @@ characterizatonGetCohortData <- function(
}
shiny::withProgress(message = 'characterizatonGetCohortData', value = 0, {
-
+
shiny::incProgress(1/4, detail = paste("Setting types"))
types <- data.frame(
@@ -862,13 +946,15 @@ characterizatonGetCohortData <- function(
result <- result %>% dplyr::select(-"firstVar",-"secondVar", -"N_1", -"N_2")
} else{
+ NULL
shiny::showNotification('Unable to add SMD due to missing columns')
}
}
shiny::incProgress(4/4, detail = paste("Done"))
})
- return(result)
+ return(result)
+
}
@@ -1014,3 +1100,61 @@ characterizationGetCohortsInputs <- function(
)
)
}
+
+characterizationGetCohortComparisonDataRaw <- function(
+ connectionHandler,
+ resultDatabaseSettings,
+ targetIds,
+ databaseIds,
+ minThreshold = 0.01,
+ addSMD = F
+){
+
+ if(is.null(targetIds) | is.null(databaseIds)){
+ warning('Ids cannot be NULL')
+ return(NULL)
+ }
+
+ sql <- "select d.cdm_source_abbreviation,
+ ref.covariate_name,
+ s.min_prior_observation,
+ cov.target_cohort_id as cohort_definition_id,
+ cg.cohort_name,
+ cov.* from
+ @schema.@c_table_prefixCOVARIATES cov
+ inner join
+ @schema.@c_table_prefixcovariate_ref ref
+ on cov.covariate_id = ref.covariate_id
+ and cov.setting_id = ref.setting_id
+ and cov.database_id = ref.database_id
+ inner join
+ @schema.@c_table_prefixsettings s
+ on s.database_id = cov.database_id
+ and s.setting_id = cov.setting_id
+ inner join
+ @schema.@database_table d
+ on cov.database_id = d.database_id
+ inner join
+ @schema.@cg_table_prefixcohort_definition cg
+ on cov.target_cohort_id = cg.cohort_definition_id
+
+ where
+ cov.target_cohort_id in (@target_ids)
+ and cov.cohort_type = 'Target'
+ AND cov.database_id in (@database_ids)
+ AND cov.average_value >= @min_threshold;"
+
+ # settings.min_characterization_mean needed?
+ res <- connectionHandler$queryDb(
+ sql = sql,
+ target_ids = paste0(targetIds, collapse = ','),
+ database_ids = paste0("'",databaseIds,"'", collapse = ','),
+ schema = resultDatabaseSettings$schema,
+ c_table_prefix = resultDatabaseSettings$cTablePrefix,
+ min_threshold = minThreshold,
+ database_table = resultDatabaseSettings$databaseTable,
+ cg_table_prefix = resultDatabaseSettings$cgTablePrefix
+ )
+
+ return(res)
+}
diff --git a/R/characterization-database.R b/R/characterization-database.R
index e787ee8e..f0104a28 100644
--- a/R/characterization-database.R
+++ b/R/characterization-database.R
@@ -48,7 +48,21 @@ characterizationDatabaseComparisonViewer <- function(id) {
),
shiny::tabPanel(
title = 'Binary',
- resultTableViewer(id = ns('mainTable'), boxTitle = 'Binary')
+ shiny::tabsetPanel(
+ type = 'pills',
+ id = ns('binaryPanel'),
+ shiny::tabPanel(
+ title = "Table",
+ resultTableViewer(id = ns('mainTable'), boxTitle = 'Binary')
+ ),
+ shiny::tabPanel(
+ title = "Plot",
+ shiny::uiOutput(ns('plotInputs')),
+ shinycssloaders::withSpinner(
+ plotly::plotlyOutput(ns('scatterPlot'))
+ )
+ )
+ )
),
shiny::tabPanel(
title = 'Continuous',
@@ -277,6 +291,208 @@ characterizationDatabaseComparisonServer <- function(
),
elementId = session$ns('continuous-table-filter')
)
+
+
+ #scatterplots
+
+ plotResult <- characterizatonGetDatabaseComparisonDataRaw(
+ connectionHandler = connectionHandler,
+ resultDatabaseSettings = resultDatabaseSettings,
+ targetIds = subTargetId(),
+ databaseIds = input$databaseIds,
+ minThreshold = input$minThreshold
+ )
+
+ names(plotResult$databaseId) <- plotResult$cdmSourceAbbreviation
+
+ output$plotInputs <- shiny::renderUI({
+ shiny::div(
+ shiny::fluidRow(
+ shiny::column(width = 5,
+ shinyWidgets::pickerInput(
+ inputId = session$ns('xAxis'),
+ label = 'X-Axis Database: ',
+ choices = unique(plotResult$cdmSourceAbbreviation),
+ selected = unique(plotResult$cdmSourceAbbreviation)[1],
+ multiple = F,
+ options = shinyWidgets::pickerOptions(
+ actionsBox = TRUE,
+ liveSearch = TRUE,
+ size = 10,
+ dropupAuto = TRUE,
+ liveSearchStyle = "contains",
+ liveSearchPlaceholder = "Type here to search",
+ virtualScroll = 50
+ )
+ )
+ ),
+ shiny::column(width = 5,
+ shinyWidgets::pickerInput(
+ inputId = session$ns('yAxis'),
+ label = 'Y-Axis Database: ',
+ choices = unique(plotResult$cdmSourceAbbreviation),
+ selected = unique(plotResult$cdmSourceAbbreviation)[2],
+ multiple = F,
+ options = shinyWidgets::pickerOptions(
+ actionsBox = TRUE,
+ liveSearch = TRUE,
+ size = 10,
+ dropupAuto = TRUE,
+ liveSearchStyle = "contains",
+ liveSearchPlaceholder = "Type here to search",
+ virtualScroll = 50
+ )
+ )
+ )
+ ),
+ shiny::fluidRow(
+ shiny::column(
+ width = 4,
+ shiny::actionButton(
+ inputId = session$ns('generatePlot'),
+ label = 'Generate Plot'
+ )
+ )
+ )
+ )
+ })
+
+ #get results
+ selectedPlotDbs <- shiny::reactiveVal()
+ shiny::observeEvent(input$generatePlot,{
+
+ plotDf <- shiny::reactive({
+
+ # Filter the plot result based on selected xAxis and yAxis inputs
+ plotResult2 <- plotResult %>%
+ dplyr::filter(.data$cdmSourceAbbreviation %in% c(input$xAxis, input$yAxis))
+
+ # Group and split the data by cdmSourceAbbreviation
+ plotResultDbSplit <- plotResult2 %>%
+ dplyr::group_by(.data$cdmSourceAbbreviation) %>%
+ dplyr::group_split()
+
+ # Initialize an empty list to store the processed dataframes
+ processedDfs <- list()
+
+ # Loop over the split datasets and process each one
+ for (i in seq_along(plotResultDbSplit)) {
+
+ currentDb <- plotResultDbSplit[[i]]
+
+ currentDbDf <- currentDb %>%
+ dplyr::select(cdmSourceAbbreviation,
+ covariateName,
+ averageValue)
+
+ # Ensure only rows with selected xAxis or yAxis inputs are kept
+ currentDbDf <- currentDbDf %>%
+ dplyr::filter(.data$cdmSourceAbbreviation %in% c(input$xAxis, input$yAxis))
+
+ # Get the name for this database (should be unique after filtering)
+ dbName <- unique(currentDbDf$cdmSourceAbbreviation)
+
+ # Rename the averageValue column based on the database name
+ colnames(currentDbDf) <- c("cdmSourceAbbreviation", "covariateName", paste0(dbName, "_avg"))
+
+ # Remove the cdmSourceAbbreviation column for joining later
+ currentDbDf <- currentDbDf %>%
+ dplyr::select(-cdmSourceAbbreviation)
+
+ # Append the processed dataframe to the list
+ processedDfs[[i]] <- currentDbDf
+ }
+
+ # Check if there's at least one dataframe to join
+ if (length(processedDfs) > 1) {
+ # Perform a left join across all processed dataframes
+ plotResultDbComb <- Reduce(function(x, y) dplyr::left_join(x, y, by = "covariateName"), processedDfs)
+ } else {
+ # If there's only one dataframe, no need for joining
+ plotResultDbComb <- processedDfs[[1]]
+ }
+
+ # Replace NA values with 0
+ plotResultDbComb <- plotResultDbComb %>%
+ replace(is.na(.), 0) %>%
+ dplyr::mutate(domain = dplyr::case_when(
+ grepl("condition_", covariateName) | sub("\\s.*", "", covariateName) == "condition" ~ "Condition",
+ grepl("drug_", covariateName) | sub("\\s.*", "", covariateName) == "drug" ~ "Drug",
+ grepl("procedure_", covariateName) | sub("\\s.*", "", covariateName) == "procedure" ~ "Procedure",
+ grepl("measurement_", covariateName) | sub("\\s.*", "", covariateName) == "measurement" ~ "Measurement",
+ grepl("observation_", covariateName) | sub("\\s.*", "", covariateName) == "observation" ~ "Observation",
+ grepl("device_", covariateName) | sub("\\s.*", "", covariateName) == "device" ~ "Device",
+ grepl("cohort_", covariateName) | sub("\\s.*", "", covariateName) == "cohort" ~ "Cohort",
+ grepl("visit_", covariateName) | sub("\\s.*", "", covariateName) == "visit" ~ "Visit",
+ .default = "Demographic"
+ ))
+
+ return(plotResultDbComb)
+
+
+
+ })
+
+ #plot
+
+ shiny::observe({
+ output$scatterPlot <- plotly::renderPlotly({
+
+ # Get the filtered and processed plot data
+ plotData <- plotDf()
+
+ # Ensure that the reactive inputs are valid and accessible
+ xAxisInput <- input$xAxis
+ yAxisInput <- input$yAxis
+
+ # Sanitize the xAxis and yAxis input values by replacing spaces with underscores
+ xAxisSafe <- gsub(" ", "_", xAxisInput)
+ yAxisSafe <- gsub(" ", "_", yAxisInput)
+
+ # Sanitize column names in plotData to replace spaces with underscores
+ colnames(plotData) <- gsub(" ", "_", colnames(plotData))
+
+ # Ensure that the column names exist in plotData
+ if (!all(c(paste0(xAxisSafe, "_avg"), paste0(yAxisSafe, "_avg")) %in% colnames(plotData))) {
+ stop("Selected columns not found in data.")
+ }
+
+ # Create hover text for plotly
+ plotData$hoverText <- paste(
+ "Covariate Name:", plotData$covariateName,
+ "
", xAxisInput, ":", scales::percent(plotData[[paste0(xAxisSafe, "_avg")]]),
+ "
", yAxisInput, ":", scales::percent(plotData[[paste0(yAxisSafe, "_avg")]])
+ )
+
+ # Create the scatter plot with the diagonal line (x = y)
+ p <- ggplot2::ggplot(plotData, ggplot2::aes_string(x = paste0(xAxisSafe, "_avg"),
+ y = paste0(yAxisSafe, "_avg"),
+ color = "domain",
+ text = "hoverText")) + # Use hoverText for hover labels
+ ggplot2::geom_point(size = 2) + # Smaller point size
+ ggplot2::geom_abline(slope = 1, intercept = 0, linetype = "dashed", color = "black") + # Diagonal x=y line in black
+ ggplot2::labs(
+ x = paste0(xAxisInput, " %"),
+ y = paste0(yAxisInput, " %"),
+ color = "Domain"
+ ) +
+ ggplot2::theme_minimal() + # Optional: use a clean theme
+ ggplot2::theme(
+ legend.position = "right", # Position legend as needed
+ axis.title = ggplot2::element_text(size = 12), # Adjust axis title size
+ axis.text = ggplot2::element_text(size = 10) # Adjust axis text size
+ ) +
+ ggplot2::scale_x_continuous(labels = scales::percent_format()) + # Format x-axis as percentage
+ ggplot2::scale_y_continuous(labels = scales::percent_format()) # Format y-axis as percentage
+
+ # Convert to a plotly object for interactivity
+ plotly::ggplotly(p, tooltip = "text") # Use the custom hover text
+ })
+ })
+
+
+ })
+
})
@@ -327,3 +543,56 @@ characterizatonGetDatabaseComparisonData <- function(
)
}
+
+characterizatonGetDatabaseComparisonDataRaw <- function(
+ connectionHandler,
+ resultDatabaseSettings,
+ targetIds,
+ databaseIds,
+ minThreshold = 0.01,
+ addSMD = F
+){
+
+ if(is.null(targetIds) | is.null(databaseIds)){
+ warning('Ids cannot be NULL')
+ return(NULL)
+ }
+
+ sql <- "select d.cdm_source_abbreviation,
+ ref.covariate_name,
+ s.min_prior_observation,
+ cov.target_cohort_id as cohort_definition_id,
+ cov.* from
+ @schema.@c_table_prefixCOVARIATES cov
+ inner join
+ @schema.@c_table_prefixcovariate_ref ref
+ on cov.covariate_id = ref.covariate_id
+ and cov.setting_id = ref.setting_id
+ and cov.database_id = ref.database_id
+ inner join
+ @schema.@c_table_prefixsettings s
+ on s.database_id = cov.database_id
+ and s.setting_id = cov.setting_id
+ inner join
+ @schema.@database_table d
+ on cov.database_id = d.database_id
+
+ where
+ cov.target_cohort_id in (@target_ids)
+ and cov.cohort_type = 'Target'
+ AND cov.database_id in (@database_ids)
+ AND cov.average_value >= @min_threshold;"
+
+ # settings.min_characterization_mean needed?
+ res <- connectionHandler$queryDb(
+ sql = sql,
+ target_ids = paste0(targetIds, collapse = ','),
+ database_ids = paste0("'",databaseIds,"'", collapse = ','),
+ schema = resultDatabaseSettings$schema,
+ c_table_prefix = resultDatabaseSettings$cTablePrefix,
+ min_threshold = minThreshold,
+ database_table = resultDatabaseSettings$databaseTable
+ )
+
+ return(res)
+}
diff --git a/R/cohort-diagnostics-indexEventBreakdown.R b/R/cohort-diagnostics-indexEventBreakdown.R
index 25a3ea2f..b47416c9 100644
--- a/R/cohort-diagnostics-indexEventBreakdown.R
+++ b/R/cohort-diagnostics-indexEventBreakdown.R
@@ -69,7 +69,7 @@ indexEventBreakdownView <- function(id) {
shiny::tags$td(
shiny::checkboxInput(
inputId = ns("showAsPercent"),
- label = "Show as percentage",
+ label = "Show persons as percentage",
value = TRUE
)
)
@@ -232,17 +232,20 @@ indexEventBreakdownModule <- function(id,
if (showDataAsPercent) {
data <- data %>%
dplyr::rename(
- "persons" = "subjectPercent",
- "records" = "conceptPercent"
+ "persons" = "subjectPercent"
)
} else {
data <- data %>%
dplyr::rename(
- "persons" = "subjectCount",
- "records" = "conceptCount"
+ "persons" = "subjectCount"
)
}
+ data <- data %>%
+ dplyr::rename(
+ "records" = "conceptCount"
+ )
+
data <- data %>%
dplyr::arrange(dplyr::desc(abs(dplyr::across(
c("records", "persons")
@@ -278,6 +281,7 @@ indexEventBreakdownModule <- function(id,
countLocation = countLocation,
dataColumns = dataColumnFields,
showDataAsPercent = showDataAsPercent,
+ excludedColumnFromPercentage = "records",
sort = TRUE
)
})
diff --git a/R/cohort-diagnostics-main.R b/R/cohort-diagnostics-main.R
index c669aaf9..825c9128 100644
--- a/R/cohort-diagnostics-main.R
+++ b/R/cohort-diagnostics-main.R
@@ -621,6 +621,9 @@ cohortDiagnosticsServer <- function(id,
if (!hasData(targetCohortId())) {
return(NULL)
}
+ if (sum(c('cohortId','conceptSetName') %in% colnames(dataSource$conceptSets)) !=2) {
+ return(NULL)
+ }
dataSource$conceptSets %>%
dplyr::filter(.data$cohortId == targetCohortId()) %>%
dplyr::mutate(name = .data$conceptSetName) %>%
diff --git a/docs/404.html b/docs/404.html
index 34ed2cc6..8ad319b3 100644
--- a/docs/404.html
+++ b/docs/404.html
@@ -18,7 +18,7 @@