From 6e2bd6c83a4bcbfd8143f815f25db529e3b6cc5f Mon Sep 17 00:00:00 2001 From: rCarto Date: Wed, 29 Mar 2023 14:43:28 +0200 Subject: [PATCH] fix: refactor osrmTrip() to handle points too close to each others fix #120 and better fix than the one used for #117 --- R/osrmTrip.R | 48 +++++++++++++++++++++++++++--------------------- 1 file changed, 27 insertions(+), 21 deletions(-) diff --git a/R/osrmTrip.R b/R/osrmTrip.R index f4f339c..02f91ea 100644 --- a/R/osrmTrip.R +++ b/R/osrmTrip.R @@ -57,7 +57,6 @@ osrmTrip <- function(loc, exclude = NULL, overview = "simplified", returnclass, osrm.server = getOption("osrm.server"), osrm.profile = getOption("osrm.profile")){ - opt <- options(error = NULL) on.exit(options(opt), add=TRUE) @@ -71,6 +70,7 @@ osrmTrip <- function(loc, exclude = NULL, overview = "simplified", loc <- input_route(x = loc, id = "loc", single = FALSE, all.ids = TRUE) oprj <- loc$oprj + # build url url <- paste0(url, paste(clean_coord(loc$lon) , clean_coord(loc$lat), sep=",",collapse = ";"), @@ -104,38 +104,45 @@ osrmTrip <- function(loc, exclude = NULL, overview = "simplified", # In case of island, multiple trips ntour <- dim(res$trips)[1] trips <- vector("list", ntour) - for (nt in 1:ntour) { - # nt=1 # Coordinates of the line geodf <- data.frame(res$trips[nt,]$geometry[[1]]$coordinates) + geodf$id <- 1:nrow(geodf) + # In case of unfinnish trip if (geodf[nrow(geodf),1] != geodf[1,1]) { geodf <- rbind(geodf,geodf[1,]) } - geodf$ind <- 1:nrow(geodf) + # Extract trip waypoints waypoints <- waypointsg[waypointsg$trips_index == (nt - 1),] + geodf$id_wp <- NA + waypoints <- waypoints[order(waypoints$waypoint_index, decreasing = F),] + j <- 1 + for(i in 1:(nrow(geodf)-1)){ + if (any(geodf[i, c("X1", "X2")] == waypoints[j, c("X1", "X2")])){ + geodf$id_wp[i] <- waypoints[j, "id"] + j <- j+1 + if (j>nrow(waypoints)){j = 1} + } + } - # Get points order and indexes - geodf <- merge(geodf, waypoints, - by.x = c("X1", "X2"), by.y = c("X1","X2"), - all.x = T) - geodf <- geodf[order(geodf$ind, decreasing = F),] - base_ind <- geodf[!is.na(geodf$waypoint_index),] - indexes <- aggregate(base_ind$ind, by= list(base_ind$id), head, 1)$x - indexes <- c(sort(indexes), nrow(geodf)) + if(is.na(geodf[nrow(geodf), "id_wp"])){ + geodf[nrow(geodf), "id_wp"] <- geodf[1, "id_wp"] + } + l <- list() + j <- 1 + for (i in 1:nrow(geodf)){ + if(!is.na(geodf[i, "id_wp"])){ + l[[j]] <- geodf[i, "id"] + j <- j + 1 + } + } # Build the polylines wktl <- rep(NA,nrow(waypoints)) - for (i in 1:(length(indexes) - 1)) { - ind0 <- indexes[i] - ind1 <- indexes[i+1] - if(ind1==ind0){ - aind <- rep(ind0,2) - }else{ - aind <- ind0:ind1 - } + for (i in 1:length(wktl)) { + aind <- l[[i]]:l[[i+1]] wktl[i] <- paste("LINESTRING(", paste(geodf[aind,1]," ", geodf[aind,2], @@ -158,5 +165,4 @@ osrmTrip <- function(loc, exclude = NULL, overview = "simplified", trips[[nt]] <- list(trip = sldf, summary = tripSummary) } return(trips) - }