Columns now parameter to compnenent not data object, convenient creat…

…ion function for ldts
OHDSI · Jul 13, 2023 · e8cca01 · e8cca01
1 parent 444aef4
commit e8cca01
Show file tree

Hide file tree

Showing 6 changed files with 115 additions and 59 deletions.
diff --git a/R/components-largeTableViewer.R b/R/components-largeTableViewer.R
@@ -11,37 +11,36 @@
 #' Alternatively, you might want to subclass this class. For example, if your backend query is against an API such
 #' as and ATLAS instance or ATHENA
 #'
+#' If subclassing use inheritance and treat this class as an interface to implement - implementing the methods:
+#'
+#'  get
+#'
 #' @field baseQuery         query string sql
 #' @field countQuery        count query string (should match query). Can be auto generated with sub query (default) but
 #'                          this will likely result in slow results
-#' @field columnDefs        reactable Coulmn definitions
 #' @field connectionHandler ResultModelManager connection handler to execute query inside
 LargeDataTable <- R6::R6Class(
   classname = "LargeDataTable",
   public = list(
     connectionHandler = NULL,
     baseQuery = NULL,
     countQuery = NULL,
-    columnDefs = NULL,
     #' initialize
     #'
     #' @param connectionHandler         ResultModelManager connectionHandler instance
     #' @param baseQuery                 base sql query
     #' @param countQuery                count query string (should match query). Can be auto generated with sub query
     #'                                  (default) but this will likely result in slow results
-    #' @param columnDefs                list of
     #'
     #' @return self
-    initialize = function(connectionHandler, baseQuery, countQuery = NULL, columnDefs = list()) {
+    initialize = function(connectionHandler, baseQuery, countQuery = NULL) {
       checkmate::assertR6(connectionHandler, "ConnectionHandler")
       checkmate::assertString(baseQuery)
       checkmate::assertString(countQuery, null.ok = TRUE)
-      checkmate::assertList(columnDefs, null.ok = TRUE, types = "colDef")
       # Cannot use multiple statments in a base query
       stopifnot(length(strsplit(baseQuery, ";")[[1]]) == 1)
       self$connectionHandler <- connectionHandler
       self$baseQuery <- baseQuery
-      self$columnDefs <- columnDefs
 
       if (!is.null(countQuery)) {
         stopifnot(length(strsplit(countQuery, ";")[[1]]) == 1)
@@ -51,12 +50,6 @@ LargeDataTable <- R6::R6Class(
       }
     },
 
-    #' @title get column defs
-    #' @return columnDefs
-    getColumnDefs = function() {
-      self$columnDefs
-    },
-
     #' get count
     #' @description
     #' execute count query with specified parameters
@@ -92,11 +85,36 @@ LargeDataTable <- R6::R6Class(
     #'
     #' @return data.frame of all results. Used for large file downloads
     getAllResults = function(...) {
-      self$connectionHandler$queryDb(self$baseQuery, ...)
+      self$connectionHandler$queryDb(self$baseQuery, ..., snakeCaseToCamelCase = FALSE)
     }
   )
 )
 
+#' Create Large Sql Query Data Table
+#'
+#' @description
+#' Construct an instance of a LargeDataTable R6 instance for use inside largeTableServer
+#'
+#' This should pass a parameterized sql query that can be used to iteratively return data from a table
+#' rather than returning the entire object.
+#'
+#' @param connectionHandler         ResultModelManager connectionHandler instance
+#' @param baseQuery                 base sql query
+#' @param countQuery                count query string (should match query). Can be auto generated with sub query
+#'                                  (default) but this will likely result in slow results
+createLargeSqlQueryDt <- function(connectionHandler = NULL,
+                                  connectionDetails = NULL,
+                                  baseQuery,
+                                  countQuery = NULL) {
+  if (is.null(connectionHandler)) {
+    checkmate::assertClass(connectionDetails, "ConnectionDetails")
+  }
+
+  LargeDataTable$new(connectionHandler = connectionHandler,
+                     baseQuery = baseQuery,
+                     countQuery = countQuery)
+}
+
 #' Large Table Component Viewer
 #' @description
 #' Componenet for results sets with many thousands of rows
@@ -188,22 +206,35 @@ largeTableView <- function(id, pageSizeChoices = c(10,25,50,100), selectedPageSi
 #' @param inputParams   reactive that returns list of parameters to be passed to ldt
 #' @param modifyData    optional callback function that takes the data page, page number, page size as parameters
 #'                      must return data.frame compatable instance
+#'
+#' @param columns       List or reactable returning list of reactable::columnDef objects
+#' @param ...           Additional reactable options (searchable, sortable
 largeTableServer <- function(id,
                              ldt,
                              inputParams,
-                             modifyData = NULL) {
+                             modifyData = NULL,
+                             columns = shiny::reactive(list()),
+                             ...) {
   checkmate::assertR6(ldt, "LargeDataTable")
 
   if (!is.list(inputParams))
     checkmate::assertClass(inputParams, "reactive")
 
+  if (!is.list(columns))
+    checkmate::assertClass(columns, "reactive")
+
   shiny::moduleServer(id, function(input, output, session) {
 
     if (is.list(inputParams)) {
       realParams <- inputParams
       inputParams <- shiny::reactive(realParams)
     }
 
+    if (is.list(columns)) {
+      realColumns <- columns
+      columns <- shiny::reactive(realColumns)
+    }
+
     ns <- session$ns
     pageNum <- shiny::reactiveVal(1)
     pageSize <- shiny::reactive(as.integer(input$pageSize))
@@ -255,8 +286,10 @@ largeTableServer <- function(id,
     })
 
     output$tableView <- reactable::renderReactable({
+      cols <- columns()
+      checkmate::assertList(cols, null.ok = TRUE, types = "colDef")
       reactable::reactable(dataPage(),
-                           columns = ldt$getColumnDefs(),
+                           columns = cols,
                            searchable = FALSE,
                            sortable = FALSE,
                            resizable = TRUE,
@@ -265,7 +298,8 @@ largeTableServer <- function(id,
                            striped = TRUE,
                            highlight = TRUE,
                            defaultColDef = reactable::colDef(align = "left"),
-                           pagination = FALSE)
+                           pagination = FALSE,
+                           ...)
     })
 
     output$pageActionButtons <-  shiny::renderUI({

diff --git a/extras/examples/largeTable.R b/extras/examples/largeTable.R
@@ -9,11 +9,14 @@
 library(OhdsiShinyModules)
 library(shiny)
 
+if (FALSE)
+  RSQLite::rsqliteVersion()
+
 ui <- fluidPage(
 
-    # Application title
-    titlePanel("Big table example"),
-           largeTableView("tblView")
+  # Application title
+  titlePanel("Big table example"),
+  largeTableView("tblView")
 
 )
 ###--- Fill in connection details with a real db ---###
@@ -28,14 +31,16 @@ server <- function(input, output) {
   baseQuery <- "SELECT * FROM main.big_table WHERE row_id >= @min_row"
   countQuery <- "SELECT count(*) FROM main.big_table WHERE row_id >= @min_row"
 
-  ldt <- LargeDataTable$new(ch,
-                            baseQuery,
-                            countQuery = countQuery,
-                            columnDefs = list(
-                              "rowId" = reactable::colDef(name = "row id")
-                            ))
+  ldt <- createLargeSqlQueryDt(connectionHandler = connectionHandler,
+                               baseQuery = baseQuery,
+                               countQuery = countQuery)
 
-  largeTableServer("tblView", ldt, reactive(list(min_row = 1)))
+  largeTableServer(id = "tblView",
+                   ldt = ldt,
+                   inputParams =  reactive(list(min_row = 1)),
+                   columns = list(
+                     "rowId" = reactable::colDef(name = "row id")
+                   ))
 }
 
 # Run the application

diff --git a/man/LargeDataTable.Rd b/man/LargeDataTable.Rd
diff --git a/man/createLargeSqlQueryDt.Rd b/man/createLargeSqlQueryDt.Rd
diff --git a/man/largeTableServer.Rd b/man/largeTableServer.Rd
diff --git a/tests/testthat/test-components-largeTableViewer.R b/tests/testthat/test-components-largeTableViewer.R
@@ -11,7 +11,7 @@ test_that("Large Data Table R6 Class works", {
   query <- "SELECT * FROM main.big_table WHERE row_id >= @min_row"
   countQuery <- "SELECT count(*) FROM main.big_table WHERE row_id >= @min_row"
 
-  ldt <- LargeDataTable$new(ch, query, countQuery, columnDefs = list(row_id = reactable::colDef("row id")))
+  ldt <- LargeDataTable$new(ch, query, countQuery)
 
   checkmate::expect_r6(ldt, "LargeDataTable")
 
@@ -20,12 +20,11 @@ test_that("Large Data Table R6 Class works", {
   expect_equal(ldt$getCount(min_row = 1), bigData %>% nrow())
   checkmate::expect_data_frame(ldt$getPage(2, 10, min_row = 1))
   expect_equal(ldt$getPage(2, 10, min_row = 1) %>% nrow(), 10)
-  checkmate::expect_list(ldt$getColumnDefs())
   expect_error(LargeDataTable$new(ch, "SELECT 1; SELECT 2;"))
   expect_error(LargeDataTable$new(ch, query, "SELECT 1; SELECT 2;"))
-  expect_error(LargeDataTable$new(ch, query, columnDefs = list(1, 2, 3)))
+  expect_error(LargeDataTable$new(ch, query))
 
-  ldt2 <- LargeDataTable$new(ch, query, countQuery = NULL, columnDefs = list(row_id = reactable::colDef("row id")))
+  ldt2 <- LargeDataTable$new(ch, query, countQuery = NULL))
   checkmate::expect_string(ldt2$countQuery)
 
   checkmate::expect_class(largeTableView("foo"), "shiny.tag")
@@ -39,7 +38,8 @@ test_that("Large Data Table R6 Class works", {
       inputParams = list(min_row = 1),
       modifyData = function(df, pageNum, pageSize) {
         df %>% dplyr::mutate(fizzBuzz = ifelse(.data$rowId %% 3 == 0, "fizz", "buzz"))
-      }
+      },
+      columns = list(row_id = reactable::colDef("row id")
     ),
     expr = {