leafgl
leafgl copied to clipboard
WIP: Fix labels/border/remove/clear-instances, **Src-functions, etc..
This PR ended up being quite substantial (initially, I just wanted to fix the labels, but I got carried away). Should I split the commits into multiple PRs?
I fixed the **Src frunctions but in my benchmarks they were always slower than the original version. Also since the **Src functions cannot be called directly anymore, I rearranged the code to not test the data/group etc twice.
I found a new JSON converter yyjsonr which appears to be much faster than jsonify (benchmarks are in ther Readme). For now it is used for all the color/label/weight/popup conversion and the point-data. It can also transform Geojson, but not in the structure expected by Leaflet.Glify. The whole {"type":"FeatureCollection","features":
overhead is missing. I tried to add the GeoJson overhead in the function yyjsonr_2_geojson
, but that doesnt seem to be faster than geojsonsf::sf_geojson
, so I commented it out.
Also in the last commit I harcoded hoverwait: 10
. Exposing this option doesn't make sense because it is a global argument. The first leafgl-layer that sets this value does so globally, and omitting it defaults to 250, which seems a bit laggy.
The compressed NEWS:
- New method
clearGlGroup
removes a group from leaflet and the Leaflet.Glify instances. - The JavaScript methods of the
removeGl**
functions were rewritten to correctly remove an element identified bylayerId
-
clearGlLayers
now correctly removes all Leaflet.Glify instances - When showing/hiding Leaflet.Glify layers, they are set to active = TRUE/FALSE to make mouseevents work again. fix #48, fix #50, fix #92
- added
popupOptions
andlabelOptions
. fix #83 - added
stroke
(default=TRUE) inaddGlPolygons
andaddGlPolygonsSrc
for drawing borders. fix #3 In the Shiny-App below you will see that the border is not always correct and polygons with holes are problematic. This PR in the upstream repo should fix this. - Labels work similar to
leaflet
.leafgl
accepts a single string, a vector of strings or a formula. fix #78 - The
...
arguments are now passed to all methods in the underlying library. This allows us to set additional arguments likefragmentShaderSource
,sensitivity
orsensitivityHover
. fix #81 - Added some @details for Shiny click and mouseover events and their corresponding input. fix #77
- Use
@inheritParams leaflet::**
for identical function arguments - unified / simplified the dependency functions/calls
- add option
leafgl_json_parser
to change JSON-parser via options. Possible values are:-
jsonify
(default) -
yyjsonr
- Custom JSON converter like
jsonlite::toJSON
for example.
-
Shiny-App to Test
## LIB & DATA ##############
library(sf)
library(shiny)
library(shinyjs)
library(leaflet)
library(leaflet.extras)
library(leafgl)
library(mapview)
options(shiny.autoreload = TRUE)
# options(leafgl_json_parser = "jsonify")
options(leafgl_json_parser = "yyjsonr")
# options(leafgl_json_parser = jsonlite::toJSON)
lines = suppressWarnings(st_cast(trails, "LINESTRING"));
lines = st_transform(lines, 4326)[1:100,]
lines$realid <- paste0("id_", 1:nrow(lines))
gadm = suppressWarnings(st_cast(st_as_sf(leaflet::gadmCHE), "POLYGON"))
gadm = st_transform(gadm, 4326)
gadm$real_id <- paste0("id_",1:nrow(gadm))
ptsdata <- breweries
ptsdata$id <- paste0(seq.int(length(ptsdata$brewery)), "_", ptsdata$brewery, "_", ptsdata$address)
pts1 <- ptsdata[1:5,]
pts2 <- ptsdata[6:224,]
SOURCEDATA = FALSE
## UI ##############
ui <- fluidPage(
useShinyjs(),
tags$head(tags$style(".inpts {display: inline-flex;}
.inpts div {padding-right: 14px;}
.labelclass {
border-radius: 8px;
font-size: 16px;
}
.popupclass pre {
color: blue;
font-size: 12px;
}
")),
div(class="inpts",
checkboxInput("border", "Border of Polygons", width = "150px", value = T),
checkboxInput("source", "Source Data", width = "150px", value = SOURCEDATA),
checkboxInput("popup", "Popup = TRUE", width = "150px", value = TRUE),
checkboxInput("popup_form", "Popup as Formula", width = "150px"),
checkboxInput("hover", "Hover", width = "150px", TRUE),
sliderInput("sensitivity", "Mouse Click sensitivity", 0.001, 1, value = 0.002, step = 0.001),
sliderInput("sensitivityHover", "Mouse Hover sensitivity", 0.001, 1, value = 0.002, step = 0.001),
sliderInput("weight", "Size/Weight", 1, 10, value = 2, step = 1),
sliderInput("opacity", "Opacity", 0.1, 1.5, value = 0.8, step = 0.1),
sliderInput("borderopacity", "Opacity (Border)", 0.1, 1.5, value = 1, step = 0.1)
),
div(class="inpts",
actionButton("hideByGroup", "hideByGroup (The Points)"),
actionButton("showByGroup", "showByGroup (The Points)"),
actionButton("clearByGroup", "clearByGroup (Points and Lines)"),
actionButton("clearByLayerId", "clearByLayerId (From Points,Lines and Polygons)"),
actionButton("clearAllGL", "clearAllGL (Delete everything)"),
actionButton("addGrp2", "Add Gl Group 2")
),
leafglOutput("map", height = 600),
splitLayout(cellWidths = c("50%", "50%"),
div(h5("Clicks"),verbatimTextOutput("click")),
div(h5("Hover"),verbatimTextOutput("hover")))
)
## SERVER ##############
server <- function(input, output, session) {
output$map <- renderLeaflet({
border = input$border
source = input$source
label = label1 = label2 = input$hover
if (label) {
label = ~NAME_1
label1 = ~brewery
label2 = ~FKN
}
popup = popup1 = popup2 = input$popup
popup_form = input$popup_form
if (popup && popup_form) {
popup = ~NAME_1
popup1 = ~address
popup2 = ~FGN
}
sensitivity = input$sensitivity
sensitivityHover = input$sensitivityHover
weight = input$weight
opacity = input$opacity
borderpacity = input$borderopacity
leaflet() %>%
addProviderTiles(provider = "CartoDB") %>%
leaflet::addMapPane("myownpane", zIndex = 490) %>%
leaflet::addMapPane("myownpane1", zIndex = 500) %>%
leaflet::addMapPane("myownpane2", zIndex = 510) %>%
leafgl::clearGlLayers() %>%
addGlPolylines(
data = lines,
layerId = lines$realid,
color = ~FKN,
opacity = opacity,
popup = popup2,
label = label2,
weight = weight,
group = "lns", pane = "myownpane2",
sensitivity = sensitivity, sensitivityHover = sensitivityHover,
labelOptions = labelOptions(opacity=0.8, textOnly = FALSE, className = "labelclass",
offset = c(10,10), direction = "left"),
popupOptions = popupOptions(maxWidth = 400, closeButton = FALSE,
closeOnClick = TRUE, className = "popupclass")) %>%
## Shapes ##########
addGlPolygons(
data = gadm,
layerId = ~real_id,
color = ~NAME_1,
fillOpacity = opacity,
popup = popup,
label = label,
stroke = border,
borderOpacity = borderpacity,
group = "polys", pane = "myownpane",
labelOptions = labelOptions(opacity=0.8, textOnly = FALSE, className = "labelclass",
direction = "left", permanent = TRUE),
popupOptions = popupOptions(maxWidth = 400, closeButton = FALSE,
closeOnClick = TRUE, className = "popupclass")) %>%
## Points ##########
addGlPoints(
data = pts2,
layerId = pts2$id,
fillColor = ~village,
fillOpacity = opacity,
popup = popup1,
label = label1,
radius = breweries$number.seasonal.beers * 4 * weight,
pane = "myownpane1", group = "pts",
labelOptions = labelOptions(opacity=0.8, textOnly = FALSE, className = "labelclass",
direction = "left"),
popupOptions = popupOptions(maxWidth = 400, closeButton = FALSE,
closeOnClick = TRUE, className = "popupclass")
) %>%
addLayersControl(
overlayGroups = c("lns", "lns2", "pts", "polys"),
options = layersControlOptions(collapsed = FALSE))
})
observeEvent(input$hideByGroup, {
leafletProxy("map", session) %>%
hideGroup("pts")
})
observeEvent(input$showByGroup, {
leafletProxy("map", session) %>%
showGroup("pts")
})
observeEvent(input$clearByGroup, {
leafletProxy("map", session) %>%
leafgl::clearGlGroup( group="lns") %>%
leafgl::clearGlGroup( group="pts")
})
observeEvent(input$clearByLayerId, {
leafletProxy("map", session) %>%
leafgl::removeGlPolylines(layerId = sample(lines$realid, 1)) %>%
leafgl::removeGlPolygons(layerId = sample(gadm$real_id, 1)) %>%
leafgl::removeGlPoints(layerId = sample(ptsdata$id, 1))
})
observeEvent(input$clearAllGL, {
leafletProxy("map", session) %>%
leafgl::clearGlLayers()
})
observeEvent(input$addGrp2, {
border = input$border
source = input$source
label = input$hover
popup = popup1 = popup2 = input$popup
popup_form = input$popup_form
if (popup && popup_form) {
popup = ~VARNAME_1
popup1 = ~address
popup2 = ~FGN
}
sensitivity = input$sensitivity
weight = input$weight
opacity = input$opacity
leafletProxy("map", session) %>%
clearGlGroup("lns2") %>%
addGlPolylines(
data = lines[1:20,],
layerId = lines$realid,
color = ~FKN,
opacity = opacity,
label = ~district,
weight = weight,
src = source,
group = "lns2",
sensitivity = sensitivity,
sensitivityHover = sensitivity
)
})
output$click <- renderPrint({
df <- req(input$map_glify_click)
message("input$map_glify_click")
print(df)
})
output$hover <- renderPrint({
df <- req(input$map_glify_mouseover)
message("input$map_glify_mouseover")
print(df)
})
}
shinyApp(ui, server)