diff --git a/.gitignore b/.gitignore index 40bc2d83..f6a14aa3 100644 --- a/.gitignore +++ b/.gitignore @@ -3,3 +3,5 @@ .RData .Ruserdata /.idea/ +rsconnect/rconnect.jnj.com/NHall6/phevaluator_v01.dcf +errorReportSql.txt diff --git a/DESCRIPTION b/DESCRIPTION index 18851c3e..537a9ad1 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -36,6 +36,7 @@ Imports: shinydashboard, shinyWidgets, SqlRender, + stringi, stringr, tibble, tidyr, diff --git a/NAMESPACE b/NAMESPACE index f11724c2..f3f39ddd 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -16,6 +16,7 @@ export(cohortOverlapView) export(compareCohortCharacterizationView) export(conceptsInDataSourceView) export(createCdDatabaseDataSource) +export(createCustomColDefList) export(dataDiagnosticDrillServer) export(dataDiagnosticDrillViewer) export(dataDiagnosticHelperFile) @@ -24,6 +25,9 @@ export(dataDiagnosticSummaryServer) export(dataDiagnosticSummaryViewer) export(dataDiagnosticViewer) export(databaseInformationView) +export(datasourcesHelperFile) +export(datasourcesServer) +export(datasourcesViewer) export(descriptionAggregateFeaturesServer) export(descriptionAggregateFeaturesViewer) export(descriptionDechallengeRechallengeServer) @@ -72,6 +76,7 @@ export(getLogoImage) export(incidenceRatesView) export(inclusionRulesView) export(indexEventBreakdownView) +export(makeButtonLabel) export(orpahanConceptsView) export(phevaluatorHelperFile) export(phevaluatorServer) @@ -99,6 +104,8 @@ export(predictionSettingsViewer) export(predictionValidationServer) export(predictionValidationViewer) export(predictionViewer) +export(resultTableServer) +export(resultTableViewer) export(sccsDiagnosticsSummaryServer) export(sccsDiagnosticsSummaryViewer) export(sccsHelperFile) diff --git a/R/cohort-generator-main.R b/R/cohort-generator-main.R index 5551b1e4..a5775ead 100644 --- a/R/cohort-generator-main.R +++ b/R/cohort-generator-main.R @@ -505,7 +505,7 @@ cohortGeneratorServer <- function( "Generation Start Time", "The time and date the cohort started generating" ), - format = reactable::colFormat(datetime = TRUE + format = reactable::colFormat(suffix = " mins" )), endTime = reactable::colDef( header = withTooltip( @@ -574,8 +574,8 @@ cohortGeneratorServer <- function( cohortNames <- unique(inputVals$cohortName) databaseIds <- unique(inputVals$cdmSourceName) inputValsClean <- dplyr::ungroup(inputVals) %>% - dplyr::mutate(modeId = dplyr::case_when( - modeId==1 ~ "Subject", + dplyr::mutate('modeId' = dplyr::case_when( + .data$modeId==1 ~ "Subject", TRUE ~ "Record" ) ) diff --git a/R/components-data-viewer.R b/R/components-data-viewer.R index de905ae7..93c807c0 100644 --- a/R/components-data-viewer.R +++ b/R/components-data-viewer.R @@ -9,11 +9,13 @@ #' Result Table Viewer #' #' @param id string +#' @param downloadedFileName string, desired name of downloaded data file. can use the name from the module that is being used #' #' @return shiny module UI #' @export #' -resultTableViewer <- function(id = "result-table") { +resultTableViewer <- function(id = "result-table", + downloadedFileName = NULL) { ns <- shiny::NS(id) shiny::div(# UI shinydashboard::box( @@ -41,6 +43,7 @@ resultTableViewer <- function(id = "result-table") { "Reactable.downloadDataCSV('", ns('resultData'), "', 'result-data-filtered-", + downloadedFileName, Sys.Date(), ".csv')" ) @@ -76,17 +79,14 @@ withTooltip <- function(value, tooltip, ...) { # ) - - - create_colDefs_list <- function(df, customColDefs = NULL) { # Get the column names of the input data frame col_names <- colnames(df) - + # Create an empty list to store the colDefs colDefs_list <- vector("list", length = length(col_names)) names(colDefs_list) <- col_names - + # Define custom colDefs for each column if provided if (!is.null(customColDefs)) { for (col in seq_along(col_names)) { @@ -95,11 +95,11 @@ create_colDefs_list <- function(df, customColDefs = NULL) { } else { colDefs_list[[col]] <- reactable::colDef(name = col_names[col]) } - + if (!is.null(customColDefs[[col_names[col]]]$header)) { colDefs_list[[col]]$header <- customColDefs[[col_names[col]]]$header } - + if (!is.null(customColDefs[[col_names[col]]]$tooltip)) { colDefs_list[[col]]$header <- withTooltip(colDefs_list[[col]]$header, customColDefs[[col_names[col]]]$tooltip) @@ -111,98 +111,11 @@ create_colDefs_list <- function(df, customColDefs = NULL) { colDefs_list[[col]] <- reactable::colDef(name = col_names[col]) } } - + # Return the list of colDefs return(colDefs_list) } -# Function to check if a column is formatted like a JSON file -# is_JSON_column <- function(column) { -# all(sapply(column, function(value) { -# suppressWarnings(jsonlite::fromJSON(value)) -# !is.null(jsonlite::validate(value)) -# })) -# } -# -# downloadJSON <- function(jsonData) { -# json <- jsonlite::fromJSON(jsonData) -# filename <- paste0("data-", Sys.Date(), ".json") -# jsonlite::write_json(json, file = filename) -# shiny::downloadHandler( -# filename = filename, -# content = function(file) { -# file.copy(filename, file) -# }, -# contentType = "application/json" -# ) -# } - -# create_colDefs_list <- function(df, customColDefs = NULL) { -# # Get the column names of the input data frame -# col_names <- colnames(df) -# -# # Create an empty list to store the colDefs -# colDefs_list <- vector("list", length = length(col_names)) -# names(colDefs_list) <- col_names -# -# # Define custom colDefs for each column if provided -# if (!is.null(customColDefs)) { -# for (col in seq_along(col_names)) { -# if (col_names[col] %in% names(customColDefs)) { -# colDefs_list[[col]] <- customColDefs[[col_names[col]]] -# } else { -# colDefs_list[[col]] <- reactable::colDef(name = col_names[col]) -# } -# -# if (!is.null(customColDefs[[col_names[col]]]$header)) { -# colDefs_list[[col]]$header <- customColDefs[[col_names[col]]]$header -# } -# -# if (!is.null(customColDefs[[col_names[col]]]$tooltip)) { -# colDefs_list[[col]]$header <- -# withTooltip(colDefs_list[[col]]$header, customColDefs[[col_names[col]]]$tooltip) -# } -# -# # Check if the column is formatted like a JSON file -# if (is_JSON_column(df[[col_names[col]]])) { -# colDefs_list[[col]]$cell <- function(value) { -# tags$button( -# "Download JSON", -# onclick = paste0("downloadJSON('", value, "')") -# ) -# } -# } -# } -# } else { -# # Define default colDefs if customColDefs is not provided -# for (col in seq_along(col_names)) { -# colDefs_list[[col]] <- reactable::colDef(name = col_names[col]) -# -# # Check if the column is formatted like a JSON file -# if (is_JSON_column(df[[col_names[col]]])) { -# colDefs_list[[col]]$cell <- function(value) { -# tags$button( -# "Download JSON", -# onclick = paste0("downloadJSON('", value, "')") -# ) -# } -# } -# } -# } -# -# # Return the list of colDefs -# return(colDefs_list) -# } - - - - - - - - - - ohdsiReactableTheme <- reactable::reactableTheme( color = "white", @@ -226,13 +139,15 @@ ohdsiReactableTheme <- reactable::reactableTheme( #' @param id string, table id must match resultsTableViewer function #' @param df reactive that returns a data frame #' @param colDefsInput named list of reactable::colDefs +#' @param downloadedFileName string, desired name of downloaded data file. can use the name from the module that is being used #' #' @return shiny module server #' @export #' resultTableServer <- function(id, #string df, #data.frame - colDefsInput + colDefsInput, #named list + downloadedFileName = NULL #string ) #list of colDefs, can use checkmate::assertList, need a check that makes sure names = columns) { shiny::moduleServer(id, function(input, output, session) { @@ -258,18 +173,23 @@ resultTableServer <- function(id, #string }) #need to try adding browser() to all reactives to see why selected cols isnt working + colDefs <- - shiny::reactive(create_colDefs_list(df = df()[, input$dataCols], - customColDefs = colDefsInput)) + shiny::reactive({ + create_colDefs_list(df = df()[, input$dataCols], + customColDefs = colDefsInput) + }) - fullData <- shiny::reactive(df()) + fullData <- shiny::reactive({ + df() + }) output$resultData <- reactable::renderReactable({ - data = df()[, input$dataCols] + data = df()[, input$dataCols, drop = F] tryCatch({ @@ -289,18 +209,14 @@ resultTableServer <- function(id, #string defaultColDef = reactable::colDef(align = "left") #, experimental #theme = ohdsiReactableTheme - )}, - - warning = function(w){ - shiny::showNotification("Select at least 2 columns!"); return(NULL) - - }, - + )} + , + error = function(e){ - shiny::showNotification("Select at least 2 columns!"); return(NULL) - + # shiny::showNotification("No columns selected!"); + return(NULL) + } - ) @@ -309,7 +225,7 @@ resultTableServer <- function(id, #string # download full data button output$downloadDataFull <- shiny::downloadHandler( filename = function() { - paste('data-full-', Sys.Date(), '.csv', sep = '') + paste('result-data-full-', downloadedFileName, Sys.Date(), '.csv', sep = '') }, content = function(con) { utils::write.csv(fullData(), con, diff --git a/R/datasources-main.R b/R/datasources-main.R new file mode 100644 index 00000000..20dbedfa --- /dev/null +++ b/R/datasources-main.R @@ -0,0 +1,195 @@ +# @file datasources-main.R +# +# Copyright 2022 Observational Health Data Sciences and Informatics +# +# This file is part of OhdsiShinyModules +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. + + + + +#' Define the helper file for the module +#' +#' @return The helper html file for the datasources module +#' @export +#' +datasourcesHelperFile <- function() { + fileLoc <- + system.file('datasources-www', "datasources.html", package = "OhdsiShinyModules") + return(fileLoc) +} + + + +#' The viewer function for hte datasources module +#' +#' @param id The unique id for the datasources viewer namespace +#' +#' @return The UI for the datasources module +#' @export +#' +datasourcesViewer <- function(id) { + ns <- shiny::NS(id) + + shinydashboard::box( + status = 'info', + width = "100%", + title = shiny::span(shiny::icon("database"), "Data Sources"), + solidHeader = TRUE, + + shinydashboard::box( + collapsible = TRUE, + collapsed = FALSE, + title = shiny::span( shiny::icon("circle-question"), "Help & Information"), + width = "100%", + shiny::htmlTemplate(system.file("datasources-www", "datasources.html", package = utils::packageName())) + ), + + shiny::tabsetPanel( + type = 'pills', + id = ns('mainPanel'), + + shiny::tabPanel( + title = "Data Source Information", + resultTableViewer(ns("datasourcesTable"), + downloadedFileName = "datasourcesTable-") + ) + ) + ) +} + + + + +#' The server function for the datasources module +#' +#' @param id The unique id for the datasources server namespace +#' @param connectionHandler A connection to the database with the results +#' @param resultDatabaseSettings A named list containing the cohort generator results database details (schema, table prefix) +#' +#' @return The server for the datasources module +#' @export +#' +datasourcesServer <- function( + id, + connectionHandler, + resultDatabaseSettings +) { + + shiny::moduleServer( + id, + function(input, output, session) { + + withTooltip <- function(value, tooltip, ...) { + shiny::div(style = "text-decoration: underline; text-decoration-style: dotted; cursor: help", + tippy::tippy(value, tooltip, ...)) + } + + datasourcesData <- shiny::reactive({ + getDatasourcesData( + connectionHandler = connectionHandler, + resultsSchema = resultDatabaseSettings$schema, + databaseMetaData = resultDatabaseSettings$databaseMetaData + ) + }) + + # # defining column definitions + # datasourcesColDefs <- createCustomColDefList( + # rawColNames = colnames(datasourcesData), + # niceColNames = c("DB Name", + # "DB Abbreviation", + # "DB Holder", + # "DB Description", + # "DB Description Link", + # "DB ETL Link", + # "Source Data Release Date", + # "CDM DB Release Date", + # "CDM Version", + # "Vocabulary Version", + # "DB ID", + # "Max Obs. Period End Date"), + # tooltipText = c("Name of the database (DB)", + # "Abbreviation for the database (DB)", + # "Holder of the database (DB)", + # "Description of the database (DB)", + # "HTML link to the database (DB) description", + # "HTML link to the ETL for the database (DB)", + # "Date the source data was released", + # "Date the CDM database (DB) was accessible", + # "Version of the common data model (CDM)", + # "Version of the vocabulary used in the database (DB)", + # "Unique identifier (ID) of the database (DB)", + # "Maximum/Latest observation period date in the database (DB)"), + # customColDefOptions = list( + # list(NULL), + # list(NULL), + # list(NULL), + # list(show = F), + # list(html = TRUE, cell = htmlwidgets::JS(' + # function(cellInfo) { + # // Render as a link + # const url = cellInfo.value; + # return `RHEALTH Description`; + # } + # ')), + # list(html = TRUE, cell = htmlwidgets::JS(' + # function(cellInfo) { + # // Render as a link + # const url = cellInfo.value; + # return `ETL`; + # } + # ')), + # list(format = reactable::colFormat(date = T)), + # list(format = reactable::colFormat(date = T)), + # list(NULL), + # list(NULL), + # list(NULL), + # list(NULL), + # list(format = reactable::colFormat(date = T)) + # ) + # ) + # + # #save the colDefs as json + # ParallelLogger::saveSettingsToJson(datasourcesColDefs, "./inst/components-columnInformation/datasources-colDefs.json") + + datasourcesColList <- ParallelLogger::loadSettingsFromJson(system.file("components-columnInformation", + "datasources-colDefs.json", + package = "OhdsiShinyModules") + ) + + #need to do for any colDefs that have JS and that are getting loaded in from a JSON + class(datasourcesColList[["sourceDocumentationReference"]]$cell) <- "JS_EVAL" + class(datasourcesColList[["cdmEtlReference"]]$cell) <- "JS_EVAL" + + + resultTableServer(id = "datasourcesTable", + df = datasourcesData, + colDefsInput = datasourcesColList, + downloadedFileName = "datasourcesTable-") + + return(invisible(NULL)) + + + + + }) +} + + + + + + + + diff --git a/R/description-incidence.R b/R/description-incidence.R index a36241f3..33308a51 100644 --- a/R/description-incidence.R +++ b/R/description-incidence.R @@ -21,7 +21,7 @@ #' #' @details #' The user specifies the id for the module -#' +#'+ #' @param id the unique reference id for the module #' #' @return diff --git a/R/evidence-synth-main.R b/R/evidence-synth-main.R index 2092517e..8e71b8ed 100644 --- a/R/evidence-synth-main.R +++ b/R/evidence-synth-main.R @@ -73,6 +73,15 @@ evidenceSynthesisViewer <- function(id=1) { shiny::tabPanel("SCCS Table", reactable::reactableOutput(ns('esSccsTable')) ) + ), + shiny::tabPanel("SCCS Plot", + shiny::plotOutput(ns('esSccsPlot')) + ), + shiny::tabPanel("SCCS Table", + reactable::reactableOutput(ns('esSccsTable')) + ), + shiny::tabPanel("Diagnostics Dashboard", + reactable::reactableOutput(ns('diagnosticsTable')) ) ) @@ -360,7 +369,6 @@ evidenceSynthesisServer <- function( ) ) ) - } ) diff --git a/R/helpers-cohortGeneratorDataPulls.R b/R/helpers-cohortGeneratorDataPulls.R index 8956e5c9..2bde16e3 100644 --- a/R/helpers-cohortGeneratorDataPulls.R +++ b/R/helpers-cohortGeneratorDataPulls.R @@ -50,8 +50,12 @@ getCohortGeneratorCohortMeta <- function( ) df2 <- df %>% - dplyr::mutate(generationDuration = case_when( - generationStatus == "COMPLETE" ~ difftime(endTime, startTime, units="mins"), + dplyr::mutate(generationDuration = dplyr::case_when( + generationStatus == "COMPLETE" ~ difftime( + as.POSIXct(as.numeric(endTime), origin = "1970-01-01"), + as.POSIXct(as.numeric(startTime), origin = "1970-01-01"), + units="mins" + ), .default = NA ) ) diff --git a/R/helpers-componentsCreateCustomColDefList.R b/R/helpers-componentsCreateCustomColDefList.R new file mode 100644 index 00000000..b1dabe2f --- /dev/null +++ b/R/helpers-componentsCreateCustomColDefList.R @@ -0,0 +1,93 @@ + +#' Creating a list of custom column definitions for use in reactables +#' +#' @param rawColNames The raw column names taken directly from the source +#' data table that are to be overwritten in the reactable +#' @param niceColNames The formatted column names that will appear as-specified in +#' the reactable +#' @param tooltipText The text to be displayed in a toolTip when hovering over the +#' column in the reactable +#' @param case Optional argument to convert raw column names to snake or camel case. Defaults to NULL and preserves +#' whatever raw column names are passed in +#' @param customColDefOptions A list of lists, where the inner lists are any custom options from +#' reactable::colDef for each column +#' +#' @return A named list of reactable::colDef objects +#' @export +#' +createCustomColDefList <- function(rawColNames, niceColNames = NULL, + tooltipText = NULL, case = NULL, + customColDefOptions = NULL) { + withTooltip <- function(value, tooltip, ...) { + shiny::div(style = "text-decoration: underline; text-decoration-style: dotted; cursor: help", + tippy::tippy(value, tooltip, ...)) + } + + if (is.null(niceColNames)) { + niceColNames <- rawColNames + } + + if (is.null(tooltipText)) { + tooltipText <- rep("", length(rawColNames)) + } + + if (!is.null(case)) { + if (case == "snakeCaseToCamelCase") { + rawColNames <- SqlRender::snakeCaseToCamelCase(rawColNames) + } else if (case == "camelCaseToSnakeCase") { + rawColNames <- SqlRender::camelCaseToSnakeCase(rawColNames) + } + } + + result <- vector("list", length(rawColNames)) + + if (is.null(customColDefOptions)) { + customColDefOptions <- vector("list", length(rawColNames)) + for (i in seq_along(rawColNames)) { + customColDefOptions[[i]] <- list() + } + } + + for (i in seq_along(rawColNames)) { + colDefOptions <- c( + list(name = rawColNames[[i]], header = withTooltip(niceColNames[[i]], tooltipText[[i]])), + customColDefOptions[[i]] + ) + + result[[i]] <- do.call(reactable::colDef, colDefOptions) + } + + names(result) <- rawColNames + + return(result) +} + + +# examples +# Define custom column definitions +# customColDefs <- createCustomColDefList( +# rawColNames = mydf$raw, +# niceColNames = c("Name", "Age", "Country"), +# tooltipText = c("Person's Name", "Person's Age", "Country"), +# customColDefOptions = list( +# list(NULL), # No aggregation for "Name" column +# list(aggregate = "mean"), # Aggregate "Age" column using mean +# list(NULL) # No aggregation for "Country" column +# ) +# ) + +# use the below as a guide to save named colDef list as JSON then read it back! +# test <- ParallelLogger::saveSettingsToJson(colDefs, "./inst/components-columnInformation/test.json") +#loadTest <- ParallelLogger::loadSettingsFromJson("./inst/components-columnInformation/test.json") + + +#' Make a label for an html button +#' +#' @param label The desired label for hte button +#' +#' @return html code to make a button label +#' @export +#' +makeButtonLabel <- function(label) { + as.character(htmltools::tags$div(htmltools::tags$button(paste(label)))) +} diff --git a/R/helpers-datasourcesDataPulls.R b/R/helpers-datasourcesDataPulls.R new file mode 100644 index 00000000..7b5c529f --- /dev/null +++ b/R/helpers-datasourcesDataPulls.R @@ -0,0 +1,17 @@ +#pull database meta data table +getDatasourcesData <- function( + connectionHandler, + resultsSchema, + databaseMetaData +) { + + sql <- "SELECT * from @resultsSchema.@databaseMetaData + ;" + return( + connectionHandler$queryDb( + sql = sql, + resultsSchema = resultsSchema, + databaseMetaData = databaseMetaData + ) + ) +} diff --git a/R/helpers-phevaluatorDataPulls.R b/R/helpers-phevaluatorDataPulls.R index 5f60707a..8a060f10 100644 --- a/R/helpers-phevaluatorDataPulls.R +++ b/R/helpers-phevaluatorDataPulls.R @@ -4,33 +4,8 @@ getPhevalAlgorithmPerformance <- function( connectionHandler, resultsSchema, - tablePrefix = 'pv_', - databaseIds, - phenotypes + tablePrefix = 'pv_' ) { - - if(!is.null(databaseIds) & !is.null(phenotypes)){ - - sql <- "SELECT * FROM @results_schema.@table_prefixALGORITHM_PERFORMANCE_RESULTS - WHERE( @results_schema.@table_prefixALGORITHM_PERFORMANCE_RESULTS.DATABASE_ID IN (@databaseIds) - AND @results_schema.@table_prefixALGORITHM_PERFORMANCE_RESULTS.PHENOTYPE IN (@phenotypes) - ) - ;" - - return( - connectionHandler$queryDb( - sql = sql, - results_schema = resultsSchema, - table_prefix = tablePrefix, - databaseIds = paste0("'", databaseIds, "'", collapse = ", "), - phenotypes = paste0("'", phenotypes, "'", collapse = ", ") - # , - # snakeCaseToCamelCase = F - ) - ) - } - - else { sql <- "SELECT * FROM @results_schema.@table_prefixALGORITHM_PERFORMANCE_RESULTS ;" @@ -39,14 +14,9 @@ getPhevalAlgorithmPerformance <- function( connectionHandler$queryDb( sql = sql, results_schema = resultsSchema, - table_prefix = tablePrefix, - databaseIds = paste0("'", databaseIds, "'", collapse = ", "), - phenotypes = paste0("'", phenotypes, "'", collapse = ", ") - # , - # snakeCaseToCamelCase = F + table_prefix = tablePrefix ) ) - } } #test it @@ -54,349 +24,174 @@ getPhevalAlgorithmPerformance <- function( # databaseIds = c("CCAE_RS", "Germany_RS") # phenotypes = c("hyperprolactinemia") # -# d <- getPhevalAlgorithmPerformance(connectionHandler = connection, +# getPhevalAlgorithmPerformance(connectionHandler = connectionHandler, # resultsSchema = resultDatabaseDetails$schema, -# tablePrefix = resultDatabaseDetails$tablePrefix, -# databaseIds = databaseIds, -# phenotypes = phenotypes +# tablePrefix = resultDatabaseDetails$tablePrefix # ) + getPhevalCohortDefinitionSet <- function( connectionHandler, resultsSchema, - tablePrefix = 'pv_', - phenotypes + tablePrefix = 'pv_' ) { - if(!is.null(phenotypes)){ - sql <- "SELECT * FROM @results_schema.@table_prefixCOHORT_DEFINITION_SET - WHERE( @results_schema.@table_prefixCOHORT_DEFINITION_SET.PHENOTYPE IN (@phenotypes) - ) - ;" - return( - connectionHandler$queryDb( - sql = sql, - results_schema = resultsSchema, - table_prefix = tablePrefix, - phenotypes = paste0("'", phenotypes, "'", collapse = ", ") - ) - ) - } - - else { sql <- "SELECT * FROM @results_schema.@table_prefixCOHORT_DEFINITION_SET ;" + return( connectionHandler$queryDb( sql = sql, results_schema = resultsSchema, - table_prefix = tablePrefix, - phenotypes = paste0("'", phenotypes, "'", collapse = ", ") - # , - # snakeCaseToCamelCase = F - ) + table_prefix = tablePrefix + ) ) - } } getPhevalDiagnostics <- function( connectionHandler, resultsSchema, - tablePrefix = 'pv_', - databaseIds, - phenotypes + tablePrefix = 'pv_' ) { - - if(!is.null(databaseIds) & !is.null(phenotypes)){ - sql <- "SELECT * FROM @results_schema.@table_prefixDIAGNOSTICS - WHERE( @results_schema.@table_prefixDIAGNOSTICS.DATABASE_ID IN (@databaseIds) - AND @results_schema.@table_prefixDIAGNOSTICS.PHENOTYPE IN (@phenotypes) - ) - ;" - return( - connectionHandler$queryDb( - sql = sql, - results_schema = resultsSchema, - table_prefix = tablePrefix, - databaseIds = paste0("'", databaseIds, "'", collapse = ", "), - phenotypes = paste0("'", phenotypes, "'", collapse = ", ") - ) - ) - } - - else{ - + sql <- "SELECT * FROM @results_schema.@table_prefixDIAGNOSTICS ;" return( connectionHandler$queryDb( sql = sql, results_schema = resultsSchema, - table_prefix = tablePrefix, - databaseIds = paste0("'", databaseIds, "'", collapse = ", "), - phenotypes = paste0("'", phenotypes, "'", collapse = ", ") - # , - # snakeCaseToCamelCase = F + table_prefix = tablePrefix ) ) - } } getPhevalEvalInputParams <- function( connectionHandler, resultsSchema, - tablePrefix = 'pv_', - databaseIds, - phenotypes + tablePrefix = 'pv_' ) { - if(!is.null(databaseIds) & !is.null(phenotypes)){ - sql <- "SELECT * FROM @results_schema.@table_prefixEVALUATION_INPUT_PARAMETERS - WHERE( @results_schema.@table_prefixEVALUATION_INPUT_PARAMETERS.DATABASE_ID IN (@databaseIds) - AND @results_schema.@table_prefixEVALUATION_INPUT_PARAMETERS.PHENOTYPE IN (@phenotypes) - ) - ;" - return( - connectionHandler$queryDb( - sql = sql, - results_schema = resultsSchema, - table_prefix = tablePrefix, - databaseIds = paste0("'", databaseIds, "'", collapse = ", "), - phenotypes = paste0("'", phenotypes, "'", collapse = ", ") - ) - ) - } - - else{ sql <- "SELECT * FROM @results_schema.@table_prefixEVALUATION_INPUT_PARAMETERS ;" return( connectionHandler$queryDb( sql = sql, results_schema = resultsSchema, - table_prefix = tablePrefix, - databaseIds = paste0("'", databaseIds, "'", collapse = ", "), - phenotypes = paste0("'", phenotypes, "'", collapse = ", ") - # , - # snakeCaseToCamelCase = F + table_prefix = tablePrefix ) ) - } } getPhevalModelCovars <- function( connectionHandler, resultsSchema, - tablePrefix = 'pv_', - databaseIds, - phenotypes + tablePrefix = 'pv_' ) { - - if(!is.null(databaseIds) & !is.null(phenotypes)){ - sql <- "SELECT * FROM @results_schema.@table_prefixMODEL_COVARIATES - WHERE( @results_schema.@table_prefixMODEL_COVARIATES.DATABASE_ID IN (@databaseIds) - AND @results_schema.@table_prefixMODEL_COVARIATES.PHENOTYPE IN (@phenotypes) - ) + + sql <- "SELECT * FROM @results_schema.@table_prefixMODEL_COVARIATES ;" - return( - connectionHandler$queryDb( + + df <- connectionHandler$queryDb( sql = sql, results_schema = resultsSchema, - table_prefix = tablePrefix, - databaseIds = paste0("'", databaseIds, "'", collapse = ", "), - phenotypes = paste0("'", phenotypes, "'", collapse = ", ") + table_prefix = tablePrefix ) - ) - } - - else{ - sql <- "SELECT * FROM @results_schema.@table_prefixMODEL_COVARIATES - ;" + + df$databaseId = stringi::stri_trans_general(df$databaseId, "latin-ascii") + df$phenotype = stringi::stri_trans_general(df$phenotype, "latin-ascii") + df$analysisName = stringi::stri_trans_general(df$analysisName, "latin-ascii") + df$covariateName = stringi::stri_trans_general(df$covariateName, "latin-ascii") + return( - connectionHandler$queryDb( - sql = sql, - results_schema = resultsSchema, - table_prefix = tablePrefix, - databaseIds = paste0("'", databaseIds, "'", collapse = ", "), - phenotypes = paste0("'", phenotypes, "'", collapse = ", ") - # , - # snakeCaseToCamelCase = F + df ) - ) - } } +# d <- getPhevalModelCovars(connectionHandler = connectionHandler, +# resultsSchema = resultDatabaseDetails$schema, +# tablePrefix = resultDatabaseDetails$tablePrefix, +# databaseIds = databaseIds, +# phenotypes = phenotypes +# ) + + + getPhevalModelInputParams <- function( connectionHandler, resultsSchema, - tablePrefix = 'pv_', - databaseIds, - phenotypes + tablePrefix = 'pv_' ) { - if(!is.null(databaseIds) & !is.null(phenotypes)){ - sql <- "SELECT * FROM @results_schema.@table_prefixMODEL_INPUT_PARAMETERS - WHERE( @results_schema.@table_prefixMODEL_INPUT_PARAMETERS.DATABASE_ID IN (@databaseIds) - AND @results_schema.@table_prefixMODEL_INPUT_PARAMETERS.PHENOTYPE IN (@phenotypes) - ) - ;" - return( - connectionHandler$queryDb( - sql = sql, - results_schema = resultsSchema, - table_prefix = tablePrefix, - databaseIds = paste0("'", databaseIds, "'", collapse = ", "), - phenotypes = paste0("'", phenotypes, "'", collapse = ", ") - ) - ) - } - - else{ sql <- "SELECT * FROM @results_schema.@table_prefixMODEL_INPUT_PARAMETERS ;" return( connectionHandler$queryDb( sql = sql, results_schema = resultsSchema, - table_prefix = tablePrefix, - databaseIds = paste0("'", databaseIds, "'", collapse = ", "), - phenotypes = paste0("'", phenotypes, "'", collapse = ", ") - # , - # snakeCaseToCamelCase = F + table_prefix = tablePrefix ) ) - } } getPhevalModelPerformance <- function( connectionHandler, resultsSchema, - tablePrefix = 'pv_', - databaseIds, - phenotypes + tablePrefix = 'pv_' ) { - - if(!is.null(databaseIds) & !is.null(phenotypes)){ - sql <- "SELECT * FROM @results_schema.@table_prefixMODEL_PERFORMANCE - WHERE( @results_schema.@table_prefixMODEL_PERFORMANCE.DATABASE_ID IN (@databaseIds) - AND @results_schema.@table_prefixMODEL_PERFORMANCE.PHENOTYPE IN (@phenotypes) - ) - ;" - return( - connectionHandler$queryDb( - sql = sql, - results_schema = resultsSchema, - table_prefix = tablePrefix, - databaseIds = paste0("'", databaseIds, "'", collapse = ", "), - phenotypes = paste0("'", phenotypes, "'", collapse = ", ") - ) - ) - } - - else{ + sql <- "SELECT * FROM @results_schema.@table_prefixMODEL_PERFORMANCE ;" return( connectionHandler$queryDb( sql = sql, results_schema = resultsSchema, - table_prefix = tablePrefix, - databaseIds = paste0("'", databaseIds, "'", collapse = ", "), - phenotypes = paste0("'", phenotypes, "'", collapse = ", ") - # , - # snakeCaseToCamelCase = F + table_prefix = tablePrefix ) ) - } } getPhevalTestSubjects <- function( connectionHandler, resultsSchema, - tablePrefix = 'pv_', - databaseIds, - phenotypes + tablePrefix = 'pv_' ) { - - if(!is.null(databaseIds) & !is.null(phenotypes)){ - sql <- "SELECT * FROM @results_schema.@table_prefixTEST_SUBJECTS - WHERE( @results_schema.@table_prefixTEST_SUBJECTS.DATABASE_ID IN (@databaseIds) - AND @results_schema.@table_prefixTEST_SUBJECTS.PHENOTYPE IN (@phenotypes) - ) - ;" - return( - connectionHandler$queryDb( - sql = sql, - results_schema = resultsSchema, - table_prefix = tablePrefix, - databaseIds = paste0("'", databaseIds, "'", collapse = ", "), - phenotypes = paste0("'", phenotypes, "'", collapse = ", ") - ) - ) - } - - else{ + sql <- "SELECT * FROM @results_schema.@table_prefixTEST_SUBJECTS ;" return( connectionHandler$queryDb( sql = sql, results_schema = resultsSchema, - table_prefix = tablePrefix, - databaseIds = paste0("'", databaseIds, "'", collapse = ", "), - phenotypes = paste0("'", phenotypes, "'", collapse = ", ") - # , - # snakeCaseToCamelCase = F + table_prefix = tablePrefix ) ) - } } getPhevalTestSubjectsCovars <- function( connectionHandler, resultsSchema, - tablePrefix = 'pv_', - databaseIds, - phenotypes + tablePrefix = 'pv_' ) { - - if(!is.null(databaseIds) & !is.null(phenotypes)){ - sql <- "SELECT * FROM @results_schema.@table_prefixTEST_SUBJECTS_COVARIATES - WHERE( @results_schema.@table_prefixTEST_SUBJECTS_COVARIATES.DATABASE_ID IN (@databaseIds) - AND @results_schema.@table_prefixTEST_SUBJECTS_COVARIATES.PHENOTYPE IN (@phenotypes) - ) + + sql <- "SELECT * FROM @results_schema.@table_prefixTEST_SUBJECTS_COVARIATES ;" - return( - connectionHandler$queryDb( + + df <- connectionHandler$queryDb( sql = sql, results_schema = resultsSchema, - table_prefix = tablePrefix, - databaseIds = paste0("'", databaseIds, "'", collapse = ", "), - phenotypes = paste0("'", phenotypes, "'", collapse = ", ") + table_prefix = tablePrefix ) - ) - } - - else{ - sql <- "SELECT * FROM @results_schema.@table_prefixTEST_SUBJECTS_COVARIATES - ;" + + df$databaseId = stringi::stri_trans_general(df$databaseId, "latin-ascii") + df$phenotype = stringi::stri_trans_general(df$phenotype, "latin-ascii") + df$analysisName = stringi::stri_trans_general(df$analysisName, "latin-ascii") + df$type = stringi::stri_trans_general(df$type, "latin-ascii") + df$covariateName = stringi::stri_trans_general(df$covariateName, "latin-ascii") + return( - connectionHandler$queryDb( - sql = sql, - results_schema = resultsSchema, - table_prefix = tablePrefix, - databaseIds = paste0("'", databaseIds, "'", collapse = ", "), - phenotypes = paste0("'", phenotypes, "'", collapse = ", ") - # , - # snakeCaseToCamelCase = F - ) + df ) - } -} +} -#test it - # t <- getPhevalTestSubjectsCovars(connectionHandler = connection, - # resultsSchema = resultDatabaseDetails$schema, - # tablePrefix = resultDatabaseDetails$tablePrefix) diff --git a/R/heplers-componentsCreateCustomColDefList.R b/R/heplers-componentsCreateCustomColDefList.R deleted file mode 100644 index 7aafd18d..00000000 --- a/R/heplers-componentsCreateCustomColDefList.R +++ /dev/null @@ -1,148 +0,0 @@ - - -#' Creating a list of custom column definitions for use in reactables -#' -#' @param rawColNames The raw column names taken directly from the source -#' data table that are to be overwritten in the reactable -#' @param niceColNames The formatted column names that will appear as-specified in -#' the reactable -#' @param tooltipText The text to be displayed in a toolTip when hovering over the -#' column in the reactable -#' -#' @return A named list of reactable::colDef objects -#' @export -#' -#' @examples -#' createCustomColDefList(rawColNames = c("firstName", "lastName), niceColNames = c("First Name", "Last Name"), tooltipText = c("The person's first name", "The person's last name")) -#' -createCustomColDefList <- function(rawColNames, niceColNames, tooltipText) { - withTooltip <- function(value, tooltip, ...) { - shiny::div(style = "text-decoration: underline; text-decoration-style: dotted; cursor: help", - tippy::tippy(value, tooltip, ...)) - } - - result <- vector("list", length(rawColNames)) - - for (i in 1:length(rawColNames)) { - result[[i]] <- reactable::colDef( - header = withTooltip(niceColNames[[i]], tooltipText[[i]]) - ) - } - - names(result) <- rawColNames - - return(result) -} - - - -#' Saving a custom colDef list to a JSON file -#' -#' @param colDefs A named list of reactable::colDef objects, generated by createCustomColDefList() -#' @param filename The desired name of the output JSON file -#' @param path The path to where the JSON should be saved -#' -#' @return Saves a JSON file -#' @export -#' -# saveColDefsAsJSON <- function(colDefs, filename, path = "") { -# # Extract the raw column names -# raw_col_names <- names(colDefs) -# -# # Convert colDefs to a named list with "header" field -# col_defs_list <- lapply(colDefs, function(colDef) list(header = as.character(colDef$header))) -# -# # Create a named list with raw column names and colDefs list -# col_defs_json <- jsonlite::toJSON(setNames(col_defs_list, raw_col_names)) -# -# # Write JSON to file -# filepath <- file.path(path, filename) -# writeLines(col_defs_json, filepath) -# } - -saveColDefsAsJSON <- function(colDefs, filename, path = "") { - # Convert colDefs to a list of serializable objects - colDefsData <- lapply(colDefs, function(colDef) list(header = as.character(colDef$header))) - - # Convert the list to JSON - colDefsJson <- jsonlite::toJSON(colDefsData, auto_unbox = TRUE) - - # Construct the file path - filepath <- file.path(path, filename) - - # Write JSON to file - writeLines(colDefsJson, filepath) -} - - - - - - - -#' Read reactable::colDefs froma JSON file -#' -#' @param filename The dname of the input JSON file -#' @param path The path to where the JSON is located -#' -#' @return -#' @expors Reads in a JSON file and saves it into the environment as a named list of colDefs -#' -readColDefsFromJSON <- function(filename, path = "") { - # Construct the file path - filepath <- file.path(path, filename) - - # Read JSON from file - colDefsJson <- readLines(filepath) - - # Convert JSON to list - colDefsData <- jsonlite::fromJSON(colDefsJson, simplifyVector = FALSE) - - # Convert list elements to colDef objects - colDefs <- lapply(colDefsData, function(data) { - header <- shiny::tags$div( - style = "text-decoration: underline; text-decoration-style: dotted; cursor: help", - shiny::tags$span(class = "tippy html-widget html-fill-item-overflow-hidden html-fill-item", - id = "htmlwidget-989018cda6e9bce08b15", width = "960", - data = jsonlite::toJSON(list(x = list(opts = list(content = data$header), - text = data$header), - evals = list(), - jsHooks = list())), - height = "500"), - shiny::tags$script(type = "application/json", - data_for = "htmlwidget-989018cda6e9bce08b15", - jsonlite::toJSON(list(x = list(opts = list(content = data$header), - text = data$header), - evals = list(), - jsHooks = list())))) - - reactable::colDef(header = header) - }) - - return(colDefs) -} - - - - - - - -#examples - -# createCustomColDefList(rawColNames = c("firstName", "lastName"), -# niceColNames = c("First Name", "Last Name"), -# tooltipText = c("The person's first name", "The person's last name")) - -# Sample data -# rawColNames <- c("col1", "col2", "col3") -# niceColNames <- c("Column 1", "Column 2", "Column 3") -# tooltipText <- c("Tooltip 1", "Tooltip 2", "Tooltip 3") -# -# # Call the function -# colDefs <- createCustomColDefList(rawColNames, niceColNames, tooltipText) -# -# # Save colDefs as JSON in a specific path -# saveColDefsAsJSON(phevalColList, "phevaluator-colDefs.json", path = "D:/shiny_test/GitHub Desktop/standardization/OhdsiShinyModules/inst/components-columnInformation") - -# testing <- readColDefsFromJSON("phevaluator-colDefs.json", "D:/shiny_test/GitHub Desktop/standardization/OhdsiShinyModules/inst/components-columnInformation") \ No newline at end of file diff --git a/R/phevaluator-main.R b/R/phevaluator-main.R index 529b2eda..8b04d7e2 100644 --- a/R/phevaluator-main.R +++ b/R/phevaluator-main.R @@ -78,35 +78,48 @@ phevaluatorViewer <- function(id) { shiny::tabPanel( title = "Phenotypes", - resultTableViewer(ns("cohortDefinitionSetTable")) + resultTableViewer(ns("cohortDefinitionSetTable"), + downloadedFileName = "cohortDefinitionSetTable-") ), shiny::tabPanel( - title = "Model Input Parameters", - resultTableViewer(ns("modelInputParametersTable")) + title = "Phenotype Performance Characteristics", + resultTableViewer(ns("algorithmPerformanceResultsTable"), + downloadedFileName = "algorithmPerformanceResultsTable-") + ), + shiny::tabPanel( + title = "Model Covariates", + resultTableViewer(ns("modelCovariatesTable"), + downloadedFileName = "modelCovariatesTable-") ), shiny::tabPanel( title = "Model Performance", - resultTableViewer(ns("modelPerformanceTable")) + resultTableViewer(ns("modelPerformanceTable"), + downloadedFileName = "modelPerformanceTable-") ), shiny::tabPanel( - title = "Model Covariates", - resultTableViewer(ns("modelCovariatesTable")) + title = "Model Input Parameters", + resultTableViewer(ns("modelInputParametersTable"), + downloadedFileName = "modelInputParametersTable-") ), shiny::tabPanel( - title = "Evaluation Cohort Parameters", - resultTableViewer(ns("evaluationCohortParametersTable")) + title = "Evaluation Cohort Diagnostics", + resultTableViewer(ns("diagnosticsTable"), + downloadedFileName = "diagnosticsTable-") ), shiny::tabPanel( - title = "Test Subjects", - resultTableViewer(ns("testSubjectsTable")) + title = "Evaluation Cohort Parameters", + resultTableViewer(ns("evaluationInputParametersTable"), + downloadedFileName = "evaluationInputParametersTable-") ), shiny::tabPanel( - title = "Test Subjects and Covariates", - resultTableViewer(ns("testSubjectsCovariatesTable")) + title = "Test Subjects", + resultTableViewer(ns("testSubjectsTable"), + downloadedFileName = "testSubjectsTable-") ), shiny::tabPanel( - title = "Phenotype Performance Characteristics", - resultTableViewer(ns("algorithmPerformanceResultsTable")) + title = "Test Subjects Covariates", + resultTableViewer(ns("testSubjectsCovariatesTable"), + downloadedFileName = "testSubjectsCovariatesTable-") ) ) ) @@ -135,6 +148,8 @@ phevaluatorServer <- function( id, function(input, output, session) { + ns <- session$ns + withTooltip <- function(value, tooltip, ...) { shiny::div(style = "text-decoration: underline; text-decoration-style: dotted; cursor: help", tippy::tippy(value, tooltip, ...)) @@ -143,13 +158,11 @@ phevaluatorServer <- function( #use algorithm performance table to get "option columns", #which will be used to make choices before generating result(s) optionCols <- getPhevalAlgorithmPerformance( - connectionHandler = connection, - resultsSchema = resultDatabaseDetails$schema, - tablePrefix = resultDatabaseDetails$tablePrefix, - databaseIds = NULL, - phenotypes = NULL + connectionHandler = connectionHandler, + resultsSchema = resultDatabaseSettings$schema, + tablePrefix = resultDatabaseSettings$tablePrefix ) %>% - dplyr::select(databaseId, phenotype) + dplyr::select("databaseId", "phenotype") databaseIds = unique(optionCols$databaseId) phenotypeNames = unique(optionCols$phenotype) @@ -217,16 +230,13 @@ phevaluatorServer <- function( } getPhevalAlgorithmPerformance( - connectionHandler = connection, - resultsSchema = resultDatabaseDetails$schema, - tablePrefix = resultDatabaseDetails$tablePrefix, - databaseIds = input$selectedDatabaseIds, - phenotypes = input$selectedPhenoypes - ) - # %>% - # dplyr::filter(databaseId %in% input$selectedDatabaseIds & - # phenotype %in% input$selectedPhenotypes - # ) + connectionHandler = connectionHandler, + resultsSchema = resultDatabaseSettings$schema, + tablePrefix = resultDatabaseSettings$tablePrefix + ) %>% + dplyr::filter(databaseId %in% input$selectedDatabaseIds & + phenotype %in% input$selectedPhenotypes) %>% + dplyr::select("databaseId":"cohortId", "description", "sensitivity95Ci":"analysisId") } ) @@ -239,14 +249,13 @@ phevaluatorServer <- function( } getPhevalCohortDefinitionSet( - connectionHandler = connection, - resultsSchema = resultDatabaseDetails$schema, - tablePrefix = resultDatabaseDetails$tablePrefix, - phenotypes = input$selectedPhenoypes - ) - # %>% - # dplyr::filter(phenotype %in% input$selectedPhenotypes - # ) + connectionHandler = connectionHandler, + resultsSchema = resultDatabaseSettings$schema, + tablePrefix = resultDatabaseSettings$tablePrefix + ) %>% + dplyr::mutate(buttonSQL = makeButtonLabel("SQL"), + buttonJSON = makeButtonLabel("JSON")) %>% + dplyr::filter(phenotype %in% input$selectedPhenotypes) } ) @@ -259,16 +268,12 @@ phevaluatorServer <- function( } getPhevalDiagnostics( - connectionHandler = connection, - resultsSchema = resultDatabaseDetails$schema, - tablePrefix = resultDatabaseDetails$tablePrefix, - databaseIds = input$selectedDatabaseIds, - phenotypes = input$selectedPhenoypes - ) - # %>% - # dplyr::filter(databaseId %in% input$selectedDatabaseIds & - # phenotype %in% input$selectedPhenotypes - # ) + connectionHandler = connectionHandler, + resultsSchema = resultDatabaseSettings$schema, + tablePrefix = resultDatabaseSettings$tablePrefix + ) %>% + dplyr::filter(databaseId %in% input$selectedDatabaseIds & + phenotype %in% input$selectedPhenotypes) } ) @@ -281,16 +286,12 @@ phevaluatorServer <- function( } getPhevalEvalInputParams( - connectionHandler = connection, - resultsSchema = resultDatabaseDetails$schema, - tablePrefix = resultDatabaseDetails$tablePrefix, - databaseIds = input$selectedDatabaseIds, - phenotypes = input$selectedPhenoypes - ) - # %>% - # dplyr::filter(databaseId %in% input$selectedDatabaseIds & - # phenotype %in% input$selectedPhenotypes - # ) + connectionHandler = connectionHandler, + resultsSchema = resultDatabaseSettings$schema, + tablePrefix = resultDatabaseSettings$tablePrefix + ) %>% + dplyr::filter(databaseId %in% input$selectedDatabaseIds & + phenotype %in% input$selectedPhenotypes) } ) @@ -303,16 +304,12 @@ phevaluatorServer <- function( } getPhevalModelCovars( - connectionHandler = connection, - resultsSchema = resultDatabaseDetails$schema, - tablePrefix = resultDatabaseDetails$tablePrefix, - databaseIds = input$selectedDatabaseIds, - phenotypes = input$selectedPhenoypes - ) - # %>% - # dplyr::filter(databaseId %in% input$selectedDatabaseIds & - # phenotype %in% input$selectedPhenotypes - # ) + connectionHandler = connectionHandler, + resultsSchema = resultDatabaseSettings$schema, + tablePrefix = resultDatabaseSettings$tablePrefix + ) %>% + dplyr::filter(databaseId %in% input$selectedDatabaseIds & + phenotype %in% input$selectedPhenotypes) } ) @@ -325,16 +322,12 @@ phevaluatorServer <- function( } getPhevalModelInputParams( - connectionHandler = connection, - resultsSchema = resultDatabaseDetails$schema, - tablePrefix = resultDatabaseDetails$tablePrefix, - databaseIds = input$selectedDatabaseIds, - phenotypes = input$selectedPhenoypes - ) - # %>% - # dplyr::filter(databaseId %in% input$selectedDatabaseIds & - # phenotype %in% input$selectedPhenotypes - # ) + connectionHandler = connectionHandler, + resultsSchema = resultDatabaseSettings$schema, + tablePrefix = resultDatabaseSettings$tablePrefix + ) %>% + dplyr::filter(databaseId %in% input$selectedDatabaseIds & + phenotype %in% input$selectedPhenotypes) } ) @@ -347,16 +340,12 @@ phevaluatorServer <- function( } getPhevalModelPerformance( - connectionHandler = connection, - resultsSchema = resultDatabaseDetails$schema, - tablePrefix = resultDatabaseDetails$tablePrefix, - databaseIds = input$selectedDatabaseIds, - phenotypes = input$selectedPhenoypes - ) - # %>% - # dplyr::filter(databaseId %in% input$selectedDatabaseIds & - # phenotype %in% input$selectedPhenotypes - # ) + connectionHandler = connectionHandler, + resultsSchema = resultDatabaseSettings$schema, + tablePrefix = resultDatabaseSettings$tablePrefix + ) %>% + dplyr::filter(databaseId %in% input$selectedDatabaseIds & + phenotype %in% input$selectedPhenotypes) } ) @@ -369,16 +358,12 @@ phevaluatorServer <- function( } getPhevalTestSubjects( - connectionHandler = connection, - resultsSchema = resultDatabaseDetails$schema, - tablePrefix = resultDatabaseDetails$tablePrefix, - databaseIds = input$selectedDatabaseIds, - phenotypes = input$selectedPhenoypes - ) - # %>% - # dplyr::filter(databaseId %in% input$selectedDatabaseIds & - # phenotype %in% input$selectedPhenotypes - # ) + connectionHandler = connectionHandler, + resultsSchema = resultDatabaseSettings$schema, + tablePrefix = resultDatabaseSettings$tablePrefix + ) %>% + dplyr::filter(databaseId %in% input$selectedDatabaseIds & + phenotype %in% input$selectedPhenotypes) } ) @@ -389,18 +374,14 @@ phevaluatorServer <- function( is.null(input$selectedPhenotypes)) { data.frame() } - + getPhevalTestSubjectsCovars( - connectionHandler = connection, - resultsSchema = resultDatabaseDetails$schema, - tablePrefix = resultDatabaseDetails$tablePrefix, - databaseIds = input$selectedDatabaseIds, - phenotypes = input$selectedPhenoypes - ) - # %>% - # dplyr::filter(databaseId %in% input$selectedDatabaseIds & - # phenotype %in% input$selectedPhenotypes - # ) + connectionHandler = connectionHandler, + resultsSchema = resultDatabaseSettings$schema, + tablePrefix = resultDatabaseSettings$tablePrefix + ) %>% + dplyr::filter(databaseId %in% input$selectedDatabaseIds & + phenotype %in% input$selectedPhenotypes) } ) @@ -425,14 +406,14 @@ phevaluatorServer <- function( shiny::tags$b("Phenotype(s):"), paste(unique(optionCols$databaseId[optionCols$databaseId %in% input$selectedDatabaseIds]), - collapse = ',') + collapse = ', ') ), shiny::column( width = 4, shiny::tags$b("Database(s):"), paste(unique(optionCols$phenotype[optionCols$phenotype %in% input$selectedPhenotypes]), - collapse = ',') + collapse = ', ') ) )) ) @@ -442,63 +423,75 @@ phevaluatorServer <- function( #read in custom column name colDef list from rds file, generated by #heplers-componentsCreateCustomColDefList.R - phevalColListOrig <- readRDS(system.file("components-columnInformation", - "phevaluator-colDefNamesList.rds", package = "OhdsiShinyModules") - ) - - # phevalColList <- readColDefsFromJSON("phevaluator-colDefs.json", - # "D:/shiny_test/GitHub Desktop/standardization/OhdsiShinyModules/inst/components-columnInformation" - # ) - #renaming names of columns in list to have cases match - names(phevalColList) <- SqlRender::snakeCaseToCamelCase(names(phevalColList)) + phevalColList <- ParallelLogger::loadSettingsFromJson(system.file("components-columnInformation", + "phevaluator-colDefs.json", + package = "OhdsiShinyModules") + ) + #define custom colDefs for SQL and JSON buttons + buttonColDefs <- list( + buttonSQL = reactable::colDef(header = withTooltip("SQL", "Downloads SQL code for the cohort"), + html = T + ), + buttonJSON = reactable::colDef(header = withTooltip("JSON", "Downloads JSON code for the cohort"), + html = T + ), + sql = reactable::colDef(show = F), + json = reactable::colDef(show = F) + ) #define custom column definitions and render the result table - customColDefs <- phevalColListOrig + customColDefs <- utils::modifyList(phevalColList, buttonColDefs) + - resultTableServer(id = "algorithmPerformanceResultsTable", + resultTableServer(id = ns("algorithmPerformanceResultsTable"), df = dataAlgorithmPerformance, - colDefsInput = customColDefs) + colDefsInput = customColDefs, + downloadedFileName = "algorithmPerformanceResultsTable-") - resultTableServer(id = "cohortDefinitionSetTable", + resultTableServer(id = ns("cohortDefinitionSetTable"), df = dataCohortDefinitionSet, - colDefsInput = customColDefs) + colDefsInput = customColDefs, + downloadedFileName = "cohortDefinitionSetTable-") - resultTableServer(id = "diagnosticsTable", + resultTableServer(id = ns("diagnosticsTable"), df = dataDiagnostics, - colDefsInput = customColDefs) + colDefsInput = customColDefs, + downloadedFileName = "diagnosticsTable-") - resultTableServer(id = "evaluationInputParametersTable", + resultTableServer(id = ns("evaluationInputParametersTable"), df = dataEvalInputParams, - colDefsInput = customColDefs) + colDefsInput = customColDefs, + downloadedFileName = "evaluationInputParametersTable-") - resultTableServer(id = "modelCovariatesTable", + resultTableServer(id = ns("modelCovariatesTable"), df = dataModelCovars, - colDefsInput = customColDefs) + colDefsInput = customColDefs, + downloadedFileName = "modelCovariatesTable-") - resultTableServer(id = "modelInputParametersTable", + resultTableServer(id = ns("modelInputParametersTable"), df = dataModelInputParams, - colDefsInput = customColDefs) + colDefsInput = customColDefs, + downloadedFileName = "modelInputParametersTable-") - resultTableServer(id = "modelPerformanceTable", + resultTableServer(id = ns("modelPerformanceTable"), df = dataModelPerformance, - colDefsInput = customColDefs) + colDefsInput = customColDefs, + downloadedFileName = "modelPerformanceTable-") - resultTableServer(id = "testSubjectsTable", + resultTableServer(id = ns("testSubjectsTable"), df = dataTestSubjects, - colDefsInput = customColDefs) + colDefsInput = customColDefs, + downloadedFileName = "testSubjectsTable-") - resultTableServer(id = "testSubjectsCovariatesTable", + resultTableServer(id = ns("testSubjectsCovariatesTable"), df = dataTestSubjectsCovars, - colDefsInput = customColDefs) - + colDefsInput = customColDefs, + downloadedFileName = "testSubjectsCovariatesTable-") return(invisible(NULL)) - - - }) } diff --git a/errorReportSql.txt b/errorReportSql.txt deleted file mode 100644 index 77cb3772..00000000 --- a/errorReportSql.txt +++ /dev/null @@ -1,31 +0,0 @@ -DBMS: -sqlite - -Error: -no such table: main.pv_COHORT_DEFINTION_SET - -SQL: -SELECT * FROM main.pv_COHORT_DEFINTION_SET - ; - -R version: -R version 4.2.2 (2022-10-31 ucrt) - -Platform: -x86_64-w64-mingw32 - -Attached base packages: -- stats -- graphics -- grDevices -- utils -- datasets -- methods -- base - -Other attached packages: -- OhdsiShinyModules (1.1.0.9000) -- shiny (1.7.4) -- testthat (3.1.6) -- ShinyAppBuilder (1.1.2) -- dplyr (1.1.0) \ No newline at end of file diff --git a/extras/codeToCreateDatasourcesDatabase.R b/extras/codeToCreateDatasourcesDatabase.R new file mode 100644 index 00000000..3d51dec6 --- /dev/null +++ b/extras/codeToCreateDatasourcesDatabase.R @@ -0,0 +1,38 @@ +# code to create test data + +testDir <- tempdir() +testDir <- 'D:/shiny_test/GitHub Desktop/standardization/OhdsiShinyModules/tests/resources' + +serverDS <- "tests/resources/dsDatabase/databaseFile.sqlite" +connectionDetailsDS <- DatabaseConnector::createConnectionDetails( + dbms = 'sqlite', + server = serverDS +) +connectionDS <- DatabaseConnector::connect( + connectionDetails = connectionDetailsDS, + dbms = 'sqlite', + user = NULL, + password = NULL, + server = serverDS, + port = NULL +) + +DatabaseConnector::insertTable( + connection = connectionDS, + databaseSchema = 'main', + tableName = 'database_meta_data', + data = data.frame( + databaseId = '1', + cdmSourceName = 'eunomia', + cdmSourceAbbreviation = 'eunomia' + ), + createTable = T, + camelCaseToSnakeCase = T +) + +# DatabaseConnector::dbRemoveTable(connectionDS, "cg_cohort_count") +# DatabaseConnector::dbRemoveTable(connectionDS, "cg_cohort_generation") +# DatabaseConnector::dbRemoveTable(connectionDS, "cg_cohort_inclusion") +# DatabaseConnector::dbRemoveTable(connectionDS, "cg_cohort_inc_result") +# DatabaseConnector::dbRemoveTable(connectionDS, "cg_cohort_summary_stats") +# DatabaseConnector::dbRemoveTable(connectionDS, "cg_cohort_definition") diff --git a/extras/codeToCreatePhevaluatorDatabase.R b/extras/codeToCreatePhevaluatorDatabase.R index b7cb4bb9..42017756 100644 --- a/extras/codeToCreatePhevaluatorDatabase.R +++ b/extras/codeToCreatePhevaluatorDatabase.R @@ -1,46 +1,49 @@ -#load specification - - mypath <- "D:/shiny_test/GitHub Desktop/standardization/phevaluator" - serverPV <- "tests/resources/pvDatabase/phevaluator.sqlite" - - #delete entire database - unlink(serverPV) - - #load tje results data model spec - specification <- ResultModelManager::loadResultsDataModelSpecifications(file.path(mypath, - "resultsDataModelSpecification.csv") - ) - - #create sql to generate schema - sql <- ResultModelManager::generateSqlSchema(schemaDefinition = specification) - - #create the schema - connectionDetails <- DatabaseConnector::createConnectionDetails(dbms = "sqlite", - server = serverPV) - - #upload the results to the schema - ResultModelManager::uploadResults(connectionDetails = connectionDetails, - schema = "main", - resultsFolder = file.path(mypath, "results"), - tablePrefix = "", - specifications = specification, - purgeSiteDataBeforeUploading = F) - - # qns <- ResultModelManager::createQueryNamespace(connectionDetails = connectionDetails, - # tableSpecification = specification, - # tablePrefix = "", - # database_schema = "main") - # #execute the SQL - # qns$executeSql(sql) - -#DBI::dbConnect(RSQLite::SQLite(), dbname = "phevaluator.sqlite") - -#create connection to DB -connection <- DatabaseConnector::connect(connectionDetails = connectionDetails) +# #load specification +# +# mypath <- "D:/shiny/resultModelSpecs" +# serverPV <- "tests/resources/pvDatabase/phevaluator.sqlite" +# +# #delete entire database +# unlink(serverPV) +# +# #load tje results data model spec +# specification <- ResultModelManager::loadResultsDataModelSpecifications(file.path(mypath, +# "resultsDataModelSpecificationReordered.csv") +# ) +# +# #create sql to generate schema +# sql <- ResultModelManager::generateSqlSchema(schemaDefinition = specification) +# +# #create the schema +# connectionDetails <- DatabaseConnector::createConnectionDetails(dbms = "sqlite", +# server = serverPV) +# +# +# # #need to re run the below qns when re-making the database +# qns <- ResultModelManager::createQueryNamespace(connectionDetails = connectionDetails, +# tableSpecification = specification, +# tablePrefix = "", +# database_schema = "main") +# #execute the SQL +# qns$executeSql(sql) +# +# +# #upload the results to the schema +# ResultModelManager::uploadResults(connectionDetails = connectionDetails, +# schema = "main", +# resultsFolder = file.path(mypath, "results"), +# tablePrefix = "", +# specifications = specification, +# purgeSiteDataBeforeUploading = F) +# +# #DBI::dbConnect(RSQLite::SQLite(), dbname = "phevaluator.sqlite") +# +# #create connection to DB +# connection <- DatabaseConnector::connect(connectionDetails = connectionDetails) +# +# #disconnect +# DatabaseConnector::disconnect(connection) -#disconnect -DatabaseConnector::disconnect(connection) - @@ -49,110 +52,110 @@ DatabaseConnector::disconnect(connection) # code to manually create test data -#resultsPV <- "D:/shiny_test/GitHub Desktop/standardization/phevaluator/results" -# serverPV <- "tests/resources/pvDatabase/phevaluator.sqlite" -# connectionDetailsPV <- DatabaseConnector::createConnectionDetails( -# dbms = 'sqlite', -# server = serverPV -# ) -# connectionPV <- DatabaseConnector::connect( -# connectionDetails = connectionDetailsPV, -# dbms = 'sqlite', -# user = NULL, -# password = NULL, -# server = serverPV, -# port = NULL -# ) -# -# DatabaseConnector::insertTable( -# connection = connectionPV, -# databaseSchema = 'main', -# tableName = 'PV_ALGORITHM_PERFORMANCE_RESULTS', -# data = read.csv(file.path(resultsPV, "pv_algorithm_performance_results.csv")), -# createTable = T, dropTableIfExists = T, -# camelCaseToSnakeCase = F -# ) -# -# DatabaseConnector::insertTable( -# connection = connectionPV, -# databaseSchema = 'main', -# tableName = 'PV_COHORT_DEFINITION_SET', -# data = read.csv(file.path(resultsPV, "pv_cohort_definition_set.csv")), -# createTable = T, dropTableIfExists = T, -# camelCaseToSnakeCase = F -# ) -# -# DatabaseConnector::insertTable( -# connection = connectionPV, -# databaseSchema = 'main', -# tableName = 'PV_DIAGNOSTICS', -# data = read.csv(file.path(resultsPV, "pv_diagnostics.csv")), -# createTable = T, dropTableIfExists = T, -# camelCaseToSnakeCase = F -# ) -# -# DatabaseConnector::insertTable( -# connection = connectionPV, -# databaseSchema = 'main', -# tableName = 'PV_EVALUATION_INPUT_PARAMETERS', -# data = read.csv(file.path(resultsPV, "pv_evaluation_input_parameters.csv")), -# createTable = T, dropTableIfExists = T, -# camelCaseToSnakeCase = F -# ) -# -# DatabaseConnector::insertTable( -# connection = connectionPV, -# databaseSchema = 'main', -# tableName = 'PV_MODEL_COVARIATES', -# data = read.csv(file.path(resultsPV, "pv_model_covariates.csv")), -# createTable = T, dropTableIfExists = T, -# camelCaseToSnakeCase = F -# ) -# -# DatabaseConnector::insertTable( -# connection = connectionPV, -# databaseSchema = 'main', -# tableName = 'PV_MODEL_INPUT_PARAMETERS', -# data = read.csv(file.path(resultsPV, "pv_model_input_parameters.csv")), -# createTable = T, dropTableIfExists = T, -# camelCaseToSnakeCase = F -# ) -# -# DatabaseConnector::insertTable( -# connection = connectionPV, -# databaseSchema = 'main', -# tableName = 'PV_MODEL_PERFORMANCE', -# data = read.csv(file.path(resultsPV, "pv_model_performance.csv")), -# createTable = T, dropTableIfExists = T, -# camelCaseToSnakeCase = F -# ) -# -# DatabaseConnector::insertTable( -# connection = connectionPV, -# databaseSchema = 'main', -# tableName = 'PV_MODEL_RUN_TIME_VALUES', -# data = read.csv(file.path(resultsPV, "pv_model_run_time_values.csv")), -# createTable = T, dropTableIfExists = T, -# camelCaseToSnakeCase = F -# ) -# -# DatabaseConnector::insertTable( -# connection = connectionPV, -# databaseSchema = 'main', -# tableName = 'PV_TEST_SUBJECTS', -# data = read.csv(file.path(resultsPV, "pv_test_subjects.csv")), -# createTable = T, dropTableIfExists = T, -# camelCaseToSnakeCase = F -# ) +resultsPV <- "D:/shiny/resultModelSpecs/results" +serverPV <- "tests/resources/pvDatabase/phevaluator.sqlite" +connectionDetailsPV <- DatabaseConnector::createConnectionDetails( + dbms = 'sqlite', + server = serverPV +) +connectionPV <- DatabaseConnector::connect( + connectionDetails = connectionDetailsPV, + dbms = 'sqlite', + user = NULL, + password = NULL, + server = serverPV, + port = NULL +) # -# DatabaseConnector::insertTable( -# connection = connectionPV, -# databaseSchema = 'main', -# tableName = 'PV_TEST_SUBJECTS_COVARIATES', -# data = read.csv(file.path(resultsPV, "pv_test_subjects_covariates.csv")), -# createTable = T, dropTableIfExists = T, -# camelCaseToSnakeCase = F -# ) +DatabaseConnector::insertTable( + connection = connectionPV, + databaseSchema = 'main', + tableName = 'PV_ALGORITHM_PERFORMANCE_RESULTS', + data = read.csv(file.path(resultsPV, "pv_algorithm_performance_results.csv")), + createTable = T, dropTableIfExists = T, + camelCaseToSnakeCase = F +) + +DatabaseConnector::insertTable( + connection = connectionPV, + databaseSchema = 'main', + tableName = 'PV_COHORT_DEFINITION_SET', + data = read.csv(file.path(resultsPV, "pv_cohort_definition_set.csv")), + createTable = T, dropTableIfExists = T, + camelCaseToSnakeCase = F +) + +DatabaseConnector::insertTable( + connection = connectionPV, + databaseSchema = 'main', + tableName = 'PV_DIAGNOSTICS', + data = read.csv(file.path(resultsPV, "pv_diagnostics.csv")), + createTable = T, dropTableIfExists = T, + camelCaseToSnakeCase = F +) + +DatabaseConnector::insertTable( + connection = connectionPV, + databaseSchema = 'main', + tableName = 'PV_EVALUATION_INPUT_PARAMETERS', + data = read.csv(file.path(resultsPV, "pv_evaluation_input_parameters.csv")), + createTable = T, dropTableIfExists = T, + camelCaseToSnakeCase = F +) + +DatabaseConnector::insertTable( + connection = connectionPV, + databaseSchema = 'main', + tableName = 'PV_MODEL_COVARIATES', + data = read.csv(file.path(resultsPV, "pv_model_covariates.csv")), + createTable = T, dropTableIfExists = T, + camelCaseToSnakeCase = F +) + +DatabaseConnector::insertTable( + connection = connectionPV, + databaseSchema = 'main', + tableName = 'PV_MODEL_INPUT_PARAMETERS', + data = read.csv(file.path(resultsPV, "pv_model_input_parameters.csv")), + createTable = T, dropTableIfExists = T, + camelCaseToSnakeCase = F +) + +DatabaseConnector::insertTable( + connection = connectionPV, + databaseSchema = 'main', + tableName = 'PV_MODEL_PERFORMANCE', + data = read.csv(file.path(resultsPV, "pv_model_performance.csv")), + createTable = T, dropTableIfExists = T, + camelCaseToSnakeCase = F +) + +DatabaseConnector::insertTable( + connection = connectionPV, + databaseSchema = 'main', + tableName = 'PV_MODEL_RUN_TIME_VALUES', + data = read.csv(file.path(resultsPV, "pv_model_run_time_values.csv")), + createTable = T, dropTableIfExists = T, + camelCaseToSnakeCase = F +) + +DatabaseConnector::insertTable( + connection = connectionPV, + databaseSchema = 'main', + tableName = 'PV_TEST_SUBJECTS', + data = read.csv(file.path(resultsPV, "pv_test_subjects.csv")), + createTable = T, dropTableIfExists = T, + camelCaseToSnakeCase = F +) + +DatabaseConnector::insertTable( + connection = connectionPV, + databaseSchema = 'main', + tableName = 'PV_TEST_SUBJECTS_COVARIATES', + data = read.csv(file.path(resultsPV, "pv_test_subjects_covariates.csv")), + createTable = T, dropTableIfExists = T, + camelCaseToSnakeCase = F +) diff --git a/inst/components-columnInformation/datasources-colDefs.json b/inst/components-columnInformation/datasources-colDefs.json new file mode 100644 index 00000000..c8e2d398 --- /dev/null +++ b/inst/components-columnInformation/datasources-colDefs.json @@ -0,0 +1,687 @@ +{ + "cdmSourceName": { + "name": "cdmSourceName", + "header": { + "name": "div", + "attribs": { + "style": "text-decoration: underline; text-decoration-style: dotted; cursor: help" + }, + "children": [ + { + "x": { + "opts": { + "content": "Name of the database (DB)" + }, + "text": "DB Name" + }, + "width": null, + "height": null, + "sizingPolicy": { + "defaultWidth": null, + "defaultHeight": null, + "padding": null, + "fill": null, + "viewer": { + "defaultWidth": null, + "defaultHeight": null, + "padding": null, + "fill": true, + "suppress": false, + "paneHeight": null + }, + "browser": { + "defaultWidth": null, + "defaultHeight": null, + "padding": null, + "fill": false, + "external": false + }, + "knitr": { + "defaultWidth": null, + "defaultHeight": null, + "figure": true + } + }, + "dependencies": null, + "elementId": null, + "preRenderHook": null, + "jsHooks": [], + "attr_class": ["tippy", "htmlwidget"], + "attr_package": "tippy" + } + ], + "attr_class": "shiny.tag" + }, + "attr_class": "colDef" + }, + "cdmSourceAbbreviation": { + "name": "cdmSourceAbbreviation", + "header": { + "name": "div", + "attribs": { + "style": "text-decoration: underline; text-decoration-style: dotted; cursor: help" + }, + "children": [ + { + "x": { + "opts": { + "content": "Abbreviation for the database (DB)" + }, + "text": "DB Abbreviation" + }, + "width": null, + "height": null, + "sizingPolicy": { + "defaultWidth": null, + "defaultHeight": null, + "padding": null, + "fill": null, + "viewer": { + "defaultWidth": null, + "defaultHeight": null, + "padding": null, + "fill": true, + "suppress": false, + "paneHeight": null + }, + "browser": { + "defaultWidth": null, + "defaultHeight": null, + "padding": null, + "fill": false, + "external": false + }, + "knitr": { + "defaultWidth": null, + "defaultHeight": null, + "figure": true + } + }, + "dependencies": null, + "elementId": null, + "preRenderHook": null, + "jsHooks": [], + "attr_class": ["tippy", "htmlwidget"], + "attr_package": "tippy" + } + ], + "attr_class": "shiny.tag" + }, + "attr_class": "colDef" + }, + "cdmHolder": { + "name": "cdmHolder", + "header": { + "name": "div", + "attribs": { + "style": "text-decoration: underline; text-decoration-style: dotted; cursor: help" + }, + "children": [ + { + "x": { + "opts": { + "content": "Holder of the database (DB)" + }, + "text": "DB Holder" + }, + "width": null, + "height": null, + "sizingPolicy": { + "defaultWidth": null, + "defaultHeight": null, + "padding": null, + "fill": null, + "viewer": { + "defaultWidth": null, + "defaultHeight": null, + "padding": null, + "fill": true, + "suppress": false, + "paneHeight": null + }, + "browser": { + "defaultWidth": null, + "defaultHeight": null, + "padding": null, + "fill": false, + "external": false + }, + "knitr": { + "defaultWidth": null, + "defaultHeight": null, + "figure": true + } + }, + "dependencies": null, + "elementId": null, + "preRenderHook": null, + "jsHooks": [], + "attr_class": ["tippy", "htmlwidget"], + "attr_package": "tippy" + } + ], + "attr_class": "shiny.tag" + }, + "attr_class": "colDef" + }, + "sourceDescription": { + "name": "sourceDescription", + "show": false, + "header": { + "name": "div", + "attribs": { + "style": "text-decoration: underline; text-decoration-style: dotted; cursor: help" + }, + "children": [ + { + "x": { + "opts": { + "content": "Description of the database (DB)" + }, + "text": "DB Description" + }, + "width": null, + "height": null, + "sizingPolicy": { + "defaultWidth": null, + "defaultHeight": null, + "padding": null, + "fill": null, + "viewer": { + "defaultWidth": null, + "defaultHeight": null, + "padding": null, + "fill": true, + "suppress": false, + "paneHeight": null + }, + "browser": { + "defaultWidth": null, + "defaultHeight": null, + "padding": null, + "fill": false, + "external": false + }, + "knitr": { + "defaultWidth": null, + "defaultHeight": null, + "figure": true + } + }, + "dependencies": null, + "elementId": null, + "preRenderHook": null, + "jsHooks": [], + "attr_class": ["tippy", "htmlwidget"], + "attr_package": "tippy" + } + ], + "attr_class": "shiny.tag" + }, + "attr_class": "colDef" + }, + "sourceDocumentationReference": { + "name": "sourceDocumentationReference", + "cell": "\n function(cellInfo) {\n // Render as a link\n const url = cellInfo.value;\n return `RHEALTH Description<\/a>`;\n }\n ", + "header": { + "name": "div", + "attribs": { + "style": "text-decoration: underline; text-decoration-style: dotted; cursor: help" + }, + "children": [ + { + "x": { + "opts": { + "content": "HTML link to the database (DB) description" + }, + "text": "DB Description Link" + }, + "width": null, + "height": null, + "sizingPolicy": { + "defaultWidth": null, + "defaultHeight": null, + "padding": null, + "fill": null, + "viewer": { + "defaultWidth": null, + "defaultHeight": null, + "padding": null, + "fill": true, + "suppress": false, + "paneHeight": null + }, + "browser": { + "defaultWidth": null, + "defaultHeight": null, + "padding": null, + "fill": false, + "external": false + }, + "knitr": { + "defaultWidth": null, + "defaultHeight": null, + "figure": true + } + }, + "dependencies": null, + "elementId": null, + "preRenderHook": null, + "jsHooks": [], + "attr_class": ["tippy", "htmlwidget"], + "attr_package": "tippy" + } + ], + "attr_class": "shiny.tag" + }, + "html": true, + "attr_class": "colDef" + }, + "cdmEtlReference": { + "name": "cdmEtlReference", + "cell": "\n function(cellInfo) {\n // Render as a link\n const url = cellInfo.value;\n return `ETL<\/a>`;\n }\n ", + "header": { + "name": "div", + "attribs": { + "style": "text-decoration: underline; text-decoration-style: dotted; cursor: help" + }, + "children": [ + { + "x": { + "opts": { + "content": "HTML link to the ETL for the database (DB)" + }, + "text": "DB ETL Link" + }, + "width": null, + "height": null, + "sizingPolicy": { + "defaultWidth": null, + "defaultHeight": null, + "padding": null, + "fill": null, + "viewer": { + "defaultWidth": null, + "defaultHeight": null, + "padding": null, + "fill": true, + "suppress": false, + "paneHeight": null + }, + "browser": { + "defaultWidth": null, + "defaultHeight": null, + "padding": null, + "fill": false, + "external": false + }, + "knitr": { + "defaultWidth": null, + "defaultHeight": null, + "figure": true + } + }, + "dependencies": null, + "elementId": null, + "preRenderHook": null, + "jsHooks": [], + "attr_class": ["tippy", "htmlwidget"], + "attr_package": "tippy" + } + ], + "attr_class": "shiny.tag" + }, + "html": true, + "attr_class": "colDef" + }, + "sourceReleaseDate": { + "name": "sourceReleaseDate", + "format": { + "cell": { + "date": true, + "attr_class": "colFormat" + }, + "aggregated": { + "date": true, + "attr_class": "colFormat" + } + }, + "header": { + "name": "div", + "attribs": { + "style": "text-decoration: underline; text-decoration-style: dotted; cursor: help" + }, + "children": [ + { + "x": { + "opts": { + "content": "Date the source data was released" + }, + "text": "Source Data Release Date" + }, + "width": null, + "height": null, + "sizingPolicy": { + "defaultWidth": null, + "defaultHeight": null, + "padding": null, + "fill": null, + "viewer": { + "defaultWidth": null, + "defaultHeight": null, + "padding": null, + "fill": true, + "suppress": false, + "paneHeight": null + }, + "browser": { + "defaultWidth": null, + "defaultHeight": null, + "padding": null, + "fill": false, + "external": false + }, + "knitr": { + "defaultWidth": null, + "defaultHeight": null, + "figure": true + } + }, + "dependencies": null, + "elementId": null, + "preRenderHook": null, + "jsHooks": [], + "attr_class": ["tippy", "htmlwidget"], + "attr_package": "tippy" + } + ], + "attr_class": "shiny.tag" + }, + "attr_class": "colDef" + }, + "cdmReleaseDate": { + "name": "cdmReleaseDate", + "format": { + "cell": { + "date": true, + "attr_class": "colFormat" + }, + "aggregated": { + "date": true, + "attr_class": "colFormat" + } + }, + "header": { + "name": "div", + "attribs": { + "style": "text-decoration: underline; text-decoration-style: dotted; cursor: help" + }, + "children": [ + { + "x": { + "opts": { + "content": "Date the CDM database (DB) was accessible" + }, + "text": "CDM DB Release Date" + }, + "width": null, + "height": null, + "sizingPolicy": { + "defaultWidth": null, + "defaultHeight": null, + "padding": null, + "fill": null, + "viewer": { + "defaultWidth": null, + "defaultHeight": null, + "padding": null, + "fill": true, + "suppress": false, + "paneHeight": null + }, + "browser": { + "defaultWidth": null, + "defaultHeight": null, + "padding": null, + "fill": false, + "external": false + }, + "knitr": { + "defaultWidth": null, + "defaultHeight": null, + "figure": true + } + }, + "dependencies": null, + "elementId": null, + "preRenderHook": null, + "jsHooks": [], + "attr_class": ["tippy", "htmlwidget"], + "attr_package": "tippy" + } + ], + "attr_class": "shiny.tag" + }, + "attr_class": "colDef" + }, + "cdmVersion": { + "name": "cdmVersion", + "header": { + "name": "div", + "attribs": { + "style": "text-decoration: underline; text-decoration-style: dotted; cursor: help" + }, + "children": [ + { + "x": { + "opts": { + "content": "Version of the common data model (CDM)" + }, + "text": "CDM Version" + }, + "width": null, + "height": null, + "sizingPolicy": { + "defaultWidth": null, + "defaultHeight": null, + "padding": null, + "fill": null, + "viewer": { + "defaultWidth": null, + "defaultHeight": null, + "padding": null, + "fill": true, + "suppress": false, + "paneHeight": null + }, + "browser": { + "defaultWidth": null, + "defaultHeight": null, + "padding": null, + "fill": false, + "external": false + }, + "knitr": { + "defaultWidth": null, + "defaultHeight": null, + "figure": true + } + }, + "dependencies": null, + "elementId": null, + "preRenderHook": null, + "jsHooks": [], + "attr_class": ["tippy", "htmlwidget"], + "attr_package": "tippy" + } + ], + "attr_class": "shiny.tag" + }, + "attr_class": "colDef" + }, + "vocabularyVersion": { + "name": "vocabularyVersion", + "header": { + "name": "div", + "attribs": { + "style": "text-decoration: underline; text-decoration-style: dotted; cursor: help" + }, + "children": [ + { + "x": { + "opts": { + "content": "Version of the vocabulary used in the database (DB)" + }, + "text": "Vocabulary Version" + }, + "width": null, + "height": null, + "sizingPolicy": { + "defaultWidth": null, + "defaultHeight": null, + "padding": null, + "fill": null, + "viewer": { + "defaultWidth": null, + "defaultHeight": null, + "padding": null, + "fill": true, + "suppress": false, + "paneHeight": null + }, + "browser": { + "defaultWidth": null, + "defaultHeight": null, + "padding": null, + "fill": false, + "external": false + }, + "knitr": { + "defaultWidth": null, + "defaultHeight": null, + "figure": true + } + }, + "dependencies": null, + "elementId": null, + "preRenderHook": null, + "jsHooks": [], + "attr_class": ["tippy", "htmlwidget"], + "attr_package": "tippy" + } + ], + "attr_class": "shiny.tag" + }, + "attr_class": "colDef" + }, + "databaseId": { + "name": "databaseId", + "header": { + "name": "div", + "attribs": { + "style": "text-decoration: underline; text-decoration-style: dotted; cursor: help" + }, + "children": [ + { + "x": { + "opts": { + "content": "Unique identifier (ID) of the database (DB)" + }, + "text": "DB ID" + }, + "width": null, + "height": null, + "sizingPolicy": { + "defaultWidth": null, + "defaultHeight": null, + "padding": null, + "fill": null, + "viewer": { + "defaultWidth": null, + "defaultHeight": null, + "padding": null, + "fill": true, + "suppress": false, + "paneHeight": null + }, + "browser": { + "defaultWidth": null, + "defaultHeight": null, + "padding": null, + "fill": false, + "external": false + }, + "knitr": { + "defaultWidth": null, + "defaultHeight": null, + "figure": true + } + }, + "dependencies": null, + "elementId": null, + "preRenderHook": null, + "jsHooks": [], + "attr_class": ["tippy", "htmlwidget"], + "attr_package": "tippy" + } + ], + "attr_class": "shiny.tag" + }, + "attr_class": "colDef" + }, + "maxObsPeriodEndDate": { + "name": "maxObsPeriodEndDate", + "header": { + "name": "div", + "attribs": { + "style": "text-decoration: underline; text-decoration-style: dotted; cursor: help" + }, + "children": [ + { + "x": { + "opts": { + "content": "Maximum/Latest observation period date in the database (DB)" + }, + "text": "Max Obs. Period End Date" + }, + "width": null, + "height": null, + "sizingPolicy": { + "defaultWidth": null, + "defaultHeight": null, + "padding": null, + "fill": null, + "viewer": { + "defaultWidth": null, + "defaultHeight": null, + "padding": null, + "fill": true, + "suppress": false, + "paneHeight": null + }, + "browser": { + "defaultWidth": null, + "defaultHeight": null, + "padding": null, + "fill": false, + "external": false + }, + "knitr": { + "defaultWidth": null, + "defaultHeight": null, + "figure": true + } + }, + "dependencies": null, + "elementId": null, + "preRenderHook": null, + "jsHooks": [], + "attr_class": ["tippy", "htmlwidget"], + "attr_package": "tippy" + } + ], + "attr_class": "shiny.tag" + }, + "attr_class": "colDef" + } +} diff --git a/inst/components-columnInformation/phevaluator-colDefNamesList.rds b/inst/components-columnInformation/phevaluator-colDefNamesList.rds deleted file mode 100644 index 0b4632b2..00000000 Binary files a/inst/components-columnInformation/phevaluator-colDefNamesList.rds and /dev/null differ diff --git a/inst/components-columnInformation/phevaluator-colDefs.json b/inst/components-columnInformation/phevaluator-colDefs.json index d8b6e07e..5f7c7a4a 100644 --- a/inst/components-columnInformation/phevaluator-colDefs.json +++ b/inst/components-columnInformation/phevaluator-colDefs.json @@ -1 +1,7793 @@ -{"database_id":{"header":"
\n <\/span>\n