Fix major bug in plot_path for nj>1

Rafnuss · Nov 20, 2024 · a20752f · a20752f
1 parent ddbd07d
commit a20752f
Show file tree

Hide file tree

Showing 2 changed files with 33 additions and 22 deletions.
diff --git a/R/plot.map.R b/R/plot.map.R
@@ -59,8 +59,8 @@
 #' @method plot map
 #' @export
 plot.map <- function(x,
-                     thr_likelihood = 1,
                      path = NULL,
+                     thr_likelihood = 1,
                      plot_leaflet = TRUE,
                      provider = "Esri.WorldTopoMap",
                      provider_options = leaflet::providerTileOptions(),
@@ -178,22 +178,25 @@ plot.map <- function(x,
     if (!is.null(path)) {
       lmap <- plot_path_leaflet(lmap, path)
 
-      for (i in seq_len(nrow(path))) {
-        if (!is.na(path$lon[i])) {
+      for (i in seq_len(max(path$stap_id))) {
+        path_stap_id <- path[path$stap_id == i, ]
+        if (any(!is.na(path_stap_id$lon[i]))) {
           lmap <- leaflet::addCircleMarkers(
             lmap,
-            lng = path$lon[i],
-            lat = path$lat[i],
+            lng = path_stap_id$lon,
+            lat = path_stap_id$lat,
             group = grp[i],
-            radius = stap2duration(path[i, ])^(0.25) * 6,
+            radius = stap2duration(path_stap_id)^(0.25) * 6,
             stroke = TRUE,
             color = "white",
             weight = 2,
             opacity = 1,
             fill = TRUE,
             fillColor = "black",
             fillOpacity = 1,
-            label = glue::glue("#{path$stap_id[i]}, {round(stap2duration(path)[i], 1)} days")
+            label = glue::glue(
+              "#{path_stap_id$stap_id[1]}, {round(stap2duration(path_stap_id)[1], 1)} days"
+            )
           )
         }
       }

diff --git a/R/plot_path.R b/R/plot_path.R
@@ -149,34 +149,42 @@ plot_path_leaflet <- function(
   # Remove position of stap not included/not available
   path_full <- path[!is.na(path$lat), ]
 
+  # Get number of path
+  unique_j <- unique(path$j)
+
   # Plot trajectory of all available point in grey
   if (nrow(path_full) < nrow(path)) {
     polyline_full <- polyline
     # polyline_full$weight <- polyline_full$weight/2
     polyline_full$opacity <- polyline_full$opacity / 2
     polyline_full$color <- "grey"
+
+    for (j in unique_j) {
+      map <- do.call(leaflet::addPolylines, c(
+        list(
+          map = map,
+          lng = path_full$lon[path_full$j == j],
+          lat = path_full$lat[path_full$j == j],
+          group = path$j[path$j == j]
+        ),
+        polyline_full
+      ))
+    }
+  }
+
+  # Overlay with trajectory of consecutive position in black.
+  for (j in unique_j) {
     map <- do.call(leaflet::addPolylines, c(
       list(
         map = map,
-        lng = path_full$lon,
-        lat = path_full$lat,
-        group = path_full$j
+        lng = path$lon[path$j == j],
+        lat = path$lat[path$j == j],
+        group = path$j[path$j == j]
       ),
-      polyline_full
+      polyline
     ))
   }
 
-  # Overlay with trajectory of consecutive position in black.
-  map <- do.call(leaflet::addPolylines, c(
-    list(
-      map = map,
-      lng = path$lon,
-      lat = path$lat,
-      group = path$j
-    ),
-    polyline
-  ))
-
   suppressWarnings({
     map <- do.call(leaflet::addCircleMarkers, c(
       list(