Агрегированные взвешенные линейные строки для кластерных маркеров в буклете в R - PullRequest
Новая
       83

Агрегированные взвешенные линейные строки для кластерных маркеров в буклете в R

0 голосов
/ 27 февраля 2020

Я пытаюсь нанести на карту местоположения и взвешенные соединительные линии. Когда я увеличиваю или уменьшаю масштаб, кластеризация маркеров корректируется. Показанные метки кластеров являются агрегированными node_val метками.

Я хотел бы сделать то же самое с линиями линий, чтобы на графике

  1. не отображались синие линии, соединяющие отдельные маркеры, а вместо этого линии, соединяющие кластеры маркеров, и
  2. новые строки линий, соединяющие кластеры маркеров, настраиваются по ширине в зависимости от переменной wgt.

Я надеюсь, что приведенный ниже код демонстрирует проблему: 

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)

Благодаря авторам этих двух вопросов:

1 Ответ

1 голос
/ 28 февраля 2020

Это частичное решение для регулировки веса линий, я не могу не кластеризовать эти строки: (

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

enter image description here

...