我正在尝试设置一个ShinyApp，它可以访问PostGreSQL / PostGIS数据库，并根据用户输入通过selectInput小部件执行被动查询。
按照这个例子（https://www.cybertec-postgresql.com/en/visualizing-data-in-postgresql-with-r-shiny/），我成功地使用单个输入执行它。我的工作代码（抱歉非repx示例，但出于安全目的，我不能提供我的数据库登录）。
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。我应该在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))
})
接下来我知道我应该使用一些自动正则表达式格式化多个selectInput返回的area_names / types向量。我想用''包装向量的每个元素，以符合SQL语法。例如，我想转换以下多个输入$ area向量：
area1 area2 area3
至
'area1', 'area2', 'area3'
为了将它存储在area_names sqlInterpolate参数中。
任何人都知道如何执行此操作？感谢所有的贡献。
我打印输出为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/
最后，我们只返回最后的字符串:-)
所以在2天后我发现了问题。错误是坚持使用sqlInterpolate来创建SQL查询。使用一些renderPrint函数可视化生成的查询，我注意到在我的查询中出现了一些不合时宜的双引号。似乎已创建sqlInterpolate以防止安全漏洞通过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函数类似（How to use dynamic values while executing SQL scripts in 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)