Aggregate Weighted Linestrings for Clustered Markers in Leaflet in R

前端 未结 1 715
無奈伤痛
無奈伤痛 2021-01-27 08:39

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 agg

相关标签:
1条回答
  • 2021-01-27 09:40

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

    0 讨论(0)
提交回复
热议问题