leafgl icon indicating copy to clipboard operation
leafgl copied to clipboard

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

Open trafficonese opened this issue 4 weeks ago • 5 comments

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 #48, fix #50, fix #92
  • added popupOptions and labelOptions. fix #83
  • added stroke (default=TRUE) in addGlPolygons and addGlPolygonsSrc 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 like fragmentShaderSource, sensitivity or sensitivityHover. 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)

trafficonese avatar Jun 09 '24 14:06 trafficonese