R Shiny: how to filter a dataframe before outputting a merged SpatialPolygonsDataFrame based on UI selectInput()?

Question

At the moment I'm working on a dashboard-project to display store data on a leaflet map. I managed to do this without any (reactive) filtering input. A functionality I would like to add is to filter the stores. With this filter the user is able to see data for their own store instead of all stores on the leaflet map.

In order to create a new leaflet map, the load_data.R needs to be reloaded based on the filter-input. Note that in load_data.R there is a where-statement: WHERE STORE_NAME = @INPUT OF THE FILTER IN ui.R.

My question to you is: how to fill the '@' in the where statement in load_data.R based on the ui.R selectInput() to remerge and replot the SpatialPolygonsDataFrame(SalesMap) when the user applies a filter?

load_data.R

library(RSQLite)
library(rgdal)
library(dplyr)

# Use the SQLite database
my_sqdb = src_sqlite("Data/dataset.sqlite")

# Extract the main dataset out of the SQLite database
df = data.frame(tbl(my_sqdb, sql("SELECT * FROM df
                                  WHERE STORE_NAME = @INPUT OF THE FILTER IN ui.R")))

# Extract the stores with their locations out of the SQLite database
Winkels = data.frame(tbl(my_sqdb, sql("SELECT * FROM Winkels")))

# Read the shape-data(polygons) into R
shape <-readOGR("Data/Polygonen NL Postcodes 4PP.kml", "Polygonen NL Postcodes 4PP")

# Combine the main dataset with the shape data to plot data into zipcode areas
SalesMap <- merge(shape, df, by.x='Description', by.y='POSTCODE')

ui.R

library(shiny)
library(shinydashboard)
library(leaflet)

source("R/load_metadata.R", chdir=TRUE)

# Header of the  dashboard
header <- dashboardHeader(
  title = "Demographic Dashboard",
  titleWidth = 350,
  dropdownMenuOutput("task_menu")

  )


# Side bar of the dashboard
sidebar <- dashboardSidebar(
  sidebarMenu(
    id = "menu_tabs",
    menuItem("Household Penetration", tabName = "menutab1", icon = icon("percent")),
    selectInput("STORE_NAME", label = "Store",
                choices = STOREFILTER$STORE_NAME,
                selected = STOREFILTER$STORE_NAME[1])
  )
)


# Body of the dashboard
body <- dashboardBody(
  tabItems(
    tabItem(
      tabName = "menutab1",
      tags$style(type = "text/css", "#mymap {height: calc(100vh - 80px) !important;}"),
      leafletOutput("mymap")
    )
  )
)


# Shiny UI
ui <- dashboardPage(
  header,
  sidebar,
  body
)

server.R

#shiny
library(shiny)
library(shinydashboard)

#define color
library(RColorBrewer)
library(colorspace)

# leaflet map
library(leaflet)
library(htmlwidgets)
library(htmltools)

# Processing the data for output
source("R/load_data.R", chdir=TRUE)

## Creating leaflet map
pal <- colorNumeric("Reds", SalesMap@data$SALES)

polygon_popup <- paste0("<strong>ZIP: </strong>", SalesMap$Description, "<br>",
                        "<strong>Store: </strong>", SalesMap$STORE_NAME, "<br>",
                        "<strong>Value: </strong>", SalesMap$SALES, "%")

pop = as.character(Winkels$WINKEL)

Icon <- makeIcon(
  iconUrl = "Images/icon.png",
  iconWidth = 100, iconHeight = 78
)

server <- function(input, output, session) {

  output$mymap <- renderLeaflet({

    leaflet() %>% 
      addTiles(
        urlTemplate = "//{s}.tiles.mapbox.com/v3/jcheng.map-5ebohr46/{z}/{x}/{y}.png",
        attribution = 'Maps by <a href="http://www.mapbox.com/">Mapbox</a>'
      )  %>%


      addPolygons(data = SalesMap,
                  fillColor = ~pal(SalesMap@data$SALES),         
                  fillOpacity = 0.6,  ## how transparent do you want the polygon to be? 
                  popup = polygon_popup,
                  color = "black",       ## color of borders between districts
                  weight = 2.0) %>%

      addMarkers(Winkels$Lon, Winkels$Lat, popup=pop, icon=Icon)

  })
}

Thanks in advance.

Joris

Answer 1

Solution: "If you want to use input variables, then the sql command needs to be inside your server bracket and inside a reactive environment. You'll need to reorganize your code instead of source it at the beginning."

Thanks to: warmoverflow

Code: server.R

 ## LOADING PACKAGES
 #shiny
 library(shiny)
 library(shinydashboard)

#define color
library(RColorBrewer)
library(colorspace)

# leaflet map
library(leaflet)

# Data processing
library(RSQLite)
library(rgdal)


## LOADING DATA
# Use the SQLite database
my_sqdb = src_sqlite("R/Data/dataset.sqlite")

# Extract the main dataset out of the SQLite database
df = data.frame(tbl(my_sqdb, sql("SELECT * FROM df")))

# Extract the stores with their locations out of the SQLite database
Winkels = data.frame(tbl(my_sqdb, sql("SELECT * FROM Winkels")))

# Read the shape-data(polygons) into R
shape <-readOGR("R/Data/Polygonen NL Postcodes 4PP.kml", "Polygonen NL Postcodes 4PP")


## LOADING SHINY SERVER
server <- function(input, output, session) {

  # Reactive dataset
  newData <- reactive({

    input$Button
      isolate({

                dfdf <- subset(df,
                               STORE_NAME == input$storeInput)

    })

    return(dfdf)

  })


  ## Creating Leaflet Map
  output$mymap <- renderLeaflet({

    dfdf = newData()

    SalesMap <- merge(shape, dfdf, by.x='Description', by.y='POSTCODE')

    ## Preparing colors, popups and icons for the leaflet map
    # Colorscale
    pal <- colorNumeric("Reds", SalesMap@data$SALES)

    # Popup for showing data in ZIP-area
    polygon_popup <- paste0("<strong>Postcode: </strong>", SalesMap$Description, "<br>",
                            "<strong>Store: </strong>", SalesMap$STORE_NAME, "<br>",
                            "<strong>Waarde: </strong>", SalesMap$SALES, "%")

    # Popup (with icon) for showing markers with store name
    pop = as.character(Winkels$WINKEL)

    # Creating Icon
    Icon <- makeIcon(
      iconUrl = "Images/icon.png",
      iconWidth = 100, iconHeight = 78
    )

    # Adding tiles, polygons and markers
    leaflet() %>% 
      addTiles(
        urlTemplate = "//{s}.tiles.mapbox.com/v3/jcheng.map-5ebohr46/{z}/{x}/{y}.png",
        attribution = 'Maps by <a href="http://www.mapbox.com/">Mapbox</a>'
      )  %>%


      addPolygons(data = SalesMap,
                  fillColor = ~pal(SalesMap@data$SALES),         
                  fillOpacity = 0.6,  ## how transparent do you want the polygon to be? 
                  popup = polygon_popup,
                  color = "black",       ## color of borders between districts
                  weight = 2.0) %>%

      addMarkers(Winkels$Lon, Winkels$Lat, popup=pop, icon=Icon)

  })
}