传单中的地图标记闪亮

Question

我仍然是 R-newb，但我正在获得一些牵引力。主要是因为我正在阅读这里的所有帖子。但是，我找不到任何有关此的信息。

我追求的是什么：

当用户单击传单中的标志时，id（我分配的）被初始化，此时我使用该 id 来查询另一个数据以构建图形。

我的问题是试图让 id 工作 - 点击似乎没有返回任何内容。我想知道是否与我的反应无关？我这么说的原因是我能够让它在一个更简单的例子上工作。
我突出显示并加粗了观察语句和相应的代码。

    library(magrittr)
library(leaflet)
library(geojson)
library(shiny)
library(leaflet)
library(shinydashboard)
library(shinyjs)
library(markdown)
library(shinythemes)
library(DT)



greenLeafIcon <- makeIcon(
  iconUrl = "http://leafletjs.com/examples/custom-icons/leaf-orange.png",
  iconWidth = 38, iconHeight = 95,
  iconAnchorX = 22, iconAnchorY = 94,
  shadowUrl = "http://leafletjs.com/examples/custom-icons/leaf-shadow.png",
  shadowWidth = 50, shadowHeight = 64,
  shadowAnchorX = 4, shadowAnchorY = 62
)


#setwd("/Users/credit4/Dropbox/GEO/GEO ALL CO.")
source("SCRIPTGEO.R", local = TRUE)
salespeople <- sort(unique(poundsslopesv3$SLSP))


# Define UI for application that draws a histogram
ui <- navbarPage(
  theme = shinytheme("cerulean"),
  title = "GEO CUSTOMERS",
  id = 'tabID',
  tabPanel("ALL CUSTOMERS", value = 'all',
    sidebarLayout(
      sidebarPanel(
          tags$div(title = "GREATER THAN",
                sliderInput("bins","FISCAL YEAR SALES",
                                                min = 0,
                                                max = 4000000,
                                                step = 10000,
                                                value = 0)),
                sliderInput("poundsall", "FISCAL YEAR POUNDS",
                            min = 0,
                            max = 2000000,
                            value = 0)),

        mainPanel(
          tags$style(type = "text/css", "#Salesall {height: calc(100vh - 80px) !important;}"),
          leafletOutput("Salesall"))
      )
  ),
  tabPanel("BY SALESPERSON", value = 'bysp',
     sidebarLayout(
       sidebarPanel(
         tags$div(title = "test",
                  sliderInput("bins1","FISCAL YEAR SALES",
                              min = 0,
                              max = 4000000,
                              step = 10000,
                              value = 0)),
                  sliderInput("pounds", "FISCAL YEAR POUNDS",
                              min = 0, 
                              max = 2000000,
                              step = 10000,
                              value = 0),
         checkboxGroupInput("slsp", "BY SALESPERSON", salespeople, "NULL")),
       mainPanel(
         tags$style(type = "text/css", "#Salesbysalesperson {height: calc(100vh - 80px) !important;}"),
         leafletOutput("Salesbysalesperson"))
     )
  ),

  tabPanel("BY SLOPE", value = 'byslope',
     sidebarLayout(
       sidebarPanel(
         checkboxGroupInput("slsp2", "BY SALESPERSON", salespeople, "NULL"),
         sliderInput("slopeslider", "FISCAL YEAR POUNDS",
                     min = 0, 
                     max = 2000000,
                     step = 10000,
                     value = c(0,2000000)),
                            sliderInput("mo6slope", "6 MONTH SLOPE", min = -4, max = 4, value = c(-4,4)),
                            sliderInput("mo12slope", "12 MONTH SLOPE", min = -4, max = 4, value = c(-4,4)),
                            sliderInput("mo24slope", "24 MONTH SLOPE", min = -4, max = 4, value = c(-4,4)),
         ***tableOutput("Poundsgraph")***
           ),
       mainPanel(
         tags$style(type = "text/css", "#Slope {height: calc(100vh - 80px) !important;}"),
         leafletOutput("Slope"))
     )
  ),
  tabPanel("DATA", value = "dataraw",
           sidebarLayout(
             sidebarPanel(

             ),
             mainPanel(

               DT::dataTableOutput("data"))
           )
  )

)



