rshinyr-leaflet
Map Marker in leaflet shiny
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)
Solution
I'm going to show you a smaller example of how this works.
Things to note
- Clicking on a shape / map object will return the
lat,lngandidvalues - The
idvalue is that which you assign inside theaddMarkers()call using thelayerIdargument - You can then use this
idto filter your data, assuming you've used an id value from the data as thelayerId
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)
- Turn dataframe with frequency into a frequency table for chi-square test
- Print result of a function in R
- dplyr is turning dates to doubles when mutating dataframe
- How to require user authentication in R Shiny before users see any part of the app using shinyauthr?
- Determine foreground / background colour in bslib app with dark/light mode
- R quanteda kwic not matching negative look behind pattern
- make ggplot legend correspond to geom type
- Preserve xy coordinates while using terra::extract with vector data
- Grepl with logical operator AND across multiple alphanumeric columns
- Newey-West error for multiple linear regressions
- Looping over variables in ggplot
- data.frame rows to a list
- Calculate svymean for variable within user-defined function called by mutate(), across(), with variable name as function parameter
- Dual axis graph, keep original scale
- creating a Instrument variable formula form formula object
- Create a straight edge between nodes if there is another node branching from the midpoint of the edge in DiagrammeR?
- Compose long character string in R across multiple lines but without functions or line breaks
- Using R Quarto to create PDF documents, how can I center code chunk output and add a background color?
- Create a gif from a series of Leaflet maps in R
- How to reduce vertical margin between rows in ggplot legend
- Importing a scatter plot from PDF into R
- How to remove background of images with the magick package?
- saveGIF() returns empty GIF
- Writing multiple images using Magick on R
- How to repair obscured blocks in a QR code image
- Join multiple rasters at specific locations, when the number of rasters is variable
- Creating animation (.gif) in R using .png files
- Forest plot images cut off on all sides
- R - select last 2 columns
- Why is step_cut from R's recipes package complaining about a factor in my data frame?