R Shiny : reactive data selection trought multiple selectInput in a postgresql/postgis db query with regular expression

Question

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 cannont provide my database login for security purpose).

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)

What I want to do is editing the reactive query in the server part in order to allow multiple selectInput. I should add IN operator instead of = in the sql query :

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))
    })

Next I know I should format the area_names / types vector returned by a multiple selectInput with some automatic regular expression. I want to wrap each elements of the vector with '', in order to accord with the SQL syntax. For example, I want to transfrom the following multiple input$area vector :

area1 area2 area3

to

'area1', 'area2', 'area3'

In order to store it in the area_names sqlInterpolate argument.

Anyone has an idea how to perform this? Thanks to all contributions.

DSGym · Accepted Answer · 2019-04-29 18:50:30Z

0

I print the output as textOutput, but i guess you can pick up the idea for whatever you want for :-)

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

Explanation: The input$multis a vector which lengths depends on how many inputs are selected. I initialize an empty output and start the loop.

paste0 will convert the input to a string and add a comma, except for the last iteration, where we do not want a comma. The double brackets extract the value by indexing. Hope this gets clear below:

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

The [[i]] will change its value every iteration. Check out this to get a feeling for it.

https://www.r-bloggers.com/how-to-write-the-first-for-loop-in-r/

At the end, we just return the final string :-)

edited Apr 29, 2019 at 18:50

answered Apr 29, 2019 at 17:55

DSGym

2,8671 gold badge9 silver badges23 bronze badges

Sign up to request clarification or add additional context in comments.

2 Comments

Rob Lucas Over a year ago

Thank you for helping. Its look pretty nice but as I'm a R rookie i didn't understand what's happening in the the loop... I was wondering about some lapply function with an improved paste like paste0(input$mult, "','"), but I'm searching for half a day and I didn't found any. Could you please explain the loop as I could reproduce please? Forx example, what's the "i" for? Each character position or each element in the list?

DSGym Over a year ago

I edited my answer with an explation. If it was helpful, feel free to upvote and accept it :-)

Rob Lucas · Accepted Answer · 2019-04-30 21:38:03Z

So after 2 days 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 (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)

Collectives™ on Stack Overflow

R Shiny : reactive data selection trought multiple selectInput in a postgresql/postgis db query with regular expression

2 Answers 2

2 Comments

Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

2 Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related