Merge branch 'develop' into cd-bugs

# Conflicts: # R/heplers-componentsCreateCustomColDefList.R # man/createCustomColDefList.Rd # man/resultTableServer.Rd # man/resultTableViewer.Rd
OHDSI · Jul 5, 2023 · c158f4a · c158f4a
2 parents e63985e + dce6532
commit c158f4a
Show file tree

Hide file tree

Showing 35 changed files with 9,421 additions and 857 deletions.
diff --git 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
@@ -36,6 +36,7 @@ Imports:
     shinydashboard,
     shinyWidgets,
     SqlRender,
+    stringi,
     stringr,
     tibble,
     tidyr,

diff --git a/NAMESPACE b/NAMESPACE
@@ -25,6 +25,9 @@ export(dataDiagnosticSummaryServer)
 export(dataDiagnosticSummaryViewer)
 export(dataDiagnosticViewer)
 export(databaseInformationView)
+export(datasourcesHelperFile)
+export(datasourcesServer)
+export(datasourcesViewer)
 export(descriptionAggregateFeaturesServer)
 export(descriptionAggregateFeaturesViewer)
 export(descriptionDechallengeRechallengeServer)
@@ -73,6 +76,7 @@ export(getLogoImage)
 export(incidenceRatesView)
 export(inclusionRulesView)
 export(indexEventBreakdownView)
+export(makeButtonLabel)
 export(orpahanConceptsView)
 export(phevaluatorHelperFile)
 export(phevaluatorServer)
@@ -100,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
@@ -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
@@ -9,10 +9,12 @@
 #' 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
 #'
-resultTableViewer <- function(id = "result-table") {
+resultTableViewer <- function(id = "result-table",
+                              downloadedFileName = NULL) {
   ns <- shiny::NS(id)
   shiny::div(# UI
     shinydashboard::box(
@@ -40,6 +42,7 @@ resultTableViewer <- function(id = "result-table") {
                 "Reactable.downloadDataCSV('",
                 ns('resultData'),
                 "', 'result-data-filtered-",
+                downloadedFileName,
                 Sys.Date(),
                 ".csv')"
               )
@@ -75,17 +78,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)) {
@@ -94,11 +94,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)
@@ -110,98 +110,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",
@@ -225,12 +138,14 @@ 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
 #'
 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) {
@@ -256,18 +171,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({
 
@@ -287,18 +207,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)
+
                               }
-
                             )
 
 
@@ -307,7 +223,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,