R Shiny: реактивный выбор данных при множественном selectInput в запросе postgresql / postgis db с регулярным выражением - PullRequest
Новая
       11

R Shiny: реактивный выбор данных при множественном selectInput в запросе postgresql / postgis db с регулярным выражением

0 голосов
/ 29 апреля 2019

Я пытаюсь настроить ShinyApp, который может получить доступ к базе данных PostGreSQL / PostGIS и выполнять реактивные запросы в соответствии с пользовательским вводом через виджет selectInput.

Мне удается выполнить его с помощью одного ввода, следуя этому примеру(https://www.cybertec -postgresql.com / о / визуализация-данные в-с-PostgreSQL-R-блестящим / ).Мой рабочий код (извините за не представленный пример, но я не могу предоставить свой логин для базы данных в целях безопасности). 

pool <- dbPool(drv = dbDriver("PostgreSQL", max.con = 100), user = "user", password = "pswd", host = "000.000.00.000", port = 5432, dbname = "db_name", idleTimeout = 3600000)

typology <- dbGetQuery(pool, "SELECT type FROM table GROUP BY type")
all_typo <- sort(unique(typology$type))

area_agripag <- dbGetQuery(pool, "SELECT area_name FROM table GROUP BY area_name")
all_area <- sort(unique(area_agripag$area_name))

ui <- fluidPage(
    sidebarLayout(
        sidebarPanel(
            selectInput(
                inputId = "area",
                label = "Select a district",
                choices = all_area,
                selected = 'district_1',
                multiple = FALSE,
                selectize = FALSE
            ),
            selectInput(
                inputId = "typo",
                label = "Select a type",
                choices = all_typo,
                selected = 'type1',
                multiple = FALSE,
                selectize = FALSE
            )
        ),
        mainPanel(
            tabsetPanel(
                tabPanel("graph", plotOutput("plot")),
                tabPanel("Table", dataTableOutput("table"))
            )
        )
    )
)

server <- function(input, output, session) {

    selectedData <- reactive({
        req(input$area)
        req(input$typo)
        query <- sqlInterpolate(ANSI(),
                "SELECT year, SUM(surface) 
                FROM table 
                WHERE area_name = ?area_name 
                AND type = ?type 
                GROUP BY year;",
            area_name = input$area, type = input$typo)
        outp <- as.data.frame(dbGetQuery(pool, query))
    })

    output$table <- DT::renderDataTable({
        DT::datatable(  data = selectedData(),
                options = list(pageLength = 14),
                rownames = FALSE)
    })

    output$plot <- renderPlot({
        ggplot( data = selectedData(), aes(x = year, y = sum)) + geom_point()
    })

}

shinyApp(ui = ui, server = server)

Что я хочу сделать, это отредактировать реактивный запрос в серверной части, чтобы разрешить несколькоselectInput.Я должен добавить оператор IN вместо = в запросе sql: 

selectedData <- reactive({
        req(input$area)
        req(input$typo)
        query <- sqlInterpolate(ANSI(),
                "SELECT year, SUM(surface) 
                FROM table 
                WHERE area_name IN (?area_names) 
                AND type IN (?types) 
                GROUP BY year;",
            area_names = input$area, types = input$typo)
        outp <- as.data.frame(dbGetQuery(pool, query))
    })

Далее я знаю, что должен отформатировать вектор area_names / types, возвращаемый множественным selectInput, с некоторым автоматическим регулярным выражением.Я хочу заключить каждый элемент вектора в '', чтобы соответствовать синтаксису SQL.Например, я хочу преобразовать следующий многократный входной вектор $ area: 

area1 area2 area3

в 

'area1', 'area2', 'area3'

, чтобы сохранить его в аргументе sqlInterpolate для area_names.

У кого-нибудь есть идеи, как это сделать?Спасибо всем за вклад.

Ответы [ 2 ]

0 голосов
/ 01 мая 2019

Итак, через 2 дня я разобрался с проблемой.Ошибка заключалась в использовании sqlInterpolate для создания SQL-запроса.Используя некоторую функцию renderPrint для визуализации сгенерированного запроса, я заметил, что в моем запросе появилась неуместная двойная кавычка.Похоже, что sqlInterpolate были созданы для предотвращения взлома системы безопасности посредством атак с использованием SQL-инъекций (https://shiny.rstudio.com/articles/sql-injections.html),, не позволяющих использовать множественный ввод.Функция sql_glue.

Вот полезные ссылки для следующих:

документация клея (https://glue.tidyverse.org/reference/glue_sql.html)

похожая тема (https://community.rstudio.com/t/using-multiple-r-variables-in-sql-chunk/2940/13)

аналогс функцией dbQuoteIdentifier ( Как использовать динамические значения при выполнении сценариев SQL в R )

И окончательный код: 


library(RPostgreSQL)
library(gdal)
library(leaflet)
library(shiny)
library(tidyverse)
library(sp)
library(rgeos)
library(rgdal)
library(DT)
library(knitr)
library(raster)
library(sf)
library(postGIStools)
library(rpostgis)
library(shinydashboard)
library(zip)
library(pool)
library(rjson)
library(reprex)
library(glue)

pool <- dbPool(drv = dbDriver("PostgreSQL", max.con = 100), user = "username", password = "pswd", host = "000.000.00.000", port = 5432, dbname = "database", idleTimeout = 3600000)

typology <- dbGetQuery(pool, "SELECT type FROM table GROUP BY type")
all_typo <- sort(unique(typology$type))

area_table <- dbGetQuery(pool, "SELECT area FROM tableGROUP BY area")
all_area <- sort(unique(area_table$area ))

ui <- fluidPage(
   sidebarLayout(
       sidebarPanel(
           selectInput(
               inputId = "area",
               label = "Select a district",
               choices = all_area,
               selected = 'area1',
               multiple = TRUE,
               selectize = FALSE
           ),
           selectInput(
               inputId = "typo",
               label = "Select a type",
               choices = all_typo,
               selected = 'type1',
               multiple = TRUE,
               selectize = FALSE
           )
       ),
       mainPanel(
           tabsetPanel(
               tabPanel("graph", plotOutput("plot")),
               tabPanel("Table", dataTableOutput("table"))
           )
       )
   )
)

server <- function(input, output, session) {

   selectedData <- reactive({
       req(input$area)
       req(input$typo)
       query <- glue::glue_sql(
            "SELECT year, SUM(surface) 
               FROM table
               WHERE area IN ({area_name*})
               AND type IN ({type*})
               GROUP BY year;",
           area_name = input$area,
        type = input$typo,
        .con = pool)
       outp <- as.data.frame(dbGetQuery(pool, query))
    outp
   })

   output$table <- DT::renderDataTable({
       DT::datatable(  data = selectedData(),
               options = list(pageLength = 14),
               rownames = FALSE)
   })

   output$plot <- renderPlot({
       ggplot( data = selectedData(), aes(x = year, y = sum)) + geom_point()
   })

}

shinyApp(ui = ui, server = server)
0 голосов
/ 29 апреля 2019

Я печатаю вывод как textOutput, но я думаю, вы можете выбрать идею для чего угодно: -) 

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

# Define UI for application that draws a histogram
ui <- fluidPage(

    # Application title
    titlePanel("Old Faithful Geyser Data"),

    # Sidebar with a slider input for number of bins 
    sidebarLayout(
        sidebarPanel(
            sliderInput("bins",
                        "Number of bins:",
                        min = 1,
                        max = 50,
                        value = 30),
            selectizeInput("mult", label = "Chooose", choices = c("area1", "area2", "area3"), selected = "area1", multiple = TRUE)
        ),

        # Show a plot of the generated distribution
        mainPanel(
           textOutput("text")
        )
    )
)

# Define server logic required to draw a histogram
server <- function(input, output) {

    output$text <- renderText({

        output <- ""

        print(length(input$mult))

        for(i in 1:length(input$mult)) {

            if(i == length(input$mult)) {
                output <- paste0(output, "'", input$mult[[i]], "'")
            } else {
                output <- paste0(output, "'", input$mult[[i]], "', ")  
            }

        }
        output 
    })    


}

# Run the application 
shinyApp(ui = ui, server = server)

Объяснение: input$mult - это вектор, длина которого зависитна сколько входов выбрано.Я инициализирую пустой вывод и запускаю цикл.

paste0 преобразует ввод в строку и добавляет запятую, за исключением последней итерации, где мы не хотим запятую.Двойные скобки извлекают значение путем индексации.Надеюсь, что это станет ясно ниже: 

x <- c(3,5,7)
paste0(x[[1]], " and ", x[[2]], " and ", x[[3]])
1] "3 and 5 and 7"

[[i]] будет менять свое значение при каждой итерации.Проверьте это, чтобы почувствовать это.

https://www.r -bloggers.com / как написать первый цикл в r /

В конце мы просто возвращаем последнюю строку: -)

...