From 1271a34e59348f6fd7d3edd1ce94faf72e765fbe Mon Sep 17 00:00:00 2001 From: Jamie Gilbert Date: Thu, 6 Jul 2023 17:06:33 -0700 Subject: [PATCH 01/10] Started large table component - mostly working. TOODO: - Unit tests - Inclusion in modules (characterization and cohort diagnostics) - Download data functionality (implement promises callback?) - Make appearance as close to other tables as possible - Allow row selection callback - Allow as many customisable reactable options as possible (beyond search and filters which will not easily work) - Make more compatible with query namespeaces to automatically generate advanced column filters --- NAMESPACE | 3 + R/components-largeTableViewer.R | 197 ++++++++++++++++++++++++++++++++ extras/examples/largeTable.R | 42 +++++++ man/LargeDataTable.Rd | 186 ++++++++++++++++++++++++++++++ man/largeTableServer.Rd | 21 ++++ man/largeTableView.Rd | 18 +++ 6 files changed, 467 insertions(+) create mode 100644 R/components-largeTableViewer.R create mode 100644 extras/examples/largeTable.R create mode 100644 man/LargeDataTable.Rd create mode 100644 man/largeTableServer.Rd create mode 100644 man/largeTableView.Rd diff --git a/NAMESPACE b/NAMESPACE index f3f39ddd..0e262dee 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,6 @@ # Generated by roxygen2: do not edit by hand +export(LargeDataTable) export(aboutHelperFile) export(aboutServer) export(aboutViewer) @@ -76,6 +77,8 @@ export(getLogoImage) export(incidenceRatesView) export(inclusionRulesView) export(indexEventBreakdownView) +export(largeTableServer) +export(largeTableView) export(makeButtonLabel) export(orpahanConceptsView) export(phevaluatorHelperFile) diff --git a/R/components-largeTableViewer.R b/R/components-largeTableViewer.R new file mode 100644 index 00000000..46b4ec1d --- /dev/null +++ b/R/components-largeTableViewer.R @@ -0,0 +1,197 @@ +#' Large Data Table +#' @export +#' @description +#' Large data table R6 class. +#' +#' Uses ResultModelManager::ConnectionHandler class to create paginating tables +#' +#' NOTE Only currently works with sqlite and postgresql database backends (probably redshift too) +#' as this method uses limit and offset for the queries +#' +#' 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 +#' +#' @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 + #' @export + #' + #' @examples + initialize = function(connectionHandler, baseQuery, countQuery = NULL, columnDefs = list()) { + 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) + self$connectionHandler <- connectionHandler + self$baseQuery <- baseQuery + self$columnDefs <- columnDefs + + if (!is.null(countQuery)) { + self$countQuery <- countQuery + } else { + self$countQuery <- SqlRender::render("SELECT COUNT(*) as count FROM (@sub_query);", + sub_query = self$baseQuery) + } + + self + }, + + #' get column defs + #' + #' @return columnDefs + getColumnDefs = function() { + self$columnDefs + }, + + #' get count + #' @description + #' execute count query with specified parameters + #' @param ... + #' + #' @return count + getCount = function(...) { + sql <- SqlRender::render(sql = self$countQuery, ...) + count <- self$connectionHandler$queryDb(sql) + return(count$count) + }, + + #' Get Page + #' + #' @param pageNum page number + #' @param pageSize page size + #' @param ... + #' + #' @return data.frame of query result + getPage = function(pageNum, pageSize = self$pageSize, ...) { + mainQuery <- SqlRender::render(sql = self$baseQuery, ...) + + pageOffset <- ((pageNum - 1) * pageSize) + 1 + self$connectionHandler$queryDb("@main_query LIMIT @page_size OFFSET @page_offset", + main_query = mainQuery, + page_size = pageSize, + page_offset = pageOffset) + }, + + #' get all results + #' + #' @param ... + #' + #' @return data.frame of all results. Used for large file downloads + getAllResults = function(...) { + self$connectionHandler$queryDb(self$baseQuery, ...) + } + ) +) + +#' Large Table Component Viewer +#' @description +#' Componenet for results sets with many thousands of rows +#' More limited than other table components in terms of automatic handling of search and +#' filtering but will allow responsive apps +#' @export +#' +#' @param id Shiny module id. Must match largeTableServer +#' @param pageSizeChoices numeric selection options for pages +largeTableView <- function(id, pageSizeChoices = c(10,20,50,100)) { + ns <- shiny::NS(id) + checkmate::assertNumeric(pageSizeChoices) + shiny::div( + id = ns("display-table"), + shiny::fluidRow( + shiny::column( + width = 9 + ), + shiny::column( + width = 3, + shiny::selectInput(ns("pageSize"), choices = pageSizeChoices, label = "Page Size") + ) + ), + shinycssloaders::withSpinner(reactable::reactableOutput(ns("tableView"))), + shiny::fluidRow( + shiny::column( + width = 1, + shiny::actionButton(ns("previousButton"), label = "Previous") + ), + shiny::column( + width = 1, + shiny::actionButton(ns("nextButton"), label = "Next") + ), + shiny::column( + width = 3, + shiny::p(shiny::textOutput(ns("pageNumber"))) + ) + ) + ) +} + +#' Large Table Component Server +#' @description +#' Display large data tables in a consistent way - server side pagination for reactable objects +#' @export +#' @param id Shiny module id. Must match Large Table Viewer +#' @param ldt LargeDataTable instance +#' @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 +largeTableServer <- function(id, + ldt, + inputParams, + modifyData = NULL) { + checkmate::assertR6(ldt, "LargeDataTable") + checkmate::assertClass(inputParams, "reactive") + shiny::moduleServer(id, function(input, output, session) { + pageNum <- shiny::reactiveVal(1) + pageSize <- shiny::reactive(as.integer(input$pageSize)) + + pageCount <- shiny::reactive({ + count <- do.call(ldt$getCount, inputParams()) + ceiling(count/pageSize()) + }) + + shiny::observeEvent(input$nextButton, pageNum(min(pageNum() + 1, pageCount()))) + shiny::observeEvent(input$previousButton, pageNum(max(pageNum() - 1, 1))) + # Reset page on page size change + shiny::observeEvent(input$pageSize, { pageNum(1) }) + + output$pageNumber <- shiny::renderText(paste("Page", pageNum(), "of", format(pageCount(), big.mark = ","))) + + output$tableView <- reactable::renderReactable({ + params <- inputParams() + checkmate::assertList(params) + params$pageNum <- pageNum() + params$pageSize <- pageSize() + + dataPage <- do.call(ldt$getPage, params) + + if (is.function(modifyData)) { + dataPage <- dataPage %>% modifyData(pageNum(), pageSize()) + } + + reactable::reactable(dataPage, + columns = ldt$getColumnDefs(), + searchable = FALSE, + sortable = FALSE, + pagination = FALSE) + }) + }) +} \ No newline at end of file diff --git a/extras/examples/largeTable.R b/extras/examples/largeTable.R new file mode 100644 index 00000000..66c47366 --- /dev/null +++ b/extras/examples/largeTable.R @@ -0,0 +1,42 @@ +# +# This is a Shiny web application. You can run the application by clicking +# the 'Run App' button above. +# +# Find out more about building applications with Shiny here: +# +# http://shiny.rstudio.com/ +# +library(OhdisShinyModules) +library(shiny) + +ui <- fluidPage( + + # Application title + titlePanel("Big table example"), + largeTableView("tblView") + +) +###--- Fill in connection details with a real db ---### +connectionDetails <- DatabaseConnector::createConnectionDetails() + +ch <- ResultModelManager::ConnectionHandler$new(connectionDetails = connectionDetails) +# Define server logic required to draw a histogram +server <- function(input, output) { + # Set to schema you are using + testSchema <- "ase_004" + + baseQuery <- "SELECT * FROM @test_schema.cd_temporal_covariate_value" + countQuery <- "SELECT count(*) as count FROM @test_schema.cd_temporal_covariate_value" + + ldt <- LargeDataTable$new(ch, + baseQuery, + countQuery = countQuery, + columnDefs = list( + "cohortId" = reactable::colDef(name = "cohort id") + )) + + largeTableServer("tblView", ldt, reactive(list(test_schema = testSchema))) +} + +# Run the application +shinyApp(ui = ui, server = server) diff --git a/man/LargeDataTable.Rd b/man/LargeDataTable.Rd new file mode 100644 index 00000000..25da8e9b --- /dev/null +++ b/man/LargeDataTable.Rd @@ -0,0 +1,186 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/components-largeTableViewer.R +\name{LargeDataTable} +\alias{LargeDataTable} +\title{Large Data Table} +\description{ +Large data table R6 class. + +Uses ResultModelManager::ConnectionHandler class to create paginating tables + +NOTE Only currently works with sqlite and postgresql database backends (probably redshift too) +as this method uses limit and offset for the queries + +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 +} +\examples{ + +## ------------------------------------------------ +## Method `LargeDataTable$new` +## ------------------------------------------------ + +get column defs + +} +\section{Public fields}{ +\if{html}{\out{
}} +\describe{ +\item{\code{baseQuery}}{query string sql} + +\item{\code{countQuery}}{count query string (should match query). Can be auto generated with sub query (default) but +this will likely result in slow results} + +\item{\code{columnDefs}}{reactable Coulmn definitions} + +\item{\code{connectionHandler}}{ResultModelManager connection handler to execute query inside +initialize} +} +\if{html}{\out{
}} +} +\section{Methods}{ +\subsection{Public methods}{ +\itemize{ +\item \href{#method-LargeDataTable-new}{\code{LargeDataTable$new()}} +\item \href{#method-LargeDataTable-getColumnDefs}{\code{LargeDataTable$getColumnDefs()}} +\item \href{#method-LargeDataTable-getCount}{\code{LargeDataTable$getCount()}} +\item \href{#method-LargeDataTable-getPage}{\code{LargeDataTable$getPage()}} +\item \href{#method-LargeDataTable-getAllResults}{\code{LargeDataTable$getAllResults()}} +\item \href{#method-LargeDataTable-clone}{\code{LargeDataTable$clone()}} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-LargeDataTable-new}{}}} +\subsection{Method \code{new()}}{ +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{LargeDataTable$new( + connectionHandler, + baseQuery, + countQuery = NULL, + columnDefs = list() +)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{connectionHandler}}{ResultModelManager connectionHandler instance} + +\item{\code{baseQuery}}{base sql query} + +\item{\code{countQuery}}{count query string (should match query). Can be auto generated with sub query +(default) but this will likely result in slow results} + +\item{\code{columnDefs}}{list of} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +self +} +\subsection{Examples}{ +\if{html}{\out{
}} +\preformatted{get column defs + +} +\if{html}{\out{
}} + +} + +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-LargeDataTable-getColumnDefs}{}}} +\subsection{Method \code{getColumnDefs()}}{ +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{LargeDataTable$getColumnDefs()}\if{html}{\out{
}} +} + +\subsection{Returns}{ +columnDefs +get count +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-LargeDataTable-getCount}{}}} +\subsection{Method \code{getCount()}}{ +execute count query with specified parameters +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{LargeDataTable$getCount(...)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{...}}{} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +count +Get Page +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-LargeDataTable-getPage}{}}} +\subsection{Method \code{getPage()}}{ +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{LargeDataTable$getPage(pageNum, pageSize = self$pageSize, ...)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{pageNum}}{page number} + +\item{\code{pageSize}}{page size} + +\item{\code{...}}{} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +data.frame of query result +get all results +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-LargeDataTable-getAllResults}{}}} +\subsection{Method \code{getAllResults()}}{ +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{LargeDataTable$getAllResults(...)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{...}}{} +} +\if{html}{\out{
}} +} +\subsection{Returns}{ +data.frame of all results. Used for large file downloads +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-LargeDataTable-clone}{}}} +\subsection{Method \code{clone()}}{ +The objects of this class are cloneable with this method. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{LargeDataTable$clone(deep = FALSE)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{deep}}{Whether to make a deep clone.} +} +\if{html}{\out{
}} +} +} +} diff --git a/man/largeTableServer.Rd b/man/largeTableServer.Rd new file mode 100644 index 00000000..5b923f27 --- /dev/null +++ b/man/largeTableServer.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/components-largeTableViewer.R +\name{largeTableServer} +\alias{largeTableServer} +\title{Large Table Component Server} +\usage{ +largeTableServer(id, ldt, inputParams, modifyData = NULL) +} +\arguments{ +\item{id}{Shiny module id. Must match Large Table Viewer} + +\item{ldt}{LargeDataTable instance} + +\item{inputParams}{reactive that returns list of parameters to be passed to ldt} + +\item{modifyData}{optional callback function that takes the data page, page number, page size as parameters +must return data.frame compatable instance} +} +\description{ +Display large data tables in a consistent way - server side pagination for reactable objects +} diff --git a/man/largeTableView.Rd b/man/largeTableView.Rd new file mode 100644 index 00000000..e850a608 --- /dev/null +++ b/man/largeTableView.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/components-largeTableViewer.R +\name{largeTableView} +\alias{largeTableView} +\title{Large Table Component Viewer} +\usage{ +largeTableView(id, pageSizeChoices = c(10, 20, 50, 100)) +} +\arguments{ +\item{id}{Shiny module id. Must match largeTableServer} + +\item{pageSizeChoices}{numeric selection options for pages} +} +\description{ +Componenet for results sets with many thousands of rows +More limited than other table components in terms of automatic handling of search and +filtering but will allow responsive apps +} From aa45ca6d17b6a489278d678ae22c25e89e5f5331 Mon Sep 17 00:00:00 2001 From: Jamie Gilbert Date: Fri, 7 Jul 2023 13:28:35 -0700 Subject: [PATCH 02/10] Tests and fully operational tables --- R/components-largeTableViewer.R | 147 ++++++++++++++---- extras/examples/largeTable.R | 20 +-- testApp.R | 51 ++++++ .../test-components-largeTableViewer.R | 74 +++++++++ 4 files changed, 253 insertions(+), 39 deletions(-) create mode 100644 testApp.R create mode 100644 tests/testthat/test-components-largeTableViewer.R diff --git a/R/components-largeTableViewer.R b/R/components-largeTableViewer.R index 46b4ec1d..82abf529 100644 --- a/R/components-largeTableViewer.R +++ b/R/components-largeTableViewer.R @@ -41,19 +41,17 @@ LargeDataTable <- R6::R6Class( 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) + 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) self$countQuery <- countQuery } else { - self$countQuery <- SqlRender::render("SELECT COUNT(*) as count FROM (@sub_query);", - sub_query = self$baseQuery) + self$countQuery <- SqlRender::render("SELECT COUNT(*) as count FROM (@sub_query);", sub_query = self$baseQuery) } - - self }, #' get column defs @@ -85,7 +83,7 @@ LargeDataTable <- R6::R6Class( getPage = function(pageNum, pageSize = self$pageSize, ...) { mainQuery <- SqlRender::render(sql = self$baseQuery, ...) - pageOffset <- ((pageNum - 1) * pageSize) + 1 + pageOffset <- ((pageNum - 1) * pageSize) self$connectionHandler$queryDb("@main_query LIMIT @page_size OFFSET @page_offset", main_query = mainQuery, page_size = pageSize, @@ -112,33 +110,51 @@ LargeDataTable <- R6::R6Class( #' #' @param id Shiny module id. Must match largeTableServer #' @param pageSizeChoices numeric selection options for pages -largeTableView <- function(id, pageSizeChoices = c(10,20,50,100)) { +#' @param selectedPageSize numeric selection options for pages +#' @param fullDownloads allow download button of full dataset from query +largeTableView <- function(id, pageSizeChoices = c(10,25,50,100), selectedPageSize = 10, fullDownloads = TRUE) { ns <- shiny::NS(id) - checkmate::assertNumeric(pageSizeChoices) + checkmate::assertNumeric(pageSizeChoices, min.len = 1, finite = TRUE, lower = 1) + checkmate::assertTRUE(selectedPageSize %in% pageSizeChoices) + + inlineStyle <- ".inline-tv label{ display: table-cell; text-align: center; vertical-align: middle; padding-right: 1em; } + .inline-tv .selectize-input { min-width:70px;} + .inline-tv .form-group { display: table-row;}" + shiny::div( id = ns("display-table"), - shiny::fluidRow( - shiny::column( - width = 9 - ), - shiny::column( - width = 3, - shiny::selectInput(ns("pageSize"), choices = pageSizeChoices, label = "Page Size") - ) + shiny::tags$head( + shiny::tags$style(type = "text/css", inlineStyle) ), + shiny::fluidRow( + if (fullDownloads) { + shiny::column( + width = 4, + shiny::downloadButton(ns("downloadFull"), + label = "Download (Full)", + icon = shiny::icon("download")) + ) + } + ), shinycssloaders::withSpinner(reactable::reactableOutput(ns("tableView"))), shiny::fluidRow( shiny::column( - width = 1, - shiny::actionButton(ns("previousButton"), label = "Previous") + width = 4, + class = "inline-tv", + shiny::textOutput(ns("pageNumber")), + shiny::selectInput(ns("pageSize"), + choices = pageSizeChoices, + selected = selectedPageSize, + label = "show", + width = "90px") ), shiny::column( - width = 1, - shiny::actionButton(ns("nextButton"), label = "Next") + width = 2 ), shiny::column( - width = 3, - shiny::p(shiny::textOutput(ns("pageNumber"))) + width = 6, + style = "text-align:right;", + shiny::uiOutput(ns("pageActionButtons")) ) ) ) @@ -158,24 +174,46 @@ largeTableServer <- function(id, inputParams, modifyData = NULL) { checkmate::assertR6(ldt, "LargeDataTable") - checkmate::assertClass(inputParams, "reactive") + + if (!is.list(inputParams)) + checkmate::assertClass(inputParams, "reactive") + shiny::moduleServer(id, function(input, output, session) { + + if (is.list(inputParams)) { + realParams <- inputParams + inputParams <- shiny::reactive(realParams) + } + + ns <- session$ns pageNum <- shiny::reactiveVal(1) pageSize <- shiny::reactive(as.integer(input$pageSize)) + rowCount <- shiny::reactive({ + do.call(ldt$getCount, inputParams()) + }) + pageCount <- shiny::reactive({ - count <- do.call(ldt$getCount, inputParams()) - ceiling(count/pageSize()) + ceiling(rowCount()/pageSize()) }) - shiny::observeEvent(input$nextButton, pageNum(min(pageNum() + 1, pageCount()))) + shiny::observeEvent(input$nextButton, pageNum(min(pageNum() + 1, rowCount()))) shiny::observeEvent(input$previousButton, pageNum(max(pageNum() - 1, 1))) + + shiny::observeEvent(input$pageNum, pageNum(input$pageNum)) + # Reset page on page size change shiny::observeEvent(input$pageSize, { pageNum(1) }) - output$pageNumber <- shiny::renderText(paste("Page", pageNum(), "of", format(pageCount(), big.mark = ","))) + output$pageNumber <- shiny::renderText({ - output$tableView <- reactable::renderReactable({ + minNum <- format(((pageNum() - 1) * pageSize()) + 1, big.mark = ",", scientific = FALSE) + maxNum <- format((pageNum() - 1) * pageSize() + pageSize(), big.mark = ",", scientific = FALSE) + rc <- format(rowCount(), big.mark = ",", scientific = FALSE) + paste(minNum, "-", maxNum, "of", rc, "rows") + }) + + dataPage <- shiny::reactive({ params <- inputParams() checkmate::assertList(params) params$pageNum <- pageNum() @@ -186,12 +224,63 @@ largeTableServer <- function(id, if (is.function(modifyData)) { dataPage <- dataPage %>% modifyData(pageNum(), pageSize()) } + dataPage + }) - reactable::reactable(dataPage, + output$tableView <- reactable::renderReactable({ + reactable::reactable(dataPage(), columns = ldt$getColumnDefs(), searchable = FALSE, sortable = FALSE, + resizable = TRUE, + outlined = TRUE, + showSortIcon = TRUE, + striped = TRUE, + highlight = TRUE, + defaultColDef = reactable::colDef(align = "left"), pagination = FALSE) }) + + output$pageActionButtons <- shiny::renderUI({ + pc <- pageCount() + if (pc == 1) { + return(shiny::span(style="width:80px;", shiny::HTML(" "))) + } + + createPageLink <- function(pageLink) { + js <- sprintf("Shiny.setInputValue('%s', %s);", ns("pageNum"), pageLink) + shiny::tags$a(onclick = js, style = "cursor:pointer;", format(pageLink, big.mark = ",", scientific = FALSE)) + } + + linkNums <- unique(c(1, max(2, pageNum() - 2):min(pageCount() - 1, pageNum() + 3))) + links <- lapply(linkNums, createPageLink) + + ## render action buttons + # Always show 1 + # Show row up to 5 + # Always show max + shiny::tagList( + shiny::actionLink(ns("previousButton"), label = "Previous"), + links, + if (pageCount() != pageNum()) { + shiny::span("...") + }, + createPageLink(pageCount()), + shiny::actionLink(ns("nextButton"), label = "Next") + ) + }) + + output$downloadFull <- shiny::downloadHandler( + filename = function() { + paste0('result-data-full-', id, Sys.Date(), '.csv') + }, + content = function(con) { + shiny::withProgress( + message = "preparing download", + value = 15, + readr::write_csv(do.call(ldt$getAllResults, inputParams()), con) + ) + } + ) }) } \ No newline at end of file diff --git a/extras/examples/largeTable.R b/extras/examples/largeTable.R index 66c47366..18025785 100644 --- a/extras/examples/largeTable.R +++ b/extras/examples/largeTable.R @@ -6,7 +6,7 @@ # # http://shiny.rstudio.com/ # -library(OhdisShinyModules) +devtools::load_all() library(shiny) ui <- fluidPage( @@ -17,25 +17,25 @@ ui <- fluidPage( ) ###--- Fill in connection details with a real db ---### -connectionDetails <- DatabaseConnector::createConnectionDetails() +connectionDetails <- DatabaseConnector::createConnectionDetails(dbms = "sqlite", server = ":memory:") +ch <- ResultModelManager::ConnectionHandler$new(connectionDetails) +# 1 million random rows +bigData <- data.frame(row_id = 1:1e6, value = stats::runif(1e6)) +DatabaseConnector::insertTable(ch$getConnection(), data = bigData, tableName = "big_table") -ch <- ResultModelManager::ConnectionHandler$new(connectionDetails = connectionDetails) -# Define server logic required to draw a histogram server <- function(input, output) { - # Set to schema you are using - testSchema <- "ase_004" - baseQuery <- "SELECT * FROM @test_schema.cd_temporal_covariate_value" - countQuery <- "SELECT count(*) as count FROM @test_schema.cd_temporal_covariate_value" + 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( - "cohortId" = reactable::colDef(name = "cohort id") + "rowId" = reactable::colDef(name = "row id") )) - largeTableServer("tblView", ldt, reactive(list(test_schema = testSchema))) + largeTableServer("tblView", ldt, reactive(list(min_row = 1))) } # Run the application diff --git a/testApp.R b/testApp.R new file mode 100644 index 00000000..ae496baf --- /dev/null +++ b/testApp.R @@ -0,0 +1,51 @@ +devtools::load_all() + +config <- ShinyAppBuilder::initializeModuleConfig() |> + + # about module + ShinyAppBuilder::addModuleConfig( + ShinyAppBuilder::createDefaultAboutConfig(useKeyring = F, + resultDatabaseDetails = list()) + ) |> + + # cohort generator module + ShinyAppBuilder::addModuleConfig( + ShinyAppBuilder::createDefaultCohortGeneratorConfig(useKeyring = F, + resultDatabaseDetails = list(dbms = "postgresql", dbms = "postgresql", + tablePrefix = "cg_", + cohortTablePrefix = "cg_", + databaseTablePrefix = "cg_", + incidenceTablePrefix = "ci_", + schema = "epi_1025")) + ) |> + + # cohort diagnostics module + ShinyAppBuilder::addModuleConfig( + ShinyAppBuilder::createDefaultCohortDiagnosticsConfig(useKeyring = TRUE, + resultDatabaseDetails = list(dbms = "postgresql", + tablePrefix = "cd_", + vocabularyDatabaseSchema = "epi_1025", + schema = "epi_1025")) + ) |> + + # cohort characterization module + ShinyAppBuilder::addModuleConfig( + ShinyAppBuilder::createDefaultCharacterizationConfig(useKeyring = F, + resultDatabaseDetails = list(dbms = "postgresql", + tablePrefix = "c_", + cohortTablePrefix = "cg_", + databaseTablePrefix = "cd", + schema = "epi_1025", + databaseTable = "database_meta_data", + incidenceTablePrefix = "ci_")) + ) + + +connectionDetails <- DatabaseConnector::createConnectionDetails(dbms = "postgresql", + server = "reward.cterqq54xyuu.us-east-1.rds.amazonaws.com/strategus_test", + user = "reward_user", + password = "4GAnEA~m6-Hk", + port = 5432) + +connection <- ResultModelManager::ConnectionHandler$new(connectionDetails) +ShinyAppBuilder::viewShiny(config, connection) diff --git a/tests/testthat/test-components-largeTableViewer.R b/tests/testthat/test-components-largeTableViewer.R new file mode 100644 index 00000000..4d30d74c --- /dev/null +++ b/tests/testthat/test-components-largeTableViewer.R @@ -0,0 +1,74 @@ +# Create Tables +test_that("Large Data Table R6 Class works", { + # Create connection handler + cdTest <- DatabaseConnector::createConnectionDetails(dbms = "sqlite", server = ":memory:") + ch <- ResultModelManager::ConnectionHandler$new(cdTest) + on.exit(ch$finalize()) + # 1 million random rows + bigData <- data.frame(row_id = 1:1e6, value = stats::runif(1e6)) + DatabaseConnector::insertTable(ch$getConnection(), data = bigData, tableName = "big_table") + + 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"))) + + checkmate::expect_r6(ldt, "LargeDataTable") + + expect_equal(ldt$getAllResults(min_row = 1) %>% nrow(), bigData %>% nrow()) + expect_equal(ldt$getCount(min_row = 2), bigData %>% nrow() - 1) + 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))) + + ldt2 <- LargeDataTable$new(ch, query, countQuery = NULL, columnDefs = list(row_id = reactable::colDef("row id"))) + checkmate::expect_string(ldt2$countQuery) + + checkmate::expect_class(largeTableView("foo"), "shiny.tag") + checkmate::expect_class(largeTableView("foo", fullDownloads = FALSE), "shiny.tag") + + shiny::testServer( + app = largeTableServer, + args = list( + id = "foo", + ldt = ldt, + inputParams = list(min_row = 1), + modifyData = function(df, pageNum, pageSize) { + df %>% dplyr::mutate(fizzBuzz = ifelse(.data$rowId %% 3 == 0, "fizz", "buzz")) + } + ), + expr = { + + session$setInputs(pageSize = 10) + + expect_equal(rowCount(), ldt$getCount(min_row = 1)) + expect_equal(pageNum(), 1) + expect_equal(pageCount(), ceiling(ldt$getCount(min_row = 1) / 10)) + + + session$setInputs(pageSize = 100) + expect_equal(pageNum(), 1) + expect_equal(pageCount(), ceiling(ldt$getCount(min_row = 1) / 100)) + + session$setInputs(pageNum = 5) + expect_equal(pageNum(), 5) + expect_equal(output$pageNumber, "401 - 500 of 1,000,000 rows") + + checkmate::expect_data_frame(dataPage(), nrow = 100, ncols = 3) + checkmate::expect_names(colnames(dataPage()), must.include = c("rowId", "value", "fizzBuzz")) + expect_true(all(dataPage()$fizzBuzz == ifelse(dataPage()$rowId %% 3 == 0, "fizz", "buzz"))) + + checkmate::expect_class(output$tableView, "json") + checkmate::expect_class(output$pageActionButtons , "list") + + session$setInputs(pageSize = 1e6) + expect_equal(pageCount(), 1) + checkmate::expect_class(output$pageActionButtons , "list") + checkmate::expect_file_exists(output$downloadFull) + } + ) +}) \ No newline at end of file From b821fb2c2a469324e2bdb9c537f62d01a81ca3c1 Mon Sep 17 00:00:00 2001 From: Jamie Gilbert Date: Fri, 7 Jul 2023 13:29:06 -0700 Subject: [PATCH 03/10] docs --- man/largeTableView.Rd | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/man/largeTableView.Rd b/man/largeTableView.Rd index e850a608..247b5c0b 100644 --- a/man/largeTableView.Rd +++ b/man/largeTableView.Rd @@ -4,12 +4,21 @@ \alias{largeTableView} \title{Large Table Component Viewer} \usage{ -largeTableView(id, pageSizeChoices = c(10, 20, 50, 100)) +largeTableView( + id, + pageSizeChoices = c(10, 25, 50, 100), + selectedPageSize = 10, + fullDownloads = TRUE +) } \arguments{ \item{id}{Shiny module id. Must match largeTableServer} \item{pageSizeChoices}{numeric selection options for pages} + +\item{selectedPageSize}{numeric selection options for pages} + +\item{fullDownloads}{allow download button of full dataset from query} } \description{ Componenet for results sets with many thousands of rows From d4391bb72abb338e7ccafd59a061438293d632db Mon Sep 17 00:00:00 2001 From: Jamie Gilbert Date: Fri, 7 Jul 2023 13:30:56 -0700 Subject: [PATCH 04/10] example fixed --- extras/examples/largeTable.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extras/examples/largeTable.R b/extras/examples/largeTable.R index 18025785..82bfc8ca 100644 --- a/extras/examples/largeTable.R +++ b/extras/examples/largeTable.R @@ -6,7 +6,7 @@ # # http://shiny.rstudio.com/ # -devtools::load_all() +library(OhdisShinyModules) library(shiny) ui <- fluidPage( From eac448e0235a8ebe9bd53664b5fbbe4436803514 Mon Sep 17 00:00:00 2001 From: Jamie Gilbert Date: Fri, 7 Jul 2023 13:40:28 -0700 Subject: [PATCH 05/10] example fixed --- extras/examples/largeTable.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extras/examples/largeTable.R b/extras/examples/largeTable.R index 82bfc8ca..f2f7a2e8 100644 --- a/extras/examples/largeTable.R +++ b/extras/examples/largeTable.R @@ -6,7 +6,7 @@ # # http://shiny.rstudio.com/ # -library(OhdisShinyModules) +library(OhdsiShinyModules) library(shiny) ui <- fluidPage( From 6dd8d98d51a75ed2a20ed6b34d04109c2fb4605a Mon Sep 17 00:00:00 2001 From: Jamie Gilbert Date: Tue, 11 Jul 2023 16:14:25 -0700 Subject: [PATCH 06/10] Changes to appearance --- R/components-largeTableViewer.R | 37 +++++++++++++++++++++++---------- man/LargeDataTable.Rd | 21 +++---------------- 2 files changed, 29 insertions(+), 29 deletions(-) diff --git a/R/components-largeTableViewer.R b/R/components-largeTableViewer.R index 82abf529..1d3edaa0 100644 --- a/R/components-largeTableViewer.R +++ b/R/components-largeTableViewer.R @@ -32,9 +32,6 @@ LargeDataTable <- R6::R6Class( #' @param columnDefs list of #' #' @return self - #' @export - #' - #' @examples initialize = function(connectionHandler, baseQuery, countQuery = NULL, columnDefs = list()) { checkmate::assertR6(connectionHandler, "ConnectionHandler") checkmate::assertString(baseQuery) @@ -54,8 +51,7 @@ LargeDataTable <- R6::R6Class( } }, - #' get column defs - #' + #' @title get column defs #' @return columnDefs getColumnDefs = function() { self$columnDefs @@ -119,7 +115,20 @@ largeTableView <- function(id, pageSizeChoices = c(10,25,50,100), selectedPageSi inlineStyle <- ".inline-tv label{ display: table-cell; text-align: center; vertical-align: middle; padding-right: 1em; } .inline-tv .selectize-input { min-width:70px;} - .inline-tv .form-group { display: table-row;}" + .inline-tv .form-group { display: table-row;} + + .link-bt { + background-color: transparent; + border: none; + border-radius: 3px; + cursor: pointer; + outline-style: solid; + outline-width: 0; + padding: 6px 12px; + text-decoration:none; + } + + " shiny::div( id = ns("display-table"), @@ -249,10 +258,12 @@ largeTableServer <- function(id, createPageLink <- function(pageLink) { js <- sprintf("Shiny.setInputValue('%s', %s);", ns("pageNum"), pageLink) - shiny::tags$a(onclick = js, style = "cursor:pointer;", format(pageLink, big.mark = ",", scientific = FALSE)) + shiny::tags$a(onclick = js, + class = "link-bt", + style = "cursor:pointer;", format(pageLink, big.mark = ",", scientific = FALSE)) } - linkNums <- unique(c(1, max(2, pageNum() - 2):min(pageCount() - 1, pageNum() + 3))) + linkNums <- unique(c(max(2, pageNum() - 2):min(pageCount() - 1, pageNum() + 3))) links <- lapply(linkNums, createPageLink) ## render action buttons @@ -260,13 +271,17 @@ largeTableServer <- function(id, # Show row up to 5 # Always show max shiny::tagList( - shiny::actionLink(ns("previousButton"), label = "Previous"), + shiny::actionLink(ns("previousButton"), label = "Previous", class = "link-bt"), + createPageLink(1), + if (!pageNum() %in% c(1, 2)) { + shiny::span("...", class = "link-bt") + }, links, if (pageCount() != pageNum()) { - shiny::span("...") + shiny::span("...", class = "link-bt") }, createPageLink(pageCount()), - shiny::actionLink(ns("nextButton"), label = "Next") + shiny::actionLink(ns("nextButton"), label = "Next", class = "link-bt") ) }) diff --git a/man/LargeDataTable.Rd b/man/LargeDataTable.Rd index 25da8e9b..f3975eea 100644 --- a/man/LargeDataTable.Rd +++ b/man/LargeDataTable.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/components-largeTableViewer.R \name{LargeDataTable} \alias{LargeDataTable} -\title{Large Data Table} +\title{get column defs} \description{ Large data table R6 class. @@ -14,14 +14,8 @@ as this method uses limit and offset for the queries 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 } -\examples{ - -## ------------------------------------------------ -## Method `LargeDataTable$new` -## ------------------------------------------------ - -get column defs - +\details{ +Large Data Table } \section{Public fields}{ \if{html}{\out{
}} @@ -79,15 +73,6 @@ initialize} \subsection{Returns}{ self } -\subsection{Examples}{ -\if{html}{\out{
}} -\preformatted{get column defs - -} -\if{html}{\out{
}} - -} - } \if{html}{\out{
}} \if{html}{\out{}} From 444aef4a709af528fb903cb3acaf67809f6b3b52 Mon Sep 17 00:00:00 2001 From: Jamie Gilbert Date: Thu, 13 Jul 2023 14:26:30 -0700 Subject: [PATCH 07/10] Minor fixes for appearance --- R/components-largeTableViewer.R | 63 +++++++++++++++++++++------------ 1 file changed, 41 insertions(+), 22 deletions(-) diff --git a/R/components-largeTableViewer.R b/R/components-largeTableViewer.R index 1d3edaa0..2d5241f0 100644 --- a/R/components-largeTableViewer.R +++ b/R/components-largeTableViewer.R @@ -113,22 +113,32 @@ largeTableView <- function(id, pageSizeChoices = c(10,25,50,100), selectedPageSi checkmate::assertNumeric(pageSizeChoices, min.len = 1, finite = TRUE, lower = 1) checkmate::assertTRUE(selectedPageSize %in% pageSizeChoices) - inlineStyle <- ".inline-tv label{ display: table-cell; text-align: center; vertical-align: middle; padding-right: 1em; } - .inline-tv .selectize-input { min-width:70px;} - .inline-tv .form-group { display: table-row;} - - .link-bt { - background-color: transparent; - border: none; - border-radius: 3px; - cursor: pointer; - outline-style: solid; - outline-width: 0; - padding: 6px 12px; - text-decoration:none; - } - - " + inlineStyle <- " + .inline-tv label{ display: table-cell; text-align: center; vertical-align: middle; padding-right: 1em; } + .inline-tv .selectize-input { min-width:70px;} + .inline-tv .form-group { display: table-row;} + + .pagination-buttons { + margin-top: 1em; + } + + .link-bt { + background-color: transparent; + border: none; + border-radius: 3px; + cursor: pointer; + outline-style: solid; + outline-width: 0; + padding: 6px 12px; + text-decoration:none; + } + .link-bt:hover{ + background-color: #eee; + } + .pagination-buttons a { + text-decoration:none; + color: #000!important; + }" shiny::div( id = ns("display-table"), @@ -203,7 +213,7 @@ largeTableServer <- function(id, }) pageCount <- shiny::reactive({ - ceiling(rowCount()/pageSize()) + max(1, ceiling(rowCount()/pageSize())) }) shiny::observeEvent(input$nextButton, pageNum(min(pageNum() + 1, rowCount()))) @@ -211,15 +221,23 @@ largeTableServer <- function(id, shiny::observeEvent(input$pageNum, pageNum(input$pageNum)) - # Reset page on page size change + # Reset page on page size change or any input variable that could impact row count + shiny::observe({ + inputParams() + pageNum(1) + }) shiny::observeEvent(input$pageSize, { pageNum(1) }) output$pageNumber <- shiny::renderText({ + rc <- format(rowCount(), big.mark = ",", scientific = FALSE) + if (pageCount() < 2) { + return(paste(rc, "rows")) + } + minNum <- format(((pageNum() - 1) * pageSize()) + 1, big.mark = ",", scientific = FALSE) maxNum <- format((pageNum() - 1) * pageSize() + pageSize(), big.mark = ",", scientific = FALSE) - rc <- format(rowCount(), big.mark = ",", scientific = FALSE) - paste(minNum, "-", maxNum, "of", rc, "rows") + return(paste(minNum, "-", maxNum, "of", rc, "rows")) }) dataPage <- shiny::reactive({ @@ -252,7 +270,7 @@ largeTableServer <- function(id, output$pageActionButtons <- shiny::renderUI({ pc <- pageCount() - if (pc == 1) { + if (pc < 2) { return(shiny::span(style="width:80px;", shiny::HTML(" "))) } @@ -270,7 +288,8 @@ largeTableServer <- function(id, # Always show 1 # Show row up to 5 # Always show max - shiny::tagList( + shiny::div( + class = "pagination-buttons", shiny::actionLink(ns("previousButton"), label = "Previous", class = "link-bt"), createPageLink(1), if (!pageNum() %in% c(1, 2)) { From e8cca012dffe3d9ef63f433c0fdea27bea94a013 Mon Sep 17 00:00:00 2001 From: Jamie Gilbert Date: Thu, 13 Jul 2023 16:08:56 -0700 Subject: [PATCH 08/10] Columns now parameter to compnenent not data object, convenient creation function for ldts --- R/components-largeTableViewer.R | 66 ++++++++++++++----- extras/examples/largeTable.R | 25 ++++--- man/LargeDataTable.Rd | 33 ++-------- man/createLargeSqlQueryDt.Rd | 27 ++++++++ man/largeTableServer.Rd | 13 +++- .../test-components-largeTableViewer.R | 10 +-- 6 files changed, 115 insertions(+), 59 deletions(-) create mode 100644 man/createLargeSqlQueryDt.Rd diff --git a/R/components-largeTableViewer.R b/R/components-largeTableViewer.R index 2d5241f0..5e0d60ee 100644 --- a/R/components-largeTableViewer.R +++ b/R/components-largeTableViewer.R @@ -11,10 +11,13 @@ #' 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", @@ -22,26 +25,22 @@ LargeDataTable <- R6::R6Class( 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,15 +206,23 @@ 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)) { @@ -204,6 +230,11 @@ largeTableServer <- function(id, 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 index f2f7a2e8..21fb5639 100644 --- 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 index f3975eea..10a9d869 100644 --- a/man/LargeDataTable.Rd +++ b/man/LargeDataTable.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/components-largeTableViewer.R \name{LargeDataTable} \alias{LargeDataTable} -\title{get column defs} +\title{Large Data Table} \description{ Large data table R6 class. @@ -13,9 +13,10 @@ as this method uses limit and offset for the queries 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 -} -\details{ -Large Data Table + +If subclassing use inheritance and treat this class as an interface to implement - implementing the methods: + + get } \section{Public fields}{ \if{html}{\out{
}} @@ -25,8 +26,6 @@ Large Data Table \item{\code{countQuery}}{count query string (should match query). Can be auto generated with sub query (default) but this will likely result in slow results} -\item{\code{columnDefs}}{reactable Coulmn definitions} - \item{\code{connectionHandler}}{ResultModelManager connection handler to execute query inside initialize} } @@ -36,7 +35,6 @@ initialize} \subsection{Public methods}{ \itemize{ \item \href{#method-LargeDataTable-new}{\code{LargeDataTable$new()}} -\item \href{#method-LargeDataTable-getColumnDefs}{\code{LargeDataTable$getColumnDefs()}} \item \href{#method-LargeDataTable-getCount}{\code{LargeDataTable$getCount()}} \item \href{#method-LargeDataTable-getPage}{\code{LargeDataTable$getPage()}} \item \href{#method-LargeDataTable-getAllResults}{\code{LargeDataTable$getAllResults()}} @@ -48,12 +46,7 @@ initialize} \if{latex}{\out{\hypertarget{method-LargeDataTable-new}{}}} \subsection{Method \code{new()}}{ \subsection{Usage}{ -\if{html}{\out{
}}\preformatted{LargeDataTable$new( - connectionHandler, - baseQuery, - countQuery = NULL, - columnDefs = list() -)}\if{html}{\out{
}} +\if{html}{\out{
}}\preformatted{LargeDataTable$new(connectionHandler, baseQuery, countQuery = NULL)}\if{html}{\out{
}} } \subsection{Arguments}{ @@ -65,25 +58,11 @@ initialize} \item{\code{countQuery}}{count query string (should match query). Can be auto generated with sub query (default) but this will likely result in slow results} - -\item{\code{columnDefs}}{list of} } \if{html}{\out{
}} } \subsection{Returns}{ self -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-LargeDataTable-getColumnDefs}{}}} -\subsection{Method \code{getColumnDefs()}}{ -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{LargeDataTable$getColumnDefs()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -columnDefs get count } } diff --git a/man/createLargeSqlQueryDt.Rd b/man/createLargeSqlQueryDt.Rd new file mode 100644 index 00000000..30c1d1c0 --- /dev/null +++ b/man/createLargeSqlQueryDt.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/components-largeTableViewer.R +\name{createLargeSqlQueryDt} +\alias{createLargeSqlQueryDt} +\title{Create Large Sql Query Data Table} +\usage{ +createLargeSqlQueryDt( + connectionHandler = NULL, + connectionDetails = NULL, + baseQuery, + countQuery = NULL +) +} +\arguments{ +\item{connectionHandler}{ResultModelManager connectionHandler instance} + +\item{baseQuery}{base sql query} + +\item{countQuery}{count query string (should match query). Can be auto generated with sub query +(default) but this will likely result in slow results} +} +\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. +} diff --git a/man/largeTableServer.Rd b/man/largeTableServer.Rd index 5b923f27..f69e018c 100644 --- a/man/largeTableServer.Rd +++ b/man/largeTableServer.Rd @@ -4,7 +4,14 @@ \alias{largeTableServer} \title{Large Table Component Server} \usage{ -largeTableServer(id, ldt, inputParams, modifyData = NULL) +largeTableServer( + id, + ldt, + inputParams, + modifyData = NULL, + columns = shiny::reactive(list()), + ... +) } \arguments{ \item{id}{Shiny module id. Must match Large Table Viewer} @@ -15,6 +22,10 @@ largeTableServer(id, ldt, inputParams, modifyData = NULL) \item{modifyData}{optional callback function that takes the data page, page number, page size as parameters must return data.frame compatable instance} + +\item{columns}{List or reactable returning list of reactable::columnDef objects} + +\item{...}{Additional reactable options (searchable, sortable} } \description{ Display large data tables in a consistent way - server side pagination for reactable objects diff --git a/tests/testthat/test-components-largeTableViewer.R b/tests/testthat/test-components-largeTableViewer.R index 4d30d74c..8748be6d 100644 --- 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 = { From d714c64179dc2c6a6ecb7a2395517b4de1eba4b6 Mon Sep 17 00:00:00 2001 From: Jamie Gilbert Date: Tue, 18 Jul 2023 08:49:59 -0700 Subject: [PATCH 09/10] fixed typo in tests --- tests/testthat/test-components-largeTableViewer.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-components-largeTableViewer.R b/tests/testthat/test-components-largeTableViewer.R index 8748be6d..015e1cf3 100644 --- a/tests/testthat/test-components-largeTableViewer.R +++ b/tests/testthat/test-components-largeTableViewer.R @@ -24,7 +24,7 @@ test_that("Large Data Table R6 Class works", { expect_error(LargeDataTable$new(ch, query, "SELECT 1; SELECT 2;")) expect_error(LargeDataTable$new(ch, query)) - ldt2 <- LargeDataTable$new(ch, query, countQuery = NULL)) + ldt2 <- LargeDataTable$new(ch, query, countQuery = NULL) checkmate::expect_string(ldt2$countQuery) checkmate::expect_class(largeTableView("foo"), "shiny.tag") From 1a7f5db413532596aaf7af8513ba956a4db61a99 Mon Sep 17 00:00:00 2001 From: Jamie Gilbert Date: Tue, 18 Jul 2023 08:51:37 -0700 Subject: [PATCH 10/10] fixed typo in tests --- inst/cohort-diagnostics-ref/migrations.csv | 2 +- .../test-components-largeTableViewer.R | 46 +++++++++---------- 2 files changed, 24 insertions(+), 24 deletions(-) diff --git a/inst/cohort-diagnostics-ref/migrations.csv b/inst/cohort-diagnostics-ref/migrations.csv index 1c3fdda5..01b71c47 100644 --- a/inst/cohort-diagnostics-ref/migrations.csv +++ b/inst/cohort-diagnostics-ref/migrations.csv @@ -2,4 +2,4 @@ migrationFile,migrationOrder Migration_1-v3_1_0_time_id.sql,1 Migration_2-v3_1_0_ir_person_years.sql,2 Migration_3-v3_2_0_suport_cohort_subsets.sql,3 -Migration_4-v3_2_1_cohort_name_field.sql,4 \ No newline at end of file +Migration_4-v3_2_1_cohort_name_field.sql,4 diff --git a/tests/testthat/test-components-largeTableViewer.R b/tests/testthat/test-components-largeTableViewer.R index 015e1cf3..2b7e5609 100644 --- a/tests/testthat/test-components-largeTableViewer.R +++ b/tests/testthat/test-components-largeTableViewer.R @@ -40,35 +40,35 @@ test_that("Large Data Table R6 Class works", { df %>% dplyr::mutate(fizzBuzz = ifelse(.data$rowId %% 3 == 0, "fizz", "buzz")) }, columns = list(row_id = reactable::colDef("row id") - ), - expr = { + ), + expr = { - session$setInputs(pageSize = 10) + session$setInputs(pageSize = 10) - expect_equal(rowCount(), ldt$getCount(min_row = 1)) - expect_equal(pageNum(), 1) - expect_equal(pageCount(), ceiling(ldt$getCount(min_row = 1) / 10)) + expect_equal(rowCount(), ldt$getCount(min_row = 1)) + expect_equal(pageNum(), 1) + expect_equal(pageCount(), ceiling(ldt$getCount(min_row = 1) / 10)) - session$setInputs(pageSize = 100) - expect_equal(pageNum(), 1) - expect_equal(pageCount(), ceiling(ldt$getCount(min_row = 1) / 100)) + session$setInputs(pageSize = 100) + expect_equal(pageNum(), 1) + expect_equal(pageCount(), ceiling(ldt$getCount(min_row = 1) / 100)) - session$setInputs(pageNum = 5) - expect_equal(pageNum(), 5) - expect_equal(output$pageNumber, "401 - 500 of 1,000,000 rows") + session$setInputs(pageNum = 5) + expect_equal(pageNum(), 5) + expect_equal(output$pageNumber, "401 - 500 of 1,000,000 rows") - checkmate::expect_data_frame(dataPage(), nrow = 100, ncols = 3) - checkmate::expect_names(colnames(dataPage()), must.include = c("rowId", "value", "fizzBuzz")) - expect_true(all(dataPage()$fizzBuzz == ifelse(dataPage()$rowId %% 3 == 0, "fizz", "buzz"))) + checkmate::expect_data_frame(dataPage(), nrow = 100, ncols = 3) + checkmate::expect_names(colnames(dataPage()), must.include = c("rowId", "value", "fizzBuzz")) + expect_true(all(dataPage()$fizzBuzz == ifelse(dataPage()$rowId %% 3 == 0, "fizz", "buzz"))) - checkmate::expect_class(output$tableView, "json") - checkmate::expect_class(output$pageActionButtons , "list") + checkmate::expect_class(output$tableView, "json") + checkmate::expect_class(output$pageActionButtons, "list") - session$setInputs(pageSize = 1e6) - expect_equal(pageCount(), 1) - checkmate::expect_class(output$pageActionButtons , "list") - checkmate::expect_file_exists(output$downloadFull) - } - ) + session$setInputs(pageSize = 1e6) + expect_equal(pageCount(), 1) + checkmate::expect_class(output$pageActionButtons, "list") + checkmate::expect_file_exists(output$downloadFull) + } + ) }) \ No newline at end of file