server <- function(input, output, session){
***data <- reactiveValues(clickedMarker=NULL)***

  ############MAIN GRAPHS########### (USE FOR LEAFLETPROXY)
  output$Salesall <- renderLeaflet({
    leaflet()%>% 
      addTiles()

  })

  output$Salesbysalesperson <- renderLeaflet({
    leaflet()%>% 
      addTiles()
  })

  output$Slope <- renderLeaflet({
    leaflet()%>% 
      addTiles()
  })

  output$data <- DT::renderDataTable({
    custgeo
  })
  ***observeEvent(input$curr_tab_marker_click, {
    data <- input$curr_tab_marker_click
    # y <- which(data$id %in% poundswslsp$id)
    # z <- poundswslsp[y,][3:26]
    output$Poundsgraph <- renderTable({
    return(
      data$id
    )
    })
  })***



  sales_data <- reactive({
    if(input$tabID == 'all'){
      sales<-input$bins
      pounds2 <- input$poundsall
      dataall <- custgeo%>%
        filter(FISCAL.YR.SALES >= sales, FISCAL.YR.POUNDS >=pounds2)
    } else if(input$tabID == 'bysp'){
      sales <- input$bins1
      salesperson <- input$slsp
      pounds <- input$pounds
      data <- poundsslopesv3%>%
        filter(poundsslopesv3$FISCAL.YR.SALES >= sales & poundsslopesv3$SLSP  %in% salesperson, poundsslopesv3$FISCAL.YR.POUNDS >= pounds)
    } else if(input$tabID == 'byslope'){
      salesp2 <- input$slsp2
      dataslopes <- poundsslopesv3%>%
        filter(poundsslopesv3$SLOPE6MO >= input$mo6slope[1],
               poundsslopesv3$SLOPE6MO <= input$mo6slope[2],
               poundsslopesv3$SLOPE12MO >= input$mo12slope[1],
               poundsslopesv3$SLOPE12MO <= input$mo12slope[2],
               poundsslopesv3$SLOPE24MO >= input$mo24slope[1],
               poundsslopesv3$SLOPE24MO <= input$mo24slope[2],
               poundsslopesv3$SLSP %in% salesp2,
               poundsslopesv3$FISCAL.YR.POUNDS >=input$slopeslider[1],
               poundsslopesv3$FISCAL.YR.POUNDS <= input$slopeslider[2])
    } else if(input$tabID == "dataraw"){
      custgeo
    }


  })

  ###############BY SALESPERSON##############
  observe({

    curr_tab <- switch(input$tabID,
                       all = 'Salesall',
                       bysp = 'Salesbysalesperson',
                       byslope = 'Slope',
                       dataraw = "data"
                       )

    leafletProxy(curr_tab)%>%
      clearMarkers()%>%
      clearMarkerClusters()%>%
      addMarkers(sales_data()$LONGITUDE, sales_data()$LATITUDE, icon = greenLeafIcon,
                 popup = paste("<b>BILL.TO:</b>", sales_data()$BILL.TO, "<br>",
                               "<b>NAME:</b>", sales_data()$NAME, "<br>",
                               "<b>ADDRESS:</b>", sales_data()$ADDRESS.1, "<br>",
                               "<b>CITY:</b>", sales_data()$CITY, "<br>",
                               "<b>STATE:</b>", sales_data()$STATE, "<br>",
                               "<b>ZIP:</b>", sales_data()$ZIP5, "<br>",
                               "<b>PHONE:</b>", sales_data()$PHONE, "<br>",
                               "<b>WEBSITE:</b>", sales_data()$url, "<br>",
                               "<b>CONTACT:</b>", sales_data()$PURCHASING.CONTACT, "<br>",
                               "<b>FISCAL YR SALES:</b>", sales_data()$FISCAL.YR.SALES, "<br>",
                               "<b>SALESPERSON</b>", sales_data()$SALESPERSON
                               ),
                 clusterOptions = markerClusterOptions())
  })


}




# Run the application 
shinyApp(ui = ui, server = server)

Answer 1

我将向您展示一个较小的示例来说明其工作原理。

注意事项

1. 单击形状/地图对象将返回 lat、lng 和 id 值
2. id 值是您在 addMarkers() 调用中使用 layerId 参数分配的值
3. 然后您可以使用此id 来过滤您的数据，假设您已将数据中的 id 值用作layerId

示例

在此示例中，我使用的是 googleway 包随附的数据集

library(shiny)
library(leaflet) 
library(googleway)

ui <- fluidRow(
  leafletOutput(outputId = "map"),
  tableOutput(outputId = "table")
)

server <- function(input, output){

  ## I'm using data from my googleway package
  df <- googleway::tram_stops

 ## define the layerId as a value from the data
  output$map <- renderLeaflet({
    leaflet() %>%
      addTiles() %>%
      addMarkers(data = df, lat = ~stop_lat, lng = ~stop_lon, layerId = ~stop_id)
  })

  ## observing a click will return the `id` you assigned in the `layerId` argument
  observeEvent(input$map_marker_click, {

    click <- input$map_marker_click

    ## filter the data and output into a table
    output$table <- renderTable({
      df[df$stop_id == click$id, ]
    })
  })

}

shinyApp(ui, server)