Блог

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

Для того, чтобы создать новую карту листовки, load_data.R необходимо перезагрузить на основе ввода фильтра. Обратите внимание, что в load_data.R существует оператор where: ГДЕ ИМЯ_ХРАНЕНИЯ = @ВВОД ФИЛЬТРА В ui.R.

Мой вопрос к вам: как заполнить ‘@’ в операторе where в load_data.R на основе пользовательского интерфейса.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)

  })
}
  

Заранее спасибо.

Joris

Решение: «Если вы хотите использовать входные переменные, то команда 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)

  })
}