R Shiny: Build an interactive SQL query and copy data into global environment

Question

I try to build a shiny app that enables users to query data. Users are supposed to provide a list of values of interest that are used to filter data stored in a database. Unfortunately, dplyr's translation does not appear to be the most efficient/performant solution such that I have to build a string and pass it to the database via sql(). The string manipulations are also a crude fail safe to handle entry errors/varieties. The following code illustrates this string building and data query process:

library(tibble)
library(dplyr)
library(dbplyr)
library(shiny)
library(RSQLite)
library(DBI)
library(stringr)

# Create string variables to experiment
mtcars1 <- tibble::rownames_to_column(mtcars, var = "model") %>% # Create column based on row names
    dplyr::mutate(carmaker = stringr::word(model, 1))            # Create column with first word of column with row names

# Establish example database
con <- DBI::dbConnect(RSQLite::SQLite(), path = ":memory:")
copy_to(con, mtcars1, "mtcars1", temporary = FALSE)

# Query example

# Input
string_input <- "Mazda,    Merc"

# Prepare input string to be used in SQL
string_filter <- string_input %>%
    base::gsub("[,]+", " ", .) %>%         # remove commas
    stringr::str_squish(.) %>%             # remove multiple blanks
    base::gsub(" ", ",", .) %>%            # substitute blanks for commas
    base::gsub("(\\w+)", "'\\1'", .) %>%   # enclose words with single quotation marks
    base::paste0("carmaker in (", ., ")")  # create sql where statement

# Data query
data <- tbl(con, "mtcars1") %>%
    filter(sql(string_filter)) %>%
    show_query() %>%
    collect()

I'd like to implement this code in a shiny app:

# Shiny user interface
ui <- fluidPage(

    textInput(inputId = "string_input", label = "Input", value = "", placeholder = "Enter list of car models without commas"),

    actionButton(inputId = "go", label = "Go"),

    textOutput(outputId = "string_output")

)

# Shiny server function
server <- function(input, output){

    observeEvent(input$go, {

        output$string_output <- reactive({input$string_input %>%
                base::gsub("[,]+", " ", .) %>%         # remove commas
                stringr::str_squish(.) %>%             # remove multiple blanks
                base::gsub(" ", ",", .) %>%            # substitute blanks for commas
                base::gsub("(\\w+)", "'\\1'", .) %>%   # enclose words with single quotation marks
                base::paste0("carmaker in (", ., ")")  # create sql where statement
        })
    })
}

# Launch shiny app
shinyApp(ui, server)

The app takes to list of values supplied by the user as input, transforms it and shows the transformed list as output.

Here is what I want to do:

1. I would like store the transformed string_input in an extra local object for further use in the app, that is, I want to pass the string_input to the data query similar to the non-shiny example above.
2. I would like to copy the data query result to R's global environment such that I can use it, even after closing the app.

Regarding the my second point: I read that one can use <- and <<-, but I could not make it work in a reactive context.

Answer 1

I figured out the solution:

library(tibble)
library(dplyr)
library(dbplyr)
library(shiny)
library(RSQLite)
library(DBI)
library(stringr)

# Create string variables to experiment
mtcars1 <- tibble::rownames_to_column(mtcars, var = "model") %>% # Create column based on row names
    dplyr::mutate(carmaker = stringr::word(model, 1))            # Create column with first word of column with row names

# Establish example database
con <- DBI::dbConnect(RSQLite::SQLite(), path = ":memory:")
copy_to(con, mtcars1, "mtcars1", temporary = FALSE)

# Shiny user interface
ui <- fluidPage(

    textInput(inputId = "string_input",
              label = "Input",
              value = "",
              placeholder = "Enter a list of car makers (e.g. Mazda, Merc)"),

    textOutput(outputId = "string_output"),

    actionButton(inputId = "go", label = "Go"),

    tableOutput(outputId = "data_output")

)

# Custom function to save reactive object to global environment
saveData <- function(x) {
    export <<- x
}

# Shiny server function
server <- function(input, output){

        list <- reactive({

            input$string_input %>%
            base::gsub("[,]+", " ", .) %>%         # remove commas
            stringr::str_squish(.) %>%             # remove multiple blanks
            base::gsub(" ", ",", .) %>%            # substitute blanks for commas
            base::gsub("(\\w+)", "'\\1'", .) %>%   # enclose words with single quotation marks
            base::paste0("carmaker in (", ., ")")  # create sql where statement

        })

        output$string_output <- reactive({list()})

        data <- eventReactive(input$go, {

            tbl(con, "mtcars1") %>%
                dplyr::filter(sql(!!list())) %>%
                dplyr::collect()

        })

        output$data_output <- renderTable(data())

        observeEvent(input$go, {

            saveData(data())

        })

}

# Launch shiny app
shinyApp(ui, server)

The trick was to define the function saveData, pass the reactive data object to it and assign it to export via <<-.

Honestly, I do not understand all of the fundamentals so any suggestions for improvement are welcome. However, it works.

Answer 2

For your first question:

# Shiny server function
server <- function(input, output){

string_output <- eventReactive(input$go, {
    input$string_input %>%
        base::gsub("[,]+", " ", .) %>%         # remove commas
        stringr::str_squish(.) %>%             # remove multiple blanks
        base::gsub(" ", ",", .) %>%            # substitute blanks for commas
        base::gsub("(\\w+)", "'\\1'", .) %>%   # enclose words with single quotation marks
        base::paste0("carmaker in (", ., ")")  # create sql where statement

  })
  output$string_output <-renderText(string_output())
}

string_output() reactive function is now available for output as well as for data query.

Note that you could also use input$string_input instead of input$goas trigger to update the output while you type the criteria.

You can then use input$go to query the data:

data <- eventReactive(input$go, { dbGetQuery(yourConnection,YourQuery(string_output())})
output$data <- renderTable(data())

Not sure you can directly write from Shiny to R's environment, but you can for sure save data() as a file on the server.