This vignette describes some examples using the create_lcp_network function in the leastcostpath package.
The leastcostpath package is written for use in the R environment (R Core Team, 2016). It provides functionality to calculate Least Cost Paths using multiple cost functions that approximate the difficulty of moving across a landscape, taking into account obstacles and local fricion (e.g. slope). Furthermore, this package allows for the incorporation of cost when traversing across slope, as well as other factors such as landscape features.
The create_lcp_network function uses a specified matrix to assess which locations to calculate the least cost path between.
library(rgdal)
library(rgeos)
library(sp)
library(raster)
library(spdep)
library(gdistance)
library(leastcostpath)r <- raster::raster(system.file('external/maungawhau.grd', package = 'gdistance'))
locs <- sp::spsample(gBuffer(as(extent(r), "SpatialPolygons"), width = -100),n=50,'random')
final_cs <- create_slope_cs(dem = r, cost_function = 'tobler', neighbours = 16) %>%
"*" (create_traversal_cs(dem = r, neighbours = 16))
plot(r)
plot(locs, add = T)
The below matrix specifies that we want to calculate least cost paths between the following locations:
## [,1] [,2]
## [1,] 1 2
## [2,] 4 2
## [3,] 2 4
## [4,] 1 3 lcp_network <- final_cs %>%
create_lcp_network(., locations = locs, nb_matrix = locs_matrix, cost_distance = FALSE, parallel = FALSE)
plot(r)
plot(locs, add = T)
plot(lcp_network, add = T, col = "red")
##
## PLEASE NOTE: The components "delsgs" and "summary" of the
## object returned by deldir() are now DATA FRAMES rather than
## matrices (as they were prior to release 0.0-18).
## See help("deldir").
##
## PLEASE NOTE: The process that deldir() uses for determining
## duplicated points has changed from that used in version
## 0.0-9 of this package (and previously). See help("deldir").origin_ids <- base::rep(base::seq_along(neighbour_pts), base::sapply(neighbour_pts, function(x) base::length(x)))
destination_ids <- base::unlist(neighbour_pts)
locs_matrix <- base::cbind(origin_ids, destination_ids)
head(locs_matrix)## origin_ids destination_ids
## [1,] 1 8
## [2,] 1 13
## [3,] 1 23
## [4,] 1 29
## [5,] 1 38
## [6,] 1 46## origin_ids destination_ids
## [271,] 49 47
## [272,] 50 2
## [273,] 50 4
## [274,] 50 12
## [275,] 50 31
## [276,] 50 33 lcp_network <- final_cs %>%
create_lcp_network(., locations = locs, nb_matrix = locs_matrix, cost_distance = FALSE, parallel = FALSE)
plot(r)
plot(locs, add = T)
plot(lcp_network, add = T, col = "red")
neighbour_pts <- spdep::gabrielneigh(locs)
locs_matrix <- base::cbind(neighbour_pts$from, neighbour_pts$to)
head(locs_matrix)## [,1] [,2]
## [1,] 1 8
## [2,] 1 23
## [3,] 1 29
## [4,] 2 4
## [5,] 2 50
## [6,] 3 16## [,1] [,2]
## [77,] 37 38
## [78,] 39 41
## [79,] 41 43
## [80,] 44 45
## [81,] 44 48
## [82,] 45 48 lcp_network <- final_cs %>%
create_lcp_network(., locations = locs, nb_matrix = locs_matrix, cost_distance = FALSE, parallel = FALSE)
plot(r)
plot(locs, add = T)
plot(lcp_network, add = T, col = "red")
neighbour_pts <- spdep::knearneigh(locs, k= 2)
k_network <- function(k_neigh) {
k_neigh <- k_neigh$nn
col_no <- ncol(k_neigh)
locs <- seq_along(1:nrow(neighbour_pts$nn))
k1 <- cbind(locs, k_neigh[, 1])
if (col_no > 1) {
print("greater than 1")
k <- list()
for (i in 2:col_no) {
k[[i]] <- k_neigh[, c(1, i)]
}
knear <- do.call(rbind, k)
kplus <- rbind(k1, knear)
return(kplus)
} else {
print("less than 1")
return(k1)
}
}
neighbour_pts <- k_network(neighbour_pts)## [1] "greater than 1"## locs
## [1,] 1 29
## [2,] 2 50
## [3,] 3 34
## [4,] 4 2
## [5,] 5 23
## [6,] 6 26## locs
## [95,] 44 10
## [96,] 29 1
## [97,] 7 17
## [98,] 23 1
## [99,] 14 17
## [100,] 2 33 lcp_network <- final_cs %>%
create_lcp_network(., locations = locs, nb_matrix = locs_matrix, cost_distance = FALSE, parallel = FALSE)
plot(r)
plot(locs, add = T)
plot(lcp_network, add = T, col = "red")