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

我将向您展示一个如何运作的小例子。

注意事项

点击形状/地图对象将返回lat，lng和id值
id值是您使用addMarkers()参数在layerId调用中分配的值
然后，您可以使用此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)

传单中的地图标记闪亮

1 个答案:

实施例