Hi,
I'm trying to set up a ShinyApp which can access to a PostGreSQL/PostGIS database and perform reactive queries according to user inputs via selectInput widget.
I succeed to perform it with single inputs following this example (https://www.cybertec-postgresql.com/en/visualizing-data-in-postgresql-with-r-shiny/). My working code (sorry for non reprex example, but I cannot provide my database login for security purpose) :
library("RPostgreSQL")
library('rgdal')
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)
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)
When I'm trying to set multiple selectInput, I'm facing similar problem than in this topic (https://forum.posit.co/t/in-in-sql-query-through-textinput-rshiny/8360). Except than I (guess) don't have any security problems using selectInput.
I overcame the SQL syntax problem with this code :
server <- function(input, output, session) {
selectedData <- reactive({
req(input$area)
req(input$typo)
area_name_selected <- ""
for (i in 1:length(input$area)) {
if(i == length(input$area)) {
output <- paste0(output, "'", input$area[[i]], "'")
} else {
output <- paste0(output, "'", input$area[[i]], "',")
}
}
type_name_selected <- ""
for (i in 1:length(input$area)) {
if(i == length(input$area)) {
output <- paste0(output, "'", input$area[[i]], "'")
} else {
output <- paste0(output, "'", input$area[[i]], "',")
}
}
query <- sqlInterpolate(ANSI(),
"SELECT year, SUM(surface)
FROM table
WHERE area IN (?area_name)
AND type IN (?type_name)
GROUP BY year;",
area_name = area_name_selected, type_name = type_name_selected)
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 = annee, y = sum)) + geom_point()
})
}
shinyApp(ui = ui, server = server)
Infortunatly, that did not fixed the situation. The app is launching, but not displaying nay data. The weird thing is that I didn't get any error message. I tried to put the area_name_selected and type_name_selected outside in two other reactive functions but it render the same, nothing without error message...
server <- function(input, output, session) {
selectedArea <- reactive({
req(input$area)
area_name_selected <- ""
for (i in 1:length(input$area)) {
if(i == length(input$area)) {
output <- paste0(output, "'", input$area[[i]], "'")
} else {
output <- paste0(output, "'", input$area[[i]], "',")
}
}
})
selectedType <- reactive({
req(input$typo)
type_name_selected <- ""
for (i in 1:length(input$area)) {
if(i == length(input$area)) {
output <- paste0(output, "'", input$area[[i]], "'")
} else {
output <- paste0(output, "'", input$area[[i]], "',")
}
}
})
selectedData <- reactive({
req(selectedArea()$area)
req(selectedType()$type)
query <- sqlInterpolate(ANSI(),
"SELECT year, SUM(surface)
FROM table
WHERE area IN (?area_name)
AND type IN (?type_name)
GROUP BY year;",
area_name = selectedArea()$area, type_name = selectedType$type)
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 = annee, y = sum)) + geom_point()
})
}
I ran out ouf ideas how to solve this problem. Anyone has a clue on which way to search?