tidyverse/dtplyr

Using `lazy_dt()` Inside of a Shiny App Throws Errors in Reactive Contexts

nigeljmckernan opened this issue · 2 comments

I wasn't sure whether to report this to rstudio/shiny or here, but since regular dplyr code is fine in my reactive sections, I'm pretty sure that it's dtplyr that's causing this issue, and not Shiny.

I've tried to make as minimal of a Shiny app to reproduce this, while incorporating some reactivity, as the reactivity is where I'm encountering these errors.

Both of the following code blocks run completely fine when regular dplyr code is used without lazy_dt().

The error thrown depends on if group_by() is used or not. I'll demonstrate both errors.

Here's without group_by():

library(shiny)
library(data.table)
library(dtplyr)
library(dplyr, warn.conflicts = FALSE)
library(lubridate, warn.conflicts = FALSE)
library(nycflights13)

flights <-  flights %>% mutate(Dep_Date = time_hour %>% as_date())

ui <- fluidPage(
            selectInput(
                "tail",
                "Select a Tail #",
                choices = unique(flights$tailnum), # I'm aware this isn't the best way to do this.
                multiple = TRUE
                ),
            dateRangeInput(
                "depDates",
                "Choose a Departure Date Range",
                min = min(flights$Dep_Date),
                max = max(flights$Dep_Date),
                start = min(flights$Dep_Date),
                end = max(flights$Dep_Date)
                ),
            dataTableOutput("depTable")
)

server <- function(input, output, session) {
    
    output$depTable <- renderDataTable(
        flights %>%
            lazy_dt() %>%
            filter(
                Dep_Date %>% between(input$depDates[1], input$depDates[2]),
                tailnum %in% input$tail
            ) %>%
            summarise(
                Avg_Dep_Delay = mean(dep_delay, na.rm = TRUE),
                Max_Dep_Delay = max(dep_delay, na.rm = TRUE)
            ) %>%
            collect()
    )
}

shinyApp(ui = ui, server = server)

This throw an error of Error: invalid subscript type 'closure'.

And if I basically do the same thing with group_by():

ui <- fluidPage(
            selectInput(
                "tail",
                "Select a Tail #",
                choices = unique(flights$tailnum),
                multiple = TRUE
                ),
            selectInput(
                 "groupby",
                 "Select which variables to group by",
                 choices = colnames(flights),
                 multiple = TRUE
             ),
            dateRangeInput(
                "depDates",
                "Choose a Departure Date Range",
                min = min(flights$Dep_Date),
                max = max(flights$Dep_Date),
                start = min(flights$Dep_Date),
                end = max(flights$Dep_Date)
                ),
            dataTableOutput("depTable")
)

server <- function(input, output, session) {
    
    output$depTable <- renderDataTable(
        flights %>%
            lazy_dt() %>%
            filter(
                Dep_Date %>% between(input$depDates[1], input$depDates[2]),
                tailnum %in% input$tail
            ) %>%
            group_by(across(any_of(input$groupby))) %>%
            summarise(
                Avg_Dep_Delay = mean(dep_delay, na.rm = TRUE),
                Max_Dep_Delay = max(dep_delay, na.rm = TRUE)
            ) %>%
            ungroup() %>%
            collect()
    )
}

shinyApp(ui = ui, server = server)

This throws an error of Error: object 'input' not found.

Lastly, no errors are thrown if no dplyr verbs are used except for something like collect() after lazy_dt().

ui <- fluidPage(
            dataTableOutput("depTable"),
)

server <- function(input, output, session) {
    
    output$depTable <- renderDataTable(
        flights %>%
            lazy_dt() %>%
            collect()
    )
}

shinyApp(ui = ui, server = server)

I would like to not have to use data.table explicitly, as various tidyselect verbs and across() are too useful to give up in certain circumstances.

For now I'm leveraging dtplyr for most of my pre-processing needs, and just leaving it to regular dplyr code in any reactive elements.

Thanks for any help!

This is almost certainly a bug; until it's fixed you might be able to work around it by changing group_by(across(any_of(input$groupby))) to group_by(across(any_of(!!input$groupby))) (this shouldn't be necessary in general, but if I'm guessing correctly it'll fix this problem)

That worked! Thank you, Hadley!

(Sort of) Minimal working reprex:

library(shiny)
library(data.table)
library(dtplyr)
library(dplyr, warn.conflicts = FALSE)
library(lubridate, warn.conflicts = FALSE)
library(nycflights13)

flights <-  flights %>% lazy_dt() %>% mutate(Dep_Date = time_hour %>% as_date()) %>% collect()

ui <- fluidPage(

            # Selecting A Tail # To Filter By
            selectInput(
                "tail",
                "Select a Tail #",
                choices = unique(flights$tailnum),
                multiple = TRUE,
                selected = "N804JB"
                ),
            
            # Selecting Grouping Variables
            selectInput(
                "groupby",
                "Select which variables to group by",
                choices = colnames(flights),
                multiple = TRUE,
                selected = c("year", "month")
            ),

            # Selecting Summarising Variables
            selectInput(
              "summarisers",
              "Select Variables to Summarise",
              choices = c("dep_delay", "arr_delay"),
              multiple = TRUE,
              selected = "arr_delay"
            ),
            
            # Date Range Selection
            dateRangeInput(
                "depDates",
                "Choose a Departure Date Range",
                min = min(flights$Dep_Date),
                max = max(flights$Dep_Date),
                start = min(flights$Dep_Date),
                end = max(flights$Dep_Date)
                ),
            
            # Outputs
            dataTableOutput("outputTable")
)

server <- function(input, output, session) {
    
    output$outputTable <- renderDataTable(
        flights %>%
          
          lazy_dt() %>%
          
          filter(
            tailnum %in% !!input$tail,
            Dep_Date %>% between(input$depDates[1], input$depDates[2])
            ) %>%

          group_by(across(any_of(!!input$groupby))) %>%

          summarise(across(any_of(!!input$summarisers), mean, na.rm = TRUE)) %>%

          ungroup() %>%
          
          collect()
    )
}

shinyApp(ui, server)

Curiously, between()'s left and right values don't need !! when using inputs. Not sure why that is.