根据传单圈子绘制数据（闪亮）

Question

我的数据

# Fake data
 df <- data.frame(lng = c(-5, -5, -5, -5, -15, -15, -10),
             lat = c(8, 8, 8, 8, 33, 33, 20),
             year = c(2018, 2018, 2018, 2017, 2017, 2017, 2016),
             type = c('A', 'A', 'A', 'A', 'B', 'B', 'A'),
             id =c("1", "1", "1", "1", "2", "2", "3"),
             place =c("somewhere1", "somewhere1", "somewhere1", "somewhere1", "somewhere3", "somewhere2", "somewhere3"),
             stringsAsFactors = FALSE)

映射我的数据：

我的用户界面：

ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
 leafletOutput("map", width = "100%", height = "100%"),
 absolutePanel(top = 10, right = 10,
            style="z-index:500;", # legend over my map (map z = 400)
            tags$h3("map"), 
            sliderInput("periode", "Chronology",
                        min(df$year),
                        max(df$year),
                        value = range(df$year),
                        step = 1,
                        sep = ""
            ),

            checkboxGroupInput("choice", 
                               "type", 
                               choices = list("type A" = "A", 
                                              "type B" = "B"),
                               selected = 1))
 # todo plot()
)

我的服务器端：

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

 # reactive filtering data from UI

   reactive_data_chrono <- reactive({
     df %>%
       filter(year >= input$periode[1] & year <= input$periode[2]) %>%
       filter(type %in% input$choice) %>%
       count(place,lng, lat, type, id) %>%
       arrange(desc(n))
   })

 # colors 

   pal <- colorFactor(
     palette = c('red', 'blue'),
     domain = df$type
   )

 # static backround map

   output$map <- renderLeaflet({
     leaflet(df) %>%
       addTiles() %>%
       fitBounds(~min(lng), ~min(lat), ~max(lng), ~max(lat))
   })  

  # reactive circles map

   observe({
     leafletProxy("map", data = reactive_data_chrono()) %>%
       clearShapes() %>%
       addCircles(lng=~lng,
                  lat=~lat,
                  weight = 5,
                  radius = ~(n*50000),
                  color = ~pal(type)) 
            })  
        }

使用ui＆amp;服务器：

 shinyApp(ui, server)

我的地图：

我做了什么：
1.将数据帧ID值分配给圆圈（图层ID） 2.根据圈子点击获取id值。

我想要的是什么：
3.根据点击事件值过滤我的df值 4.在绝对面板中绘制x，y图（n，年）。

示例：绘制id == 1

我在服务器端试了一下：  我有点困惑，并试图适应几个问题，如 Map Marker in leaflet shiny（@SymbolixAU回答）给leaftleproxy圈子层（而不是背景地图）

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

          # reactive filtering data from UI

            reactive_data_chrono <- reactive({
          df %>%
          filter(year >= input$periode[1] & year <= input$periode[2]) %>%
          filter(type %in% input$choice) %>%
          count(place,lng, lat, type, id) %>%
          arrange(desc(n))
   })

 # colors 

     pal <- colorFactor(
     palette = c('red', 'blue'),
     domain = df$type
   )

 # static backround map

   output$map <- renderLeaflet({
   leaflet(df) %>%
      addTiles() %>%
      fitBounds(~min(lng), ~min(lat), ~max(lng), ~max(lat))
   })  

   # reactive circles map

   observe({
     leafletProxy("map", data = reactive_data_chrono()) %>%
       clearShapes() %>%
       addCircles(lng=~lng,
                  lat=~lat,
                  weight = 5,
                  radius = ~(n*50000),
                  color = ~pal(type),
                  layerId = ~id) ### Assigning df id to layerid
       })  


  observe circles from leafletProxy "map"
  #############################################  
    observe({
      leafletProxy("map") %>% clearPopups()
      event <- input$map_shape_click
      print(event)


  # print(event) returns $id in console

  #############################################
  # what I want : filtering and plotting 
  # using dplyr not woeking
  ############################################# 

      x <- df[df$id == event$id, ]
      x2 <- xtabs(formula =place~year, x)
      output$plot <- renderPlot({x2})
      })
 }


   })
 }

UI添加

         plotOutput(outputId =  "plot"))

 shinyApp(ui, server)

Answer 1

最后，我找到了我的问题的答案。这是完整的代码。 基于@SymbolixAU的建议。

      library(shiny)
      library(leaflet)
      library(dplyr)
      library(leaflet)

      # Fake data
      df <- data.frame(lng = c(-5, -5, -5, -5, -15, -15, -10),
                       lat = c(8, 8, 8, 8, 33, 33, 20),
                       year = c(2018, 2018, 2018, 2017, 2017, 2017, 2016),
                       type = c('A', 'A', 'A', 'A', 'B', 'B', 'A'),
                       id =c(1, 1, 1, 1, 2, 2, 3),
                       place =c("somewhere1", "somewhere1", "somewhere1", "somewhere1", "somewhere3", "somewhere2", "somewhere3"),
                       stringsAsFactors = FALSE)

UI

      ui <- bootstrapPage(
        tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
        leafletOutput("map", width = "100%", height = "100%"),
        absolutePanel(top = 10, right = 10,
                      style="z-index:500;", # legend over my map (map z = 400)
                      tags$h3("map"), 
                      sliderInput("periode", "Chronology",
                                  min(df$year),
                                  max(df$year),
                                  value = range(df$year),
                                  step = 1,
                                  sep = ""
                      ),

                      checkboxGroupInput("choice", 
                                         "type", 
                                         choices = list("type A" = "A", 
                                                        "type B" = "B"),
                                         selected = 1),
                      plotOutput(outputId =  "plot"))
      )

服务器

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

        # reactive filtering data from UI

        reactive_data_chrono <- reactive({
          df %>%
            filter(year >= input$periode[1] & year <= input$periode[2]) %>%
            filter(type %in% input$choice) %>%
            count(place,lng, lat, type, id) %>%
            arrange(desc(n))
        })

        # colors
        pal <- colorFactor(
          palette = c('red', 'blue'),
          domain = df$type
        )

        # static backround map
        output$map <- renderLeaflet({
          leaflet(df) %>%
            addTiles() %>%
            fitBounds(~min(lng), ~min(lat), ~max(lng), ~max(lat))
        })  

        # reactive circles map
        observe({
          leafletProxy("map", data = reactive_data_chrono()) %>%
            clearShapes() %>%
            addCircles(lng=~lng,
                       lat=~lat,
                       weight = 5,
                       radius = ~(n*50000),
                       color = ~pal(type), 
                       layerId = ~id) # Assigning df id to layerid
        })  

        # Observe circles from leafletProxy "map"
        observe({
          leafletProxy("map") %>% clearPopups()
          event <- input$map_shape_click
          if (is.null(event))
            return()
          print(event) # Show values on console fort testing

          # Filtering and plotting
          x <- df[df$id == event$id, ]
          x2 <- x %>%
            count(id, year)
          output$plot <- renderPlot({plot(x2$n, x2$year)
          })
        })
      }

      shinyApp(ui, server)