Develop

.github/workflows/R_CMD_check_Hades.yaml

@@ -52,7 +52,7 @@ jobs:
       CDM5_SPARK_CONNECTION_STRING: ${{ secrets.CDM5_SPARK_CONNECTION_STRING }}
 
     steps:
-      - uses: actions/checkout@v2
+      - uses: actions/checkout@v4
 
       - uses: r-lib/actions/setup-r@v2
         with:
@@ -85,7 +85,7 @@ jobs:
 
       - name: Upload source package
         if: success() && runner.os == 'macOS' && github.event_name != 'pull_request' && github.ref == 'refs/heads/main'
-        uses: actions/upload-artifact@v2
+        uses: actions/upload-artifact@v4
         with:
           name: package_tarball
           path: check/*.tar.gz
@@ -113,7 +113,7 @@ jobs:
 
     steps:
 
-      - uses: actions/checkout@v2
+      - uses: actions/checkout@v4
         with:
           fetch-depth: 0
 
@@ -155,7 +155,7 @@ jobs:
 
       - name: Download package tarball
         if: ${{ env.new_version != '' }}
-        uses: actions/download-artifact@v2
+        uses: actions/download-artifact@v4
         with:
           name: package_tarball
 

R/characterization-caseSeries.R

@@ -74,20 +74,38 @@ characterizationCaseSeriesServer <- function(
       output$inputs <- shiny::renderUI({ # need to make reactive?
 
         shiny::div(
-          shiny::selectInput(
+          shinyWidgets::pickerInput(
             inputId = session$ns('databaseId'),
             label = 'Database: ',
             choices = options()$databaseIds,
             selected = options()$databaseIds[1],
-            multiple = F
+            multiple = F,
+            options = shinyWidgets::pickerOptions(
+              actionsBox = TRUE,
+              liveSearch = TRUE,
+              size = 10,
+              dropupAuto = TRUE,
+              liveSearchStyle = "contains",
+              liveSearchPlaceholder = "Type here to search",
+              virtualScroll = 50
+            )
           ),
 
-          shiny::selectInput(
+          shinyWidgets::pickerInput(
             inputId = session$ns('tarInd'),
             label = 'Time-at-risk: ',
             choices = options()$tarInds,
             selected = options()$tarInds[1],
-            multiple = F
+            multiple = F,
+            options = shinyWidgets::pickerOptions(
+              actionsBox = TRUE,
+              liveSearch = TRUE,
+              size = 10,
+              dropupAuto = TRUE,
+              liveSearchStyle = "contains",
+              liveSearchPlaceholder = "Type here to search",
+              virtualScroll = 50
+            )
           ),
 
           shiny::actionButton(

R/characterization-database.R

@@ -85,12 +85,21 @@ characterizationDatabaseComparisonServer <- function(
       output$inputs <- shiny::renderUI({
 
         shiny::div(
-          shiny::selectInput(
+          shinyWidgets::pickerInput(
             inputId = session$ns('databaseIds'), 
             label = 'Databases: ',
             choices = inputVals()$databaseIds,
             selected = inputVals()$databaseIds[1],
-            multiple = T
+            multiple = T,
+            options = shinyWidgets::pickerOptions(
+              actionsBox = TRUE,
+              liveSearch = TRUE,
+              size = 10,
+              dropupAuto = TRUE,
+              liveSearchStyle = "contains",
+              liveSearchPlaceholder = "Type here to search",
+              virtualScroll = 50
+            )
           ),
 
           shiny::sliderInput(

R/characterization-incidence.R

@@ -268,21 +268,27 @@ characterizationIncidenceServer <- function(
             style = "font-weight: bold; font-size: 20px; text-align: center; margin-bottom: 20px;"
           ),
 
-          shiny::selectInput(
+          shinyWidgets::pickerInput(
             inputId = session$ns('outcomeIds'),
             label = 'Outcome: ',
             choices = outcomes(),
-            selected = 1,
+            selected = outcomes()[1],
             multiple = T,
-            selectize = TRUE,
-            width = NULL,
-            size = NULL
+            options = shinyWidgets::pickerOptions(
+              actionsBox = TRUE,
+              liveSearch = TRUE,
+              size = 10,
+              dropupAuto = TRUE,
+              liveSearchStyle = "contains",
+              liveSearchPlaceholder = "Type here to search",
+              virtualScroll = 50
+            )
           ),
 
           shinyWidgets::pickerInput(
             inputId = session$ns('databaseSelector'),
             label = 'Filter By Database: ',
-            choices = ciOptions$databases,
+            choices = sort(ciOptions$databases),
             selected = ciOptions$databases,
             multiple = T,
             options = shinyWidgets::pickerOptions(

R/characterization-riskFactors.R

@@ -684,8 +684,41 @@ characteriationCountsColDefs <- function(
       filterable = T
     ),
 
+    minPriorObservation = reactable::colDef(
+      header = withTooltip("Min Prior Observation",
+                           "Minimum prior observation time (days)"),
+      filterable = T,
+      filterInput = function(values, name) {
+        shiny::tags$select(
+          # Set to undefined to clear the filter
+          onchange = sprintf("Reactable.setFilter('%s', '%s', event.target.value || undefined)", elementId, name),
+          # "All" has an empty value to clear the filter, and is the default option
+          shiny::tags$option(value = "", "All"),
+          lapply(unique(values), shiny::tags$option),
+          "aria-label" = sprintf("Filter %s", name),
+          style = "width: 100%; height: 28px;"
+        )
+      }
+    ), 
+    outcomeWashoutDays = reactable::colDef(
+      header = withTooltip("Outcome Washout Days",
+                           "Number of days for the outcome washout"),
+      filterable = T,
+      filterInput = function(values, name) {
+        shiny::tags$select(
+          # Set to undefined to clear the filter
+          onchange = sprintf("Reactable.setFilter('%s', '%s', event.target.value || undefined)", elementId, name),
+          # "All" has an empty value to clear the filter, and is the default option
+          shiny::tags$option(value = "", "All"),
+          lapply(unique(values), shiny::tags$option),
+          "aria-label" = sprintf("Filter %s", name),
+          style = "width: 100%; height: 28px;"
+        )
+      }
+    ),
+
     rowCount = reactable::colDef(
-      header = withTooltip("# rows",
+      header = withTooltip("# Rows",
                            "Number of exposures in the cohort (people can be in more than once)"),
       cell = function(value) {
         if(is.null(value)){return('< min threshold')}
@@ -694,7 +727,7 @@ characteriationCountsColDefs <- function(
       }
     ), 
     personCount = reactable::colDef(
-      header = withTooltip("# persons",
+      header = withTooltip("# Persons",
                            "Number of distinct people in the cohort"),
       cell = function(value) {
         if(is.null(value)){return('< min threshold')}

R/characterization-timeToEvent.R

@@ -174,12 +174,21 @@ characterizationTimeToEventServer <- function(
         shiny::fluidPage(
           shiny::fluidRow(
 
-            shiny::selectInput(
+            shinyWidgets::pickerInput(
               inputId = session$ns("databases"),
               label = "Databases:",
               multiple = T, 
               choices = unique(allData()$databaseName),
-              selected = unique(allData()$databaseName)
+              selected = unique(allData()$databaseName),
+              options = shinyWidgets::pickerOptions(
+                actionsBox = TRUE,
+                liveSearch = TRUE,
+                size = 10,
+                dropupAuto = TRUE,
+                liveSearchStyle = "contains",
+                liveSearchPlaceholder = "Type here to search",
+                virtualScroll = 50
+                )
               ),
 
             shiny::fluidRow(

R/cohort-diagnostics-cohort-overlap.R

@@ -128,7 +128,10 @@ plotCohortOverlap <- function(data,
                                     title = "",
                                     gridcolor = 'ffff'),
                        yaxis = list(zerolinecolor = '#ffff',
-                                    title = database,
+                                    title = addTextBreaks(
+                                      text = database, 
+                                      length = 25
+                                      ),
                                     zerolinewidth = 1,
                                     gridcolor = 'ffff'))
 

R/cohort-diagnostics-databaseInformation.R

@@ -29,7 +29,7 @@ databaseInformationView <- function(id) {
     shinydashboard::box(
       width = NULL,
       title = "Execution meta-data",
-      shiny::tags$p("Each entry relates to execution on a given cdm. Results are merged between executions incrementally"),
+      shiny::tags$p("Each entry relates to execution on a given CDM. Results are merged between executions incrementally"),
       shinycssloaders::withSpinner(reactable::reactableOutput(outputId = ns("databaseInformationTable"))),
       shiny::conditionalPanel(
         "output.databaseInformationTableIsSelected == true",

R/cohort-diagnostics-timeDistributions.R

@@ -176,7 +176,10 @@ plotTimeDistribution <- function(data, shortNameRef = NULL, showMax = FALSE) {
                          zerolinewidth = 2,
                          gridcolor = 'ffff'),
                        yaxis = list(
-                         title = db,
+                         title = addTextBreaks(
+                           text = db, 
+                           length = 25 # change this based on plot height?
+                         ),
                          showTitle = FALSE,
                          zerolinecolor = '#ffff',
                          zerolinewidth = 2,