Map Marker in leaflet shiny

2
votes

I'm still a R-newb but I'm gaining some traction. Primarily because I'm reading all the posts in here. This one, however, I can't find any information on.

What I'm after:

When User clicks a flag in leaflet the id (that I assign) is initialized at which point I use that id to query another datable to build a graph.

My issue is trying to get the id to work - appears nothing is coming back from the click. I wonder if doesn't have to do with my reactives? The reason I say that is that I am able to get it to work on a simpler example.
I highlighted and bolded the observe statement and corresponding code.

    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)
1
rshinyleaflet
inside your observeEvent() you're returning data$id - this is currently returning the id of the marker that was clicked, correct? – SymbolixAU
that's correct, however, it's not pushing back the id – astronomerforfun
I used a rendertable so I could see the data that came back. Later I'll switch it to a graph. – astronomerforfun
so yourPoundsgraph is just displaying the id value? You need to filter your data by this id value; something like sales_data()[sales_data()$id == data$id, ] (or whichever data is is you want to filter) (I haven't run your code or tested this) – SymbolixAU
ok. Let me give it a quick try. – astronomerforfun

1 Answers

3
votes

I'm going to show you a smaller example of how this works.

Things to note

  1. Clicking on a shape / map object will return the lat, lng and id values
  2. The id value is that which you assign inside the addMarkers() call using the layerId argument
  3. You can then use this id to filter your data, assuming you've used an id value from the data as the layerId

Example

In this example I'm using a data set supplied with my googleway package

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)

enter image description here