leafletProxy clearShapes工作一次,随后添加数据(点)并且不清除

时间:2015-08-09 19:03:07

标签: r shiny leaflet

以下闪亮的应用程序借用了superzip示例。四个反应参数过滤数据表并在地图上显示过滤的邮政编码级别观察。该应用程序在本地运行或部署时填充正常,它可以在第一次参数调整时正常运行,但之后,不再清除这些点,并且将更多数据(点)添加到地图中。我究竟做错了什么?非常感谢您的指导。

ui.R

library(shiny)
library(shinydashboard)
library(leaflet)
df = readRDS('data/hyops.rds')
products = as.list(unique(df$Product))

header<-dashboardHeader(title = "Title")

sidebar<-dashboardSidebar(
  sidebarMenu(
# Year
selectInput("year", 
            label = "Choose a Year",
            choices = c("2014", "2015"),
            selected = "2014"),

# Product
selectInput("product", 
            label = "Choose a Product",
            choices = products,
            selected = products[[1]]),

# slider bar 
sliderInput("slider1", label = h3("CDI"), min = 50, 
            max = 150, value = 100),
# slider bar 
sliderInput("slider2", label = h3("BDI"), min = 50, 
            max = 150, value = 100)
)
)

body<-dashboardBody(
  navbarPage('Navigate',
  tabPanel("HyOps Map",
    div(class="outer",
      tags$head(
        # Include CSS
        includeCSS("styles.css"),
        includeScript("gomap.js")
      ),
      leafletOutput("map", width="100%", height="900px")
  )
)
))

dashboardPage(header,sidebar,body)

server.R

library(shiny)
library(shinydashboard)
library(DT)
library(RColorBrewer)
library(scales)
library(lattice)
library(dplyr)
source("helpers.R")
df = readRDS('data/hyops.rds')
products = as.list(unique(df$Product))

shinyServer(function(input, output) {
  sliderValue1 <- reactive({
    slide1 = as.numeric(input$slider1)
  })

  sliderValue2 <- reactive({
    slide2 = as.numeric(input$slider2)
  })

  yrInput <- reactive({
    switch(input$year,
           "2014" = 14,
           "2015" = 15)
  })

  prodInput <- reactive({
    as.character(input$product)
  })

  # Dataset Input Zip
  datasetInput <- reactive({
    hid = highops(df,sliderValue1(),sliderValue2(),yrInput())
    dat = hid$q1[hid$q1$Product==prodInput(),]
  })

  ## Interactive Map ###########################################

  # Create the map
  output$map <- 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>'
      ) %>%
      setView(lng = -100.85, lat = 37.45, zoom = 5
      ) 
  })

  # A reactive expression that returns the set of zips that are
  # in bounds right now
  zipsInBounds <- reactive({
    if (is.null(input$map_bounds))
      return(datasetInput()[FALSE,])
    bounds <- input$map_bounds
    latRng <- range(bounds$north, bounds$south)
    lngRng <- range(bounds$east, bounds$west)

    subset(datasetInput(),
           latitude >= latRng[1] & latitude <= latRng[2] &
             longitude >= lngRng[1] & longitude <= lngRng[2])
  })

  # This observer is responsible for maintaining the points on the map
  observe({
    bdiyr = bdiyr = paste0(c('bdi',as.character(yrInput())),collapse='') 
    leafletProxy("map", data = datasetInput()) %>%
      clearShapes() %>%
      addCircles(~longitude, ~latitude, radius=datasetInput()[[bdiyr]] / max(datasetInput()[[bdiyr]]) * 30000, layerId=~ZIPCODE,
                 stroke=FALSE, fillOpacity=0.4)
  })

})

0 个答案:

没有答案