R Shiny: создание интерактивного запроса SQL и копирование данных в глобальную среду - PullRequest
Новая
       10

R Shiny: создание интерактивного запроса SQL и копирование данных в глобальную среду

0 голосов
/ 18 июня 2020

Я пытаюсь создать блестящее приложение, которое позволяет пользователям запрашивать данные. Пользователи должны предоставить список интересующих значений, которые используются для фильтрации данных, хранящихся в базе данных. К сожалению, перевод dplyr не кажется самым эффективным / производительным решением, поэтому мне нужно создать строку и передать ее в базу данных через sql(). Манипуляции со строками также являются грубым отказоустойчивым средством для обработки ошибок / разновидностей ввода. Следующий код иллюстрирует этот процесс построения строки и запроса данных: 

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()

Я бы хотел реализовать этот код в блестящем приложении: 

# 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)

Приложение переходит к списку значений предоставленный пользователем в качестве ввода, преобразует его и показывает преобразованный список в качестве вывода.

Вот что я хочу сделать:

  1. Я хотел бы сохранить преобразованный string_input в дополнительном локальном объекте для дальнейшего использования в приложении, то есть я хочу передать string_input в запрос данных, аналогичный приведенному выше примеру без блеска.
  2. Я хотел бы скопировать результат запроса данных в глобальную среду R, чтобы я мог использовать его даже после закрытия приложения.

Что касается моего второго пункта: я читал, что можно использовать <- и <<-, но я не мог заставить его работать в реактивном контексте.

Ответы [ 2 ]

0 голосов
/ 19 июня 2020

Я нашел решение: 

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)

Хитрость заключалась в том, чтобы определить функцию saveData, передать ей реактивный data объект и назначить его export через <<-.

Честно говоря, я не понимаю всех основ, поэтому любые предложения по улучшению приветствуются. Однако это работает.

0 голосов
/ 19 июня 2020

Для вашего первого вопроса: 

# 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() теперь доступна как для вывода, так и для запроса данных.

Обратите внимание, что вы также можете использовать input$string_input вместо input$go в качестве триггера для обновления вывода при вводе критериев.

Затем вы можете использовать input$go для запроса данных: 

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

Не уверен, что вы можете напрямую писать из Shiny в среду R, но вы можете точно сохранить data () как файл на сервере.

...