Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

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

Open
wants to merge 14 commits into
base: master
Choose a base branch
from
Open

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

wants to merge 14 commits into from

Conversation

trafficonese
Copy link
Collaborator

@trafficonese trafficonese commented Jun 9, 2024 •
edited
Loading

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:

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)

This was referenced Jun 9, 2024
Closed
Closed
Closed
@trafficonese
Copy link
Collaborator Author

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

tim-salabim
tim-salabim reviewed Jun 11, 2024
View reviewed changes
R/glify-helpers.R Outdated Show resolved Hide resolved
@trafficonese
Copy link
Collaborator Author

trafficonese commented Jun 23, 2024 •
edited
Loading

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 trafficonese changed the title Fix labels/border/remove/clear-instances, **Src-functions, etc.. WIP: Fix labels/border/remove/clear-instances, **Src-functions, etc.. Jun 27, 2024
@trafficonese
Copy link
Collaborator Author

trafficonese commented Jun 30, 2024 •
edited
Loading

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
Copy link
Collaborator Author

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

@tim-salabim
Copy link
Member

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.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Reviewers

@tim-salabim tim-salabim tim-salabim left review comments

Assignees
No one assigned
Labels
None yet
Projects
None yet
Milestone
No milestone
2 participants
@trafficonese @tim-salabim