与多个观察者的闪亮传单地图

时间:2015-10-22 06:53:12

标签: r shiny leaflet

我有两个数据集是使用sliderInput选择一系列日期的子集。然后,过滤的数据显示在所选日期范围内的某些事件(杂草和商店)的纬度和经度(基于邮政编码)。然而,当我渲染leaflet地图时,只会显示一组数据点。如果我注释掉第一组observe函数,我可以看到第二组数据点,反之亦然,但我永远不会让两个观察者同时显示两个数据点的sts。

数据集1(杂草)

                Date   Zip      MainSource
 2014-01-03 17:35:00 98103 Marijuana Plant
 2014-01-04 22:53:00 98112      Other Food
 2014-01-13 22:50:00 98272 Marijuana Plant
 2014-01-14 17:50:00 99210 Marijuana Plant
 2014-01-29 19:27:00 99302             thc
 2014-02-03 11:55:00 99336            Misc
                 ...   ...             ...

数据集2(商店)

                       name   zip    opening
             The Stash Box 98002 2014-11-21
                 Greenside 98198 2015-01-01
                Bud Nation 98106 2015-06-29
 West Seattle Cannabis Co. 98168 2015-02-28
               Nimbin Farm 98168 2015-04-25
              Have a Heart 98178 2015-04-24
                       ...   ...        ...

宣传单地图代码

这是传单地图的代码。

library(htmltools)
library(dplyr)
library(zipcode)
library(leaflet)
data(zipcode)

ui <- bootstrapPage(
    tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
    leafletOutput("map", width = "100%", height = "100%"),

    # Get user input for selected date range
    absolutePanel(top = 10, right = 12,
                  sliderInput("range", 
                      "Choose your dates:", 
                      min(weed$Date),
                      max(weed$Date), 
                      value = range(weed$Date), 
                      step = 0.1,       
                      timeFormat = "%b-%d-%Y"
                  )
    )
)

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

    # Reactive expression for the data subsetted to what the user selected

    filteredData <- reactive({ 
            df <- weed[weed$Date >= input$range[1] & weed$Date <= input$range[2],] %>% 
                    group_by(Zip) %>% 
                    summarize(count = n())
                    names(df) <- c("zip", "count") 
                    df <- join(df, zipcode[,c(1,4,5)], by = "zip")
            return(df)
            })

    filteredShopData <- reactive({ 
            df <- shops[shops$opening >= input$range[1] & shops$opening <= input$range[2],] %>% 
                    group_by(zip) %>% 
                    summarize(count = n())
                    names(df) <- c("zip", "count") 
                    df <- join(df, zipcode[,c(1,4,5)], by = "zip")
            return(df)
    })

# Plot static map
    output$map <- renderLeaflet({
            leaflet() %>% addProviderTiles("CartoDB.Positron") %>% 
                    setView(lng = -122.213380, lat = 47.595225, zoom = 10)
    })

    # Plot pot shops
    observe({
          if (nrow(filteredShopData()) == 0) {leafletProxy("map") %>% clearShapes()} 
          else {
          leafletProxy("map", data = filteredShopData()) %>%
                    clearShapes() %>%
                    addCircles(~longitude, 
                               ~latitude, 
                               radius = ~500*sqrt(count), 
                               color = "black")
          }
     })

    # Plot cases in WA state
       observe({
            if (nrow(filteredData()) == 0) {leafletProxy("map") %>% clearShapes()} 
            else {
            leafletProxy("map", data = filteredData()) %>%
                    clearShapes() %>%
                             addCircles(~longitude, 
                                        ~latitude, 
                                        weight = 1, 
                                        radius = ~700*sqrt(count), 
                                        color = "red") }
    })

}

shinyApp(ui, server)

非常感谢任何帮助。

1 个答案:

答案 0 :(得分:3)

我认为这与传递两个数据参数的事实有关。

相反,我会直接调用您的数据

observe({
      if (nrow(filteredShopData()) == 0) {leafletProxy("map") %>% clearShapes()} 
      else {
      leafletProxy("map") %>%
                clearShapes() %>%
                addCircles(filteredShopData()$longitude, 
                           filteredShopData()$latitude, 
                           radius = ~500*sqrt(count), 
                           color = "black")
      }
 })

# Plot cases in WA state
   observe({
        if (nrow(filteredData()) == 0) {leafletProxy("map") %>% clearShapes()} 
        else {
        leafletProxy("map") %>%
                clearShapes() %>%
                         addCircles( filteredData()$longitude, 
                                     filteredData()$latitude, 
                                    weight = 1, 
                                    radius = ~700*sqrt(count), 
                                    color = "red") }
})