Hello all,
I try to link leaflet and plotly in a shiny app in order to draw a cross on both according to the value of a variable when hover.
- When hover the leaflet map, I use the x-coordinates of mouse to define the nearest point on the plotted layer and draw cross for this point. Then I use "addTraces" to add a vertical line corresponding to the value stored in the point of the layer selected in in the leaflet map.
- In the plotly I use spikesline to draw a vertical line at the point closest to the cursor position. Then I draw polylines in the leaflet map corresponding to the value stored in the point selected in the plotly.
This solution is not effective, because very slow, when I use my data, which contains a large number of points with a much larger geographical extent.
- For plotly, The idea would be triggering mouse events in plotly with "potly.Fx.hover" in order to use spikelines which seems much faster than "addTraces". Unfortunately, I don't code in javascript although the solution seems to be oriented there.
- I would also like to speed up the plotting of polylines in the leaflet map but I have no idea of the solutions.
Here my code, where I generate data for the example:
server.r
#! ---------- SERVER
shinyServer(function(input, output, session){
#! --------------------- spatial data
#! SpatialLines
sp_line <- sp::SpatialLines(list(
sp::Lines(list(sp::Line(cbind(c(4.023027, 4.021673),
c(48.56464, 48.56466)))),
ID="1"),
sp::Lines(list(sp::Line(cbind(c(4.021673, 4.020289),
c(48.56466, 48.56378)))),
ID="2"),
sp::Lines(list(sp::Line(cbind(c(4.020289, 4.018935),
c(48.56378, 48.56380)))),
ID="3"),
sp::Lines(list(sp::Line(cbind(c(4.018935, 4.017552),
c(48.56380, 48.56292)))),
ID="4"),
sp::Lines(list(sp::Line(cbind(c(4.017552, 4.016198),
c(48.56292, 48.56294)))),
ID="5")),
proj4string = sp::CRS("+init=epsg:4326"))
#! SpatialLinesDataFrame
sp_line <- sp::SpatialLinesDataFrame(sp_line,
data = data.frame(data1 = c(1, 2, 3, 4, 5),
data2 = c(2, 20, 30, 35, 37)))
#! --------------------- reactiveValues
plotly_hover <- reactiveValues(proxy = plotly::plotlyProxy(outputId = "plot"))
leaflet <- reactiveValues(mouseover_map = NULL,
line_x1 = NULL,
line_y1 = NULL,
line_x2 = NULL,
line_y2 = NULL,
extent = NULL,
lines_intersect = NULL)
#! --------------------- PLOTLY
output$plot <- plotly::renderPlotly({
#! plot
p <- plotly::plot_ly(type = "scatter",
mode = "lines+markers",
x = sp_line@data$data1,
y = sp_line@data$data2
)
#! layout
p <- plotly::layout(p, xaxis = list(showspikes = TRUE,
showline = TRUE,
spikemode = "across",
hovermode = "x"),
yaxis = list(range = c(0, 37)))
})
#! --------------------- LEAFLET
output$map <- leaflet::renderLeaflet({
my_map <- leaflet::leaflet()
#! function to get mousemove coordinates
my_map <- htmlwidgets::onRender(my_map,
jsCode = "function(el,x){
this.on('mousemove', function(e) {
var lat = e.latlng.lat;
var lng = e.latlng.lng;
var coord = [lat, lng];
Shiny.onInputChange('hover_coordinates', coord);
Shiny.onInputChange('elem', test_hidden_value);
});
this.on('mouseout', function(e) {
Shiny.onInputChange('hover_coordinates', null)
})
}"
)
#! #! define bounds
my_map <- leaflet::fitBounds(map = my_map,
lng1 = sp_line@bbox[1,1],
lng2 = sp_line@bbox[1,2],
lat1 = sp_line@bbox[2,1],
lat2 = sp_line@bbox[2,2])
#! ajoute le trace du cours deau choisi from points
my_map <- leaflet::addPolylines(map = my_map,
data = sp_line,
group = "sp_line",
layerId = sp_line@data$data1)
})
###########################################
#!
#! ---------- observe
#!
###########################################
observe({
leaflet$extent <- input$map_bounds
})
###########################################
#!
#! ---------- observeEvent : PLOTLY HOVER
#!
###########################################
toListen_plotly_hover <- reactive({
list(plotly::event_data(event = "plotly_hover"))
})
observeEvent(toListen_plotly_hover(), {
#! save plotly_hover value
hover_data <- plotly::event_data(event = "plotly_hover")$x
#! if null
if(is.null(hover_data)){
map <- leaflet::leafletProxy(mapId = "map")
map <- leaflet::clearGroup(map = map, group = "line_temp_x")
map <- leaflet::clearGroup(map = map, group = "line_temp_y")
return()
}
#! --------------------- LEAFLET
map <- leaflet::leafletProxy(mapId = "map")
#! ind shp where sp_line$data1 == plotly_hover$data1
ind <- which(sp_line@data$data1 == hover_data)
#! horizontal line
leaflet$line_y <- data.frame(lng = c(leaflet$extent$west,
leaflet$extent$east),
lat = c(sp_line@lines[[ind]]@Lines[[1]]@coords[1,2],
sp_line@lines[[ind]]@Lines[[1]]@coords[1,2]))
#! vertical line
leaflet$line_x <- data.frame(lng = c(sp_line@lines[[ind]]@Lines[[1]]@coords[1,1],
sp_line@lines[[ind]]@Lines[[1]]@coords[1,1]),
lat = c(leaflet$extent$south, leaflet$extent$north))
#! clear previous lines
map <- leaflet::clearGroup(map = map, group = "line_temp_y")
map <- leaflet::clearGroup(map = map, group = "line_temp_x")
#! new horizontal line
map <- leaflet::addPolylines(map = map,
lng = ~lng,
lat = ~lat,
data = leaflet$line_y,
group = "line_temp_y")
#! new vertical line
map <- leaflet::addPolylines(map = map,
lng = ~lng,
lat = ~lat,
data = leaflet$line_x,
group = "line_temp_x")
}) #!end observeEvent plotly hover
##########################################
#!
#! ---------- observeEvent : MOUSEOVER MAP
#!
###########################################
toListen_mouseover_map <- reactive({
list(input$hover_coordinates)
})
observeEvent(toListen_mouseover_map(), {
leaflet$mouseover_map <- as.numeric(input$hover_coordinates)
#! --------------------- if coordinates null
if(is.null(input$hover_coordinates)){
#! leaflet
map <- leaflet::leafletProxy(mapId = "map")
map <- leaflet::clearGroup(map = map, group = "line_temp_y")
map <- leaflet::clearGroup(map = map, group = "line_temp_x")
#! plotly
plotly_hover$proxy <- plotly::plotlyProxyInvoke(p = plotly_hover$proxy,
method = "deleteTraces",
list(as.integer(1)))
return(NULL)
}
#! --------------------- when mouse within bbox of sp_line
if(leaflet$mouseover_map[2] >= sp_line@bbox[1] & leaflet$mouseover_map[2] <= sp_line@bbox[3]){
#! create vertical line to cursor x coordinates
vertical_line_cursor <- sp::SpatialLines(list(
sp::Lines(list(sp::Line(cbind(c(leaflet$mouseover_map[2],
leaflet$mouseover_map[2]),
c(leaflet$extent$south,
leaflet$extent$north)))),
ID="1")),
proj4string = sp::CRS("+init=epsg:4326"))
leaflet$lines_intersect <- sp_line[which(rgeos::gIntersects(sp_line,
vertical_line_cursor, byid = TRUE)), ]
#! --------------------- LEAFLET
map <- leaflet::leafletProxy(mapId = "map")
#! vertical line
leaflet$line_y1 <- data.frame(lng = c(leaflet$extent$west, leaflet$extent$east),
lat = c(leaflet$lines_intersect@lines[[1]]@Lines[[1]]@coords[1,2],
leaflet$lines_intersect@lines[[1]]@Lines[[1]]@coords[1,2]))
#! horizontal line
leaflet$line_x1 <- data.frame(lat = c(leaflet$extent$south, leaflet$extent$north),
lng = c(leaflet$lines_intersect@lines[[1]]@Lines[[1]]@coords[1,1],
leaflet$lines_intersect@lines[[1]]@Lines[[1]]@coords[1,1]))
#! check if lines are different to avoid multiple draw
if(!identical(leaflet$line_y1, leaflet$line_y2) | !identical(leaflet$line_x1, leaflet$line_x2)){
map <- leaflet::clearGroup(map = map, group = "line_temp_y")
map <- leaflet::clearGroup(map = map, group = "line_temp_x")
#! vertical line
map <- leaflet::addPolylines(map = map,
lng = ~lng,
lat = ~lat,
data = leaflet$line_y1,
group = "line_temp_y")
#! horizontal line
map <- leaflet::addPolylines(map = map,
lng = ~lng,
lat = ~lat,
data = leaflet$line_x1,
group = "line_temp_x")
leaflet$line_y2 <- leaflet$line_y1
leaflet$line_x2 <- leaflet$line_x1
#! --------------------- PLOTLY
#! delete previous line
plotly_hover$proxy <- plotly::plotlyProxyInvoke(p = plotly_hover$proxy, method = "deleteTraces",
list(as.integer(1)))
#! draw vertical line to follow leaflet position
plotly_hover$proxy <- plotly::plotlyProxyInvoke(p = plotly_hover$proxy, method = "addTraces",
list(x =c(leaflet$lines_intersect@data$data1,
leaflet$lines_intersect@data$data1),
y = c(0,37),
type = "scatter",
mode = "lines"
))
} #! end if identical
#! if no lines intersected
}else{
#! --------------------- LEAFLET
#! vertical line
leaflet$line_x1 <- data.frame(lng = c(leaflet$mouseover_map[2], leaflet$mouseover_map[2]),
lat = c(leaflet$extent$south, leaflet$extent$north))
map <- leaflet::leafletProxy(mapId = "map")
map <- leaflet::clearGroup(map = map, group = "line_temp_x")
map <- leaflet::clearGroup(map = map, group = "line_temp_y")
#! vertical line
map <- leaflet::addPolylines(map = map,
lng = ~lng,
lat = ~lat,
data = leaflet$line_x1,
group = "line_temp_x")
#! --------------------- PLOTLY
plotly_hover$proxy <- plotly::plotlyProxyInvoke(p = plotly_hover$proxy,
method = "deleteTraces",
list(as.integer(1)))
} #! end else
}) #!end observeEvent MOUSEOVER MAP
}) #! end shinyserver
ui.r
#! --------------------- UI
shinyUI(
fluidPage(
mainPanel(
leaflet::leafletOutput(outputId = "map"),
plotly::plotlyOutput(outputId = "plot")
)
) #! end fluidPage
) #! end shinyUI
Thank you very much in advance if someone can provide me with a solution to this problem.
Regards,
Benoît