Question

目前我正在开发一个仪表板项目，以在传单地图上显示商店数据。我设法做到这一点没有任何（被动）过滤输入。我想添加的功能是过滤商店。使用此过滤器，用户可以查看自己商店的数据，而不是传单地图上的所有商店。

为了创建新的传单映射，需要根据filter-input重新加载load_data.R。请注意，在load_data.R中有一个where语句： WHERE STORE_NAME = @ uP.过滤器的@INPUT 。

我的问题是：如何在load_data.R中的where语句中填写'@'，基于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

解决方案：＆＃34;如果要使用输入变量，则sql命令需要位于服务器括号内并处于响应环境中。您需要重新组织代码，而不是在开始时提供代码。＆＃34;

感谢： 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("Postcode: ", SalesMap$Description, " ", "Store: ", SalesMap$STORE_NAME, " ", "Waarde: ", 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) }) }

R Shiny：如何在输出基于UI selectInput（）的合并SpatialPolygonsDataFrame之前过滤数据帧？

1 个答案: