Shiny : reactive data selection from a PostgreSQL database trought multiple input SQL query

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://community.rstudio.com/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?

It's hard to tell fore sure without a reprex but, I think you are returning nothing from the reactive expression, that is why selectedData is empty, try adding outp at the end.

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))
        outp
    })
1 Like

Thank you for the tip, but sadly it was not that. I'm actually working on the reactivity flow, which may be the reason that the query is not returning table... But i'm still aware to any idea.

So after 2 days of pain, tears and drying stackoverflow, I figured out the problem. The mistake was sticking to sqlInterpolate for creating the SQL query. Using some renderPrint function to visualize the generated query, I noticed that some inopportune double quote was showing up in my query.
It appears that sqlInterpolate have been created to prevent security breach trough sql injection attacks (https://shiny.rstudio.com/articles/sql-injections.html), not allowing to use multiple input.
Thanks to parameterized queries (https://db.rstudio.com/best-practices/run-queries-safely) I was able to implement multiple in the query using sql_glue function.

Here are the usefull links for next ones :

glue documentation (https://glue.tidyverse.org/reference/glue_sql.html)
some similar topic (https://community.rstudio.com/t/using-multiple-r-variables-in-sql-chunk/2940/13)
similar with dbQuoteIdentifier function (https://stackoverflow.com/questions/43385119/how-to-use-dynamic-values-while-executing-sql-scripts-in-r)

And the final code :

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)

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.