Aggregate Weighted Linestrings for Clustered Markers in Leaflet in R

问题

I'm trying to plot locations and weighted connecting linestrings. When I zoom in or out the clustering of the markers adjusts fine. The shown labels of the clusters are the aggregated node_val of the markers.

I would like to do similar with the linestrings, so that

the plot does not show the blue lines connecting the single markers, but instead lines connecting the clusters of markers, and
the new linestrings that connect the clusters of markers are customized in width dependent on the wgt variable.

I hope the code below demonstrates the problem:

library(dplyr)
library(leaflet)
library(sf)

set.seed(123)
N <- 1000
N_conn <- 100

# data frame for points
df_points <- data.frame(id = 1:N,
                        lng = sample(c(11.579657, 16.370654), N, TRUE) + rnorm(N, 0, 0.5),
                        lat = sample(c(48.168889, 48.208087), N, TRUE) + rnorm(N, 0, 0.5),
                        node_val = sample(10, N, TRUE))


# data frame for connections
df_conn <- data.frame(id_from = sample(N_conn, replace = TRUE),
                      id_to   = sample(N_conn, replace = TRUE),
                      wgt  = abs(rnorm(N_conn)))

# drop connections where from and to ids are identical
df_conn <- subset(df_conn, id_from != id_to)

# add the coordinates for the connections (merging is not neccessary due to ordering of synth data)
df_conn$lat_from <- df_points[df_conn$id_from, "lat"]
df_conn$lng_from <- df_points[df_conn$id_from, "lng"]
df_conn$lat_to   <- df_points[df_conn$id_to, "lat"]
df_conn$lng_to   <- df_points[df_conn$id_to, "lng"]


sf_conn_from <- df_conn %>% 
  st_as_sf(coords=c("lng_from", "lat_from"))

sf_conn_to <- df_conn %>% 
  st_as_sf(coords=c("lng_to", "lat_to"))

sf_conn <- st_combine(cbind(sf_conn_from, sf_conn_to)) %>% 
  st_cast("LINESTRING")

st_crs(sf_conn) <- 4326

leaflet(df_points) %>% 
  addTiles() %>% 
  addMarkers(options = markerOptions(node_val = ~node_val), 
             label = quakes$mag,
             clusterOptions = markerClusterOptions(
               iconCreateFunction=JS("function (cluster) {    
                var markers = cluster.getAllChildMarkers();
                var sum = 0; 
                for (i = 0; i < markers.length; i++) {
                  sum += Number(markers[i].options.node_val);
                  //sum += 1;
                }
                sum = Math.round(sum);
                return new L.DivIcon({ html: '<div><span>' + sum + '</span></div>',
                  className: 'marker-cluster marker-cluster-medium', 
                  iconSize: new L.Point(40,40)});
              }")
             )) %>% 
  leafem::addFeatures(data = sf_conn,
                      color = 'blue',#~pal(rel_full$N_scale),#
                      weight = 1)

Thanks to the contributers of these two questions:

leaflet R, how to make appearance of clustered icon related to statistics of the children?
Shiny leaflet add large amount of separated polylines

回答1:

This is a partial solution for adjusting the weighting of the lines, I can't help clustering those lines :(

library(dplyr)
library(leaflet)
library(sf)

set.seed(123)
N <- 1000
N_conn <- 100

# data frame for points
df_points <- data.frame(id = 1:N,
                        lng = sample(c(11.579657, 16.370654), N, TRUE) + rnorm(N, 0, 0.5),
                        lat = sample(c(48.168889, 48.208087), N, TRUE) + rnorm(N, 0, 0.5),
                        node_val = sample(10, N, TRUE))


# data frame for connections
df_conn <- data.frame(id_from = sample(N_conn, replace = TRUE),
                      id_to   = sample(N_conn, replace = TRUE),
                      wgt  = abs(rnorm(N_conn)))

# drop connections where from and to ids are identical
df_conn <- subset(df_conn, id_from != id_to)

# add the coordinates for the connections (merging is not neccessary due to ordering of synth data)
df_conn$lat_from <- df_points[df_conn$id_from, "lat"]
df_conn$lng_from <- df_points[df_conn$id_from, "lng"]
df_conn$lat_to   <- df_points[df_conn$id_to, "lat"]
df_conn$lng_to   <- df_points[df_conn$id_to, "lng"]

geom <- lapply(1:nrow(df_conn),
  function(i)
    rbind(
      as.numeric(df_conn[i, c("lng_from","lat_from")]),
      as.numeric(df_conn[i, c("lng_to","lat_to")])
    )
) %>%
  st_multilinestring() %>%
  st_sfc(crs = 4326) %>%
  st_cast("LINESTRING")

sf_conn <- st_sf(df_conn,
                 geometry=geom)

#Modify weighting
sf_conn$cut=exp(sf_conn$wgt-1)



leaflet(df_points) %>%
  addTiles() %>%
  addMarkers(
    options = markerOptions(node_val = ~ node_val),
    label = quakes$mag,
    clusterOptions = markerClusterOptions(
      iconCreateFunction = JS(
        "function (cluster) {
                var markers = cluster.getAllChildMarkers();
                var sum = 0;
                for (i = 0; i < markers.length; i++) {
                  sum += Number(markers[i].options.node_val);
                  //sum += 1;
                }
                sum = Math.round(sum);
                return new L.DivIcon({ html: '<div><span>' + sum + '</span></div>',
                  className: 'marker-cluster marker-cluster-medium',
                  iconSize: new L.Point(40,40)});
              }"
      )
    )
  ) %>%   addPolylines(weight = sf_conn$cut,
                       data = sf_conn,
                       col = "blue")

来源：https://stackoverflow.com/questions/60436142/aggregate-weighted-linestrings-for-clustered-markers-in-leaflet-in-r

标签

leaflet

cluster-analysis