R Shiny:反应式数据选择在带有正则表达式的postgresql/postgis db查询中输入多个选择输入

Question

>我正在尝试设置一个ShinyApp，它可以访问PostGreSQL/PostGIS数据库，并通过selectInput小部件根据用户输入执行反应式查询。

按照此示例 (https://www.cybertec-postgresql.com/en/visualizing-data-in-postgresql-with-r-shiny/)，我成功地使用单个输入执行它。我的工作代码(很抱歉非reprex示例，但出于安全目的，我无法提供我的数据库登录名)。

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)

我想做的是编辑服务器部分中的反应式查询，以允许多个选择输入。我应该在sql查询中添加IN运算符而不是=：

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/类型向量。我想用''包装向量的每个元素，以符合SQL语法。 例如，我想从以下多个输入/区域向量转换：

area1 area2 area3

自

'area1', 'area2', 'area3'

为了将其存储在area_names sql插值参数中。

有人知道如何执行此操作吗？感谢所有贡献。

Answer 1

我将输出打印为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/how-to-write-the-first-for-loop-in-r/

最后，我们只返回最后一个字符串：-)

Answer 2

所以两天后我就想出了问题所在。错误是坚持使用sql插值来创建SQL查询。使用一些 renderPrint 函数来可视化生成的查询，我注意到我的查询中出现了一些不合时宜的双引号。 似乎已经创建了sql插值，以防止通过SQL注入攻击(https://shiny.rstudio.com/articles/sql-injections.html)进行安全漏洞，不允许使用多个输入。 多亏了参数化查询 (https://db.rstudio.com/best-practices/run-queries-safely)，我能够使用 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 函数(如何在 R 中执行 SQL 脚本时使用动态值)

最终代码：

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)