From c36501d8ea0cab6cdcb3e5123452bb4c18599aac Mon Sep 17 00:00:00 2001 From: GrouchyPenguin Date: Fri, 4 Jun 2021 10:47:27 -0700 Subject: [PATCH 1/8] Bug fixes and optimizations (#1) * Bug fixes and optimizations * Cleanup --- R/main.R | 73 ++++++++++++++++++++++++++++++++++++-------------------- 1 file changed, 47 insertions(+), 26 deletions(-) diff --git a/R/main.R b/R/main.R index a3d2d25..80f9d05 100644 --- a/R/main.R +++ b/R/main.R @@ -1,6 +1,6 @@ MIN_PHOTO_INTERVAL = 2 DIAG_35MM = sqrt(36^2 + 24^2) # Classical 35mm film diagonal - +MAX_WAYPOINTS = 99 #' Function to generate Litchi csv flight plan #' @@ -208,24 +208,33 @@ litchi.plan = function(roi, output, } waypoints = wptsMatrix + # Break if distance greater than the maxWaypointDistance - waypointsXY = waypoints[, c("x", "y")] - distances = sqrt(diff(waypoints$x)**2 + diff(waypoints$y)**2) - breakIdx = distances > max.waypoints.distance - - newSize = nrow(waypoints) + sum(breakIdx) - if (newSize != nrow(waypoints)) { - midpoints = (waypointsXY[breakIdx,] + waypointsXY[-1,][breakIdx,])/2 - waypoints2 = data.frame(x = numeric(newSize), - y = numeric(newSize), - isCurve = FALSE, - takePhoto = TRUE) - - pos = seq_along(breakIdx)[breakIdx] - idx = pos + order(pos) - waypoints2[idx,1:2] = midpoints - waypoints2[-idx,] = waypoints - waypoints = waypoints2 + # A single pass only adds one intermediate waypoint even if a leg is longer than max, but more than one intermediate point may be needed. + # We can iterate this process as a temp fix but we may be adding more intermediate waypoints than strictly necessary--e.g. when 2 intermediate points will suffice we will get 3. + retest = TRUE + while (retest) { + waypointsXY = waypoints[, c("x", "y")] + distances = sqrt(diff(waypoints$x)**2 + diff(waypoints$y)**2) + breakIdx = distances > max.waypoints.distance + + newSize = nrow(waypoints) + sum(breakIdx) + if (newSize != nrow(waypoints)) { + midpoints = (waypointsXY[breakIdx,] + waypointsXY[-1,][breakIdx,])/2 + waypoints2 = data.frame(x = numeric(newSize), + y = numeric(newSize), + isCurve = FALSE, + takePhoto = TRUE) + + pos = seq_along(breakIdx)[breakIdx] + idx = pos + order(pos) + waypoints2[idx,1:2] = midpoints + waypoints2[-idx,] = waypoints + waypoints = waypoints2 + } + else { + retest = FALSE + } } @@ -255,7 +264,8 @@ litchi.plan = function(roi, output, dfLitchi$heading.deg. = c(finalHeading, 90) dfLitchi$curvesize.m. = 0 dfLitchi$curvesize.m.[waypoints$isCurve==1] = flightLineDistance*0.5 - dfLitchi$photo_distinterval = flight.params@ground.height + dfLitchi$photo_distinterval = flight.params@photo.interval * flightSpeedMs + dfLitchi$photo_timeinterval = flight.params@photo.interval dfLitchi$gimbalpitchangle = gimbal.pitch.angle @@ -266,9 +276,9 @@ litchi.plan = function(roi, output, finalSize = nrow(dfLitchi) totalFlightTime = flightTime[finalSize] dfLitchi$split = 1 - if (totalFlightTime > max.flight.time) { + if ((totalFlightTime > max.flight.time) || (nrow(waypoints) > MAX_WAYPOINTS)) { indexes = seq_len(finalSize) - nBreaks = ceiling(totalFlightTime/max.flight.time) + nBreaks = max(ceiling(totalFlightTime/max.flight.time), ceiling(nrow(waypoints)/MAX_WAYPOINTS)) breaks = seq(0, flightTime[finalSize], length.out = nBreaks+1)[c(-1, -nBreaks-1)] endWaypointsIndex = indexes[waypoints$isCurve & (seq_len(finalSize) %% 2 == 0)] endWaypoints = flightTime[waypoints$isCurve & (seq_len(finalSize) %% 2 == 0)] @@ -278,10 +288,16 @@ litchi.plan = function(roi, output, dfLitchi$split = rep(1:nBreaks, diff(c(0, waypointsBreak, finalSize))) splits = split.data.frame(dfLitchi, f = dfLitchi$split) - message("Your flight was splitted in ", length(splits), " splits, -because the total time would be ", round(totalFlightTime, 2), " minutes.") - message("They were saved as:") - first = substr(output, 1, nchar(output)-4) + if (nrow(waypoints) > MAX_WAYPOINTS) { + message("Your flight was split into ", length(splits), " sub-flights, +because the number of waypoints ", nrow(waypoints), " exceeds the maximum of ", MAX_WAYPOINTS, ".") + } + else { + message("Your flight was split into ", length(splits), " sub-flights, +because the total flight time of ", round(totalFlightTime, 2), " minutes exceeds the max of ", max.flight.time, " minutes.") + } + message("The flights were saved as:") + first = paste(substr(output, 1, nchar(output)-4), "_") second = substr(output, nchar(output)-3, nchar(output)) for (dataSplit in splits) { i = dataSplit[1, ]$split @@ -289,7 +305,7 @@ because the total time would be ", round(totalFlightTime, 2), " minutes.") write.csv(dataSplit[,-ncol(dataSplit)], output2, row.names = FALSE) message(output2) } - output2 = paste0(first, "_entire", second) + output2 = paste0(first, "entire", second) write.csv(dfLitchi, output2, row.names = FALSE) message("The entire flight plan was saved as:") message(output2) @@ -313,9 +329,14 @@ because the total time would be ", round(totalFlightTime, 2), " minutes.") message("Photo interval: ", appendLF = FALSE) message(flight.params@photo.interval, appendLF = FALSE) message(" s") + message("Photo distance: ", appendLF = FALSE) + message(flight.params@photo.interval * flight.params@flight.speed.kmh / 3.6, appendLF = FALSE) + message(" m") message("Flight speed: ", appendLF = FALSE) message(round(flight.params@flight.speed.kmh, 4), appendLF = FALSE) message(" km/h") + message("Total number of waypoints", appendLF = FALSE) + message(nrow(waypoints)) message("Flight lines angle: ", appendLF = FALSE) message(round(alpha, 4)) message('Total flight time: ', appendLF = FALSE) From 2a13f7eadebc761fc1aa564c10b01a2c97dbd762 Mon Sep 17 00:00:00 2001 From: GrouchyPenguin Date: Mon, 7 Jun 2021 15:25:02 -0700 Subject: [PATCH 2/8] Launch gimbal agl handling (#2) * Bug fixes and optimizations * Cleanup * Add launch point, gimbal and agl handling --- R/main.R | 25 +++++++++++++++++++++++-- 1 file changed, 23 insertions(+), 2 deletions(-) diff --git a/R/main.R b/R/main.R index 80f9d05..99411b7 100644 --- a/R/main.R +++ b/R/main.R @@ -61,7 +61,7 @@ MAX_WAYPOINTS = 99 litchi.plan = function(roi, output, flight.params, gimbal.pitch.angle = -90, flight.lines.angle = -1, max.waypoints.distance = 2000, - max.flight.time = 15, starting.point = 1) { + max.flight.time = 15, starting.point = 1, launch = list(0, 0)) { # Check parameters if (class(roi)[1] != "SpatialPolygonsDataFrame") stop("ROI is not a valid polygon layer") @@ -111,6 +111,13 @@ litchi.plan = function(roi, output, # Switch position of the first point + if (starting.point == 0) { + # In this case we will automatically pick the best starting point + # TODO check if launch is valid and not (0,0) + # TODO figure out closest corner in shape to launch point and then set starting.point to 1-4 + starting.point == 1 + } + if (starting.point == 2) { yHeights = c(heightPHalf, heightMHalf) } else if (starting.point == 3) { @@ -209,6 +216,17 @@ litchi.plan = function(roi, output, waypoints = wptsMatrix + # Check if launch point has been specified before inserting it as way-point 1 + if ((launch[1] == 0) && (launch[2] == 0)) { + message("No launch point specified") + } else { + launchdf = data.frame(launch[1], launch[2], FALSE, FALSE) + names(launchdf) = c("x", "y", "isCurve", "takePhoto") + tempdf = rbind(launchdf, waypoints) + waypoints = tempdf + } + + # Break if distance greater than the maxWaypointDistance # A single pass only adds one intermediate waypoint even if a leg is longer than max, but more than one intermediate point may be needed. # We can iterate this process as a temp fix but we may be adding more intermediate waypoints than strictly necessary--e.g. when 2 intermediate points will suffice we will get 3. @@ -260,6 +278,7 @@ litchi.plan = function(roi, output, dfLitchi$latitude = lats dfLitchi$longitude = lngs dfLitchi$altitude.m. = flight.params@height + dfLitchi$altitudemode = 1 dfLitchi$speed.m.s. = flightSpeedMs dfLitchi$heading.deg. = c(finalHeading, 90) dfLitchi$curvesize.m. = 0 @@ -267,6 +286,8 @@ litchi.plan = function(roi, output, dfLitchi$photo_distinterval = flight.params@photo.interval * flightSpeedMs dfLitchi$photo_timeinterval = flight.params@photo.interval dfLitchi$gimbalpitchangle = gimbal.pitch.angle + dfLitchi$actiontype1 = 5 + dfLitchi$actionparam1 = gimbal.pitch.angle # Split the flight if is too long @@ -297,7 +318,7 @@ because the number of waypoints ", nrow(waypoints), " exceeds the maximum of ", because the total flight time of ", round(totalFlightTime, 2), " minutes exceeds the max of ", max.flight.time, " minutes.") } message("The flights were saved as:") - first = paste(substr(output, 1, nchar(output)-4), "_") + first = paste0(substr(output, 1, nchar(output)-4), "_") second = substr(output, nchar(output)-3, nchar(output)) for (dataSplit in splits) { i = dataSplit[1, ]$split From 7d0c387a48836a5cd25e79f5fd51be0113f93a23 Mon Sep 17 00:00:00 2001 From: GrouchyPenguin Date: Wed, 9 Jun 2021 09:39:51 -0700 Subject: [PATCH 3/8] Photo interval handling and max-gsd input (#3) --- R/main.R | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) diff --git a/R/main.R b/R/main.R index 99411b7..792516d 100644 --- a/R/main.R +++ b/R/main.R @@ -260,6 +260,7 @@ litchi.plan = function(roi, output, transform = rgdal::rawTransform(roi@proj4string@projargs, wgs84, n=nrow(waypoints), x=waypoints[,1], y=waypoints[,2]) lats = transform[[2]] lngs = transform[[1]] + photos = waypoints[,4] graphics::plot(waypoints[,1:2]) graphics::polygon(roi@polygons[[1]]@Polygons[[1]]@coords) @@ -283,8 +284,8 @@ litchi.plan = function(roi, output, dfLitchi$heading.deg. = c(finalHeading, 90) dfLitchi$curvesize.m. = 0 dfLitchi$curvesize.m.[waypoints$isCurve==1] = flightLineDistance*0.5 - dfLitchi$photo_distinterval = flight.params@photo.interval * flightSpeedMs - dfLitchi$photo_timeinterval = flight.params@photo.interval + dfLitchi$photo_distinterval = flight.params@photo.interval * flightSpeedMs * photos + dfLitchi$photo_timeinterval = flight.params@photo.interval * photos dfLitchi$gimbalpitchangle = gimbal.pitch.angle dfLitchi$actiontype1 = 5 dfLitchi$actionparam1 = gimbal.pitch.angle @@ -401,7 +402,8 @@ flight.parameters = function( image.height.px = 3000, side.overlap = 0.8, front.overlap = 0.8, - flight.speed.kmh = 54) { + flight.speed.kmh = 54, + max.gsd = 0) { if (is.na(gsd) == is.na(height)) { stop("You must specify either gsd or height!") @@ -413,6 +415,14 @@ flight.parameters = function( mult.factor = (height / focal.length35) diag.ground = DIAG_35MM * mult.factor gsd = diag.ground / image.diag.px * 100 + if ((max.gsd != 0) && (gsd > max.gsd)) { + height = height * max.gsd / gsd + message("GSD of ", gsd, " is above target of ", max.gsd, " so adjusting height down to ", height) + mult.factor = (height / focal.length35) + diag.ground = DIAG_35MM * mult.factor + gsd = diag.ground / image.diag.px * 100 + message("Final GSD is ", gsd) + } groundWidth = image.width.px * gsd / 100 } else { groundWidth = image.width.px * gsd / 100 From dc04d13347c315f8932febc98180bfc5abc4d63d Mon Sep 17 00:00:00 2001 From: GrouchyPenguin Date: Wed, 9 Jun 2021 15:27:38 -0700 Subject: [PATCH 4/8] Allow 1/10 second photo interval resolution (#4) --- R/main.R | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) diff --git a/R/main.R b/R/main.R index 792516d..331a0f2 100644 --- a/R/main.R +++ b/R/main.R @@ -115,6 +115,7 @@ litchi.plan = function(roi, output, # In this case we will automatically pick the best starting point # TODO check if launch is valid and not (0,0) # TODO figure out closest corner in shape to launch point and then set starting.point to 1-4 + # But until then, just use and set default value starting.point == 1 } @@ -447,16 +448,22 @@ flight.parameters = function( groundAllowedOffset = groundHeight - groundHeightOverlap photoInterval = groundAllowedOffset / flightSpeedMs if (photoInterval < MIN_PHOTO_INTERVAL) { - photoInterval = 2 + photoInterval = MIN_PHOTO_INTERVAL flightSpeedMs = groundAllowedOffset / photoInterval - flight.speed.kmh = flightSpeedMs*3.6 + flight.speed.kmh = flightSpeedMs * 3.6 warning(paste0("Speed had to be lowered because frequency of photos would be too high - New speed: ", flight.speed.kmh, "km/h")) - } else if ((photoInterval %% 1) > 1e-4) { - photoInterval = ceiling(photoInterval) + New speed: ", flight.speed.kmh, " km/h")) + # Repeat as a Warning message because warnings are not always getting through + message("WARNING: Speed had to be lowered because frequency of photos would be too high + New speed: ", flight.speed.kmh, " km/h") + } else if ((photoInterval %% .1) > 1e-4) { + # Allow 0.1s resolution because integer seconds blocks useful drone speeds + photoInterval = ceiling(photoInterval * 10) / 10 flightSpeedMs = groundAllowedOffset / photoInterval flight.speed.kmh = flightSpeedMs*3.6 - warning(paste0("Speed lowered to ", flight.speed.kmh, "km/h to round up photo interval time\n")) + warning(paste0("Speed lowered to ", flight.speed.kmh, " km/h to round up photo interval time to ", photoInterval, " seconds")) + # Repeat as a Warning message because warnings are not always getting through + message("WARNING: Speed lowered to ", flight.speed.kmh, " km/h to round up photo interval time to ", photoInterval, " seconds") } params = methods::new("Flight Parameters") From 4ca5feaa5d8810fb6c9b3463098d69db6eafc2d2 Mon Sep 17 00:00:00 2001 From: GrouchyPenguin Date: Thu, 17 Jun 2021 16:30:24 -0700 Subject: [PATCH 5/8] Add warning when height is lowered for max gsd (#5) --- R/main.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/main.R b/R/main.R index 331a0f2..ea8fe20 100644 --- a/R/main.R +++ b/R/main.R @@ -418,7 +418,9 @@ flight.parameters = function( gsd = diag.ground / image.diag.px * 100 if ((max.gsd != 0) && (gsd > max.gsd)) { height = height * max.gsd / gsd - message("GSD of ", gsd, " is above target of ", max.gsd, " so adjusting height down to ", height) + warning(paste0("GSD of ", gsd, " is above target of ", max.gsd, " so adjusting height down to ", height)) + # Repeat as a Warning message because warnings are not always getting through + message("WARNING: GSD of ", gsd, " is above target of ", max.gsd, " so adjusting height down to ", height) mult.factor = (height / focal.length35) diag.ground = DIAG_35MM * mult.factor gsd = diag.ground / image.diag.px * 100 From fed8f6928aef89eb5d7884b6001b7e16f0ec4bfd Mon Sep 17 00:00:00 2001 From: GrouchyPenguin Date: Tue, 6 Jul 2021 08:59:48 -0700 Subject: [PATCH 6/8] Remove launch leg from max_leg checks (#6) --- R/main.R | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/R/main.R b/R/main.R index ea8fe20..939fd03 100644 --- a/R/main.R +++ b/R/main.R @@ -217,17 +217,6 @@ litchi.plan = function(roi, output, waypoints = wptsMatrix - # Check if launch point has been specified before inserting it as way-point 1 - if ((launch[1] == 0) && (launch[2] == 0)) { - message("No launch point specified") - } else { - launchdf = data.frame(launch[1], launch[2], FALSE, FALSE) - names(launchdf) = c("x", "y", "isCurve", "takePhoto") - tempdf = rbind(launchdf, waypoints) - waypoints = tempdf - } - - # Break if distance greater than the maxWaypointDistance # A single pass only adds one intermediate waypoint even if a leg is longer than max, but more than one intermediate point may be needed. # We can iterate this process as a temp fix but we may be adding more intermediate waypoints than strictly necessary--e.g. when 2 intermediate points will suffice we will get 3. @@ -257,6 +246,17 @@ litchi.plan = function(roi, output, } + # Check if launch point has been specified before inserting it as way-point 1 + if ((launch[1] == 0) && (launch[2] == 0)) { + message("No launch point specified") + } else { + launchdf = data.frame(launch[1], launch[2], FALSE, FALSE) + names(launchdf) = c("x", "y", "isCurve", "takePhoto") + tempdf = rbind(launchdf, waypoints) + waypoints = tempdf + } + + # Transform to WGS84 latitude and longitude transform = rgdal::rawTransform(roi@proj4string@projargs, wgs84, n=nrow(waypoints), x=waypoints[,1], y=waypoints[,2]) lats = transform[[2]] From a4a8c7f8d50f03d29ddd65d73815aee0faebd55b Mon Sep 17 00:00:00 2001 From: GrouchyPenguin Date: Thu, 8 Jul 2021 17:14:37 -0700 Subject: [PATCH 7/8] Fix quantization error in path widths (#7) --- R/main.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/main.R b/R/main.R index 939fd03..bd71ef4 100644 --- a/R/main.R +++ b/R/main.R @@ -96,6 +96,8 @@ litchi.plan = function(roi, output, # based on angle and width/height offsets # width offsets (between flightlines) nLines = ceiling(width / flightLineDistance) + 1 + # Then need to update flightLineDistance to avoid offset/quantization errors + flightLineDistance = width / (nLines - 1) xWidths = (-nLines/2):(nLines/2) * flightLineDistance xWidths = rep(xWidths, each=2) From 1b43add396c8ed9020c1f06863d4e7c8aef7355d Mon Sep 17 00:00:00 2001 From: evanmoss Date: Tue, 27 Jul 2021 04:01:46 -0700 Subject: [PATCH 8/8] Support custom launch in sub missionsush --- DESCRIPTION | 6 +-- R/main.R | 118 ++++++++++++++++++++++++++++++++++++++++++++++++---- R/utils.R | 2 +- 3 files changed, 114 insertions(+), 12 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index db01147..07fcf6c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: flightplanning Type: Package -Title: UAV Flight Planning -Version: 0.8.4 +Title: Hivemapper/UAV Flight Planning +Version: 0.8.14 Authors@R: c( person("Caio", "Hamamura", email = "caiohamamura@gmail.com", role = c("aut", "cre")), person("Danilo Roberti Alves de", "Almeida", email = "daniloflorestas@gmail.com", role = c("aut")), @@ -22,5 +22,3 @@ License: MIT + file LICENSE Encoding: UTF-8 LazyData: true RoxygenNote: 7.1.0 -URL: https://github.com/caiohamamura/flightplanning-R -BugReports: https://github.com/caiohamamura/flightplanning-R/issues diff --git a/R/main.R b/R/main.R index bd71ef4..32134b0 100644 --- a/R/main.R +++ b/R/main.R @@ -2,6 +2,23 @@ MIN_PHOTO_INTERVAL = 2 DIAG_35MM = sqrt(36^2 + 24^2) # Classical 35mm film diagonal MAX_WAYPOINTS = 99 +# Calculate distance in meters between two points +earth.dist <- function (long1, lat1, long2, lat2) +{ + rad <- pi/180 + a1 <- lat1 * rad + a2 <- long1 * rad + b1 <- lat2 * rad + b2 <- long2 * rad + dlon <- b2 - a2 + dlat <- b1 - a1 + a <- (sin(dlat/2))^2 + cos(a1) * cos(b1) * (sin(dlon/2))^2 + c <- 2 * atan2(sqrt(a), sqrt(1 - a)) + R <- 6378.145 + d <- R * c + return(d * 1000) +} + #' Function to generate Litchi csv flight plan #' #' @@ -249,13 +266,12 @@ litchi.plan = function(roi, output, # Check if launch point has been specified before inserting it as way-point 1 - if ((launch[1] == 0) && (launch[2] == 0)) { - message("No launch point specified") + hasCustomLaunch = (launch[1] != 0) || (launch[2] != 0) + if (hasCustomLaunch) { + message("Launch point specified: ", launch[1], ',', launch[2]) + MAX_WAYPOINTS = MAX_WAYPOINTS - 1 } else { - launchdf = data.frame(launch[1], launch[2], FALSE, FALSE) - names(launchdf) = c("x", "y", "isCurve", "takePhoto") - tempdf = rbind(launchdf, waypoints) - waypoints = tempdf + message("No launch point specified") } @@ -293,7 +309,6 @@ litchi.plan = function(roi, output, dfLitchi$actiontype1 = 5 dfLitchi$actionparam1 = gimbal.pitch.angle - # Split the flight if is too long dists = sqrt(diff(waypoints[,1])**2+diff(waypoints[,2])**2) distAcum = c(0,cumsum(dists)) @@ -313,11 +328,100 @@ litchi.plan = function(roi, output, dfLitchi$split = rep(1:nBreaks, diff(c(0, waypointsBreak, finalSize))) splits = split.data.frame(dfLitchi, f = dfLitchi$split) + + if (hasCustomLaunch) { + p0x = launch[[1]][1] + p0y = launch[[2]][1] + + message("adding custom launch point to submissions") + + launch84 = rgdal::rawTransform(roi@proj4string@projargs, wgs84, as.integer(1), launch[[1]], launch[[2]]) + + overage = NULL + + for (i in 1:length(splits)) { + message("starting ", i) + if (!is.null(overage)) { + message("setting ", i, " to ", "overage (", nrow(overage), ") and ", nrow(splits[[i]])) + splits[[i]] = rbind(overage, splits[[i]]) + } + + mercator = rgdal::rawTransform(wgs84, roi@proj4string@projargs, nrow(splits[[i]]), splits[[i]]$longitude, splits[[i]]$latitude) + p1x = mercator[[1]][1] + p1y = mercator[[2]][1] + dx = p1x - p0x + dy = p1y - p0y + distance = earth.dist(launch84[[1]][1], launch84[[2]][1], splits[[i]]$longitude[1], splits[[i]]$latitude[1]) + + interpPtsToAdd = floor(distance / max.waypoints.distance) + nPtsToAdd = 1 + interpPtsToAdd + + message("adding ", nPtsToAdd, " points") + + ptsToAdd = rbind(splits[[1]][1:nPtsToAdd,]) + ptsToAdd$split <- i + ptsToAdd$curvesize.m. <- 0 + ptsToAdd$photo_distinterval <- 0 + ptsToAdd$photo_timeinterval <- 0 + + toConvert = data.frame( + lat = numeric(nPtsToAdd), + lon = numeric(nPtsToAdd) + ) + + toConvert[1,] = c(p0x, p0y) + if (nPtsToAdd > 1) { + for (j in 2:nPtsToAdd) { + toConvert[j,] <- c(p0x + ((j - 1) / nPtsToAdd) * dx, p0y + ((j - 1) / nPtsToAdd) * dy) + } + } + + wgs84D = rgdal::rawTransform(roi@proj4string@projargs, wgs84, nrow(toConvert), toConvert$lat, toConvert$lon) + + ptsToAdd$latitude = wgs84D[[2]] + ptsToAdd$longitude = wgs84D[[1]] + + splitSize = nrow(splits[[i]]) + totalSize = splitSize + nPtsToAdd + rem = 0 + if (totalSize > MAX_WAYPOINTS + 1) { + rem = totalSize - (MAX_WAYPOINTS + 1) + } + + if (rem > 0) { + message("setting overage to ", splitSize + 1 - rem, " : ", splitSize) + message(class(splits[[i]])) + message(splits[[i]][splitSize + 1 - rem:splitSize,]) + message(colnames(splits[[i]])) + message(splits[[i]]) + message(colnames(splits[[i]][splitSize + 1 - rem:splitSize,])) + message(rownames(splits[[i]][splitSize + 1 - rem:splitSize,])) + overage = rbind(splits[[i]][splitSize + 1 - rem:splitSize,]) + message("overage has ", nrow(overage)) + message(overage) + message(overage[splitSize + 1 - rem: splitSize,]) + } else { + message("setting overage to NULL") + overage = NULL + } + + message("setting ", i, " to ptsToAdd (", nrow(ptsToAdd), ") + splits 1 : ", splitSize - rem) + splits[[i]] = rbind(ptsToAdd, splits[[i]][1:splitSize - rem,]) + } + + if (!is.null(overage)) { + newIdx = length(splits) + 1 + splits[[newIdx]] = rbind(overage) + splits[[newIdx]]$split = newIdx + } + } + if (nrow(waypoints) > MAX_WAYPOINTS) { message("Your flight was split into ", length(splits), " sub-flights, because the number of waypoints ", nrow(waypoints), " exceeds the maximum of ", MAX_WAYPOINTS, ".") } else { + # XXX flight time doesn't include custom launch point stuff message("Your flight was split into ", length(splits), " sub-flights, because the total flight time of ", round(totalFlightTime, 2), " minutes exceeds the max of ", max.flight.time, " minutes.") } diff --git a/R/utils.R b/R/utils.R index 864257f..ba17bb8 100644 --- a/R/utils.R +++ b/R/utils.R @@ -2,7 +2,7 @@ #' #' @description #' Calculates the minimum oriented bounding box using the -#' rotating claipers algorithm. +#' rotating calipers algorithm. #' Credits go to Daniel Wollschlaeger #' #' @param xy A matrix of xy values from which to calculate the minimum oriented