WIP: Fix labels/border/remove/clear-instances, **Src-functions, etc..

[trafficonese]

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 by layerId
• 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 popup not working if Polylines are added twice #48, fix Popups don't work after redraw #50, fix Is it possible to have more than one pop-up in the same map? #92
• added popupOptions and labelOptions. fix add popup options #83
• added stroke (default=TRUE) in addGlPolygons and addGlPolygonsSrc for drawing borders. fix Can we draw the polygon borders? #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 Label argument not working #78
• The ... arguments are now passed to all methods in the underlying library. This allows us to set
  additional arguments like fragmentShaderSource, sensitivity or sensitivityHover. fix Clickable space of polyline pop-ups are extremely large #81
• Added some @details for Shiny click and mouseover events and their corresponding input. fix Not possible to recover layerID as in leaflet #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)

[trafficonese]

If robertleeplummerjr/Leaflet.glify#153 gets merged the clearGlLayers and clearGlGroup dont need arr.splice(i, 1); anymore

[trafficonese]

I updated Leaflet.Glify to 3.3.0 and used the new hoverOff function to remove the tooltip and expose the MAPID_glify_mouseout Shiny event.

The new version should fix #93 and fix #49

❌ The workaround explained in #49 with L.glify.Shapes.instances.splice(0, 1) has to be removed with this new version.

[trafficonese]

Here's an example Shiny-App with some street data of Vienna. You can see that the click events (leaflet and leafgl) dont return the same thing and Glify is way off now sometimes and some elements are not selectable at all anymore.

Details

library(shiny)
library(leaflet)
library(leafgl)
library(osmdata)

# streetnetwork <- opq(bbox = "Vienna") %>%
#   add_osm_feature(key = 'highway', value = "primary") %>%
#   osmdata_sf()
# streetnetworklines <- streetnetwork$osm_lines
# streetnetworklines <- streetnetworklines[,c("osm_id","name","lanes","maxspeed","ref","geometry")]

ui <- fluidPage(
  leafletOutput("map", height = 600),
  splitLayout(cellWidths = c("50%", "50%"),
              div(h5("Click-Glify"),verbatimTextOutput("click")),
              div(h5("Click-Leaflet"),verbatimTextOutput("clickleaf")))
)

server <- function(input, output, session) {
  output$map <- renderLeaflet({
    leaflet() %>%
      addProviderTiles(provider = "CartoDB") %>%
      addMapPane("labels", 500) %>% addMapPane("labels1", 600) %>%
      addPolylines(data = streetnetworklines,
                   layerId = ~osm_id, color = "blue", weight = 2, group="leaflet") %>%
      addGlPolylines(data = streetnetworklines,
                     popup=TRUE,
                     layerId = streetnetworklines$osm_id,
                     sensitivity = 0.003,
                     sensitivityHover = 0.003,
                     color = "red", weight = 1, group="Glify") %>%
      addLayersControl(overlayGroups = c("leaflet", "Glify"))
  })

  output$click <- renderPrint({
    input$map_glify_click
  })
  output$clickleaf <- renderPrint({
    input$map_shape_click
  })

  observeEvent(input$map_glify_click, {
    click <- input$map_glify_click
    df <- streetnetworklines[.subset2(streetnetworklines, "osm_id") == click[["id"]],]
    leafletProxy("map") %>% clearGroup("clickedline") %>%
      addPolylines(data = df, color="black", weight = 15, group="clickedline", opacity = 0.8,
                   label="glify_click",
                   options = pathOptions(pane = "labels1"))
  })
  observeEvent(input$map_shape_click, {
    click <- input$map_shape_click
    df <- streetnetworklines[.subset2(streetnetworklines, "osm_id") == click[["id"]],]
    leafletProxy("map") %>% clearGroup("clickedline1") %>%
      addPolylines(data = df, color="darkblue", weight = 15, group="clickedline1", opacity = 0.8,
                   label="leaflet_click",
                   options = pathOptions(pane = "labels"))
  })
}

shinyApp(ui, server)

[trafficonese]

The PR robertleeplummerjr/Leaflet.glify#157 should fix the click/hover on Lines.

[tim-salabim]

Ok, thanks for all the work on this. I'll test when I get back from a short vacation at the end of the week.

[tim-salabim]

@trafficonese I am about to merge this one. Is that ok? Or will it break things somehow?

[trafficonese]

Yes this will currently break things, as it includes the new Leaflet.Glify version. You would have to also inlcude robertleeplummerjr/Leaflet.glify#157, since it fixes the hover and click events.

With 157 merged, I think this PR should be ready to go, but it's been a while, so I would definitly run some tests.

And as a reminder:

• ❌ The workaround explained in Possible memory leak ? #49 with L.glify.Shapes.instances.splice(0, 1) has to be removed when this gets merged.
• And we are hijacking some Leaflet JS-functions (hideGroup/showGroup).. and I'm not sure what could all go wrong there.. 🤔

[tim-salabim]

Ok, then I think I'm holding off on this one for now. Let's wait until the upstream PR gets merged.
tmap needs the current dev version to be on CRAN soonish. I'll clean the main branch as much as possible and will submit as is.
Thanks for all the efforts here.