R Shiny: как фильтровать dataframe перед выводом объединенного SpatialPolygonsDataFrame на основе пользовательского интерфейса selectInput()?

Question

На данный момент я работаю над проектом панели мониторинга, чтобы отображать данные хранилища на карте листовка. Мне удалось сделать это без какого-либо (реактивного) фильтрационного ввода. Функциональность, которую я хотел бы добавить, - это фильтрация магазинов. С помощью этого фильтра пользователь может видеть данные для своего собственного магазина, а не все магазины на карте листовки.

Чтобы создать новую карту буклетов, load_data.R необходимо перезагрузить на основе ввода фильтра. Обратите внимание, что в load_data.R есть оператор where: WHERE STORE_NAME = @INPUT OF FILTER IN ui.R.

Мой вопрос к вам: как заполнить '@' в инструкции where в load_data.R на основе ui.R selectInput() для ретрансляции и замены SpatialPolygonsDataFrame (SalesMap), когда пользователь применяет фильтр?

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) 

    }) 
} 

Спасибо заранее.

Джорис

Answer 1

Решение. «Если вы хотите использовать входные переменные, то SQL команда должна быть внутри ваш сервер кронштейна и внутри реактивной среды Вы должны реорганизовать свой код вместо источника его в начале."

Благодаря: warmoverflow

Код: 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) 

    }) 
}