单张闪亮的地图标记 [英] Map Marker in leaflet shiny
本文介绍了单张闪亮的地图标记的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
我仍然是R-newb，但我获得了一些关注.主要是因为我正在阅读此处的所有帖子.但是，我找不到任何信息.
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.
我的追求:
当用户单击传单中的标志时，将初始化ID(我分配的)，此时我将使用该ID查询另一个datable来构建图形.
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.
我的问题是尝试使ID正常工作-似乎没有任何点击返回.我想知道是否与我的反应物无关?我之所以这样说，是因为我能够将其用于一个更简单的示例.
我突出显示并加粗了观察语句和相应的代码.
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)
推荐答案
我将向您展示一个较小的示例.
I'm going to show you a smaller example of how this works.
注意事项
- 单击形状/地图对象将返回
lat，lng和id值 -
id值是您使用layerId参数在addMarkers()调用中分配的值 - 然后，假设您已使用数据中的id值作为
layerId，则可以使用此
id来过滤数据.
- 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
示例
在此示例中，我使用的是googleway软件包随附的数据集
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)
这篇关于单张闪亮的地图标记的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
