R中传单中聚类标记的聚合加权线串 [英] Aggregate Weighted Linestrings for Clustered Markers in Leaflet in R

问题描述

我正在尝试绘制位置和加权连接线串.当我放大或缩小标记的聚类时，可以很好地调整.显示的集群标签是标记的聚合 node_val.

我想对线串做类似的事情，这样

1. 该图不显示连接单个标记的蓝线，而是显示连接标记簇的线，并且
2. 连接标记簇的新线串的宽度根据 wgt 变量进行自定义.

我希望下面的代码能说明问题:

库(dplyr)图书馆(传单)图书馆(旧金山)set.seed(123)N <- 1000N_conn <- 100# 点的数据框df_points <- data.frame(id = 1:N,lng = 样本(c(11.579657, 16.370654), N, TRUE) + rnorm(N, 0, 0.5),lat = 样本(c(48.168889, 48.208087), N, TRUE) + rnorm(N, 0, 0.5),node_val = sample(10, N, TRUE))# 连接数据框df_conn <- data.frame(id_from = sample(N_conn, replace = TRUE),id_to = 样本(N_conn，替换 = TRUE)，wgt = abs(rnorm(N_conn)))# 删除 from 和 to id 相同的连接df_conn <- 子集(df_conn, id_from != id_to)# 添加连接的坐标(由于合成数据的排序，不需要合并)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传单(df_points)%>%addTiles() %>%addMarkers(options = markerOptions(node_val = ~node_val),标签 = 地震$mag，clusterOptions = markerClusterOptions(iconCreateFunction=JS("函数(集群){var 标记 = cluster.getAllChildMarkers();变量总和 = 0;对于 (i = 0; i < 标记长度; i++) {sum += Number(markers[i].options.node_val);//总和 += 1;}sum = Math.round(sum);return new L.DivIcon({ html: '<div><span>' + sum + '</span></div>',className: 'marker-cluster marker-cluster-medium',图标大小:新 L.Point(40,40)});}"))) %>%Leafem::addFeatures(data = sf_conn,颜色 = '蓝色',#~pal(rel_full$N_scale),#重量 = 1)

感谢这两个问题的贡献者:

• 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

  1. the plot does not show the blue lines connecting the single markers, but instead lines connecting the clusters of markers, and
  2. 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

  解决方案

  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")
  

  这篇关于R中传单中聚类标记的聚合加权线串的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！