R/cost_matrix.R

Defines functions cost_matrix

Documented in cost_matrix

#' Create a cost based nearest neighbour matrix
#'
#' Creates a cost based nearest neighbour matrix of k length for each provided location. This matrix can be used in the nb_matrix argument within the create_lcp_network function to calculate Least Cost Paths between origins and destinations.
#'
#' @param cost_surface \code{TransitionLayer} object (gdistance package). Cost surface to be used in calculating the k nearest neighbour
#'
#' @param locations \code{SpatialPoints}. Locations to calculate k nearest neighbours from
#'
#' @param k \code{numeric} number of nearest neighbours to be returned
#'
#' @return \code{matrix} cost-based k nearest neighbour for each location as specified in the locations argument. The resultant \code{matrix} can be used in the nb_matrix argument within the create_lcp_network function.
#'
#' @author Joseph Lewis
#'
#' @import rgdal
#' @import rgeos
#' @import sp
#' @import raster
#' @import gdistance
#'
#' @export
#'
#' @examples
#'
#'r <- raster::raster(nrow=50, ncol=50,  xmn=0, xmx=50, ymn=0, ymx=50,
#'crs='+proj=utm')
#'
#'r[] <- stats::runif(1:length(r))
#'
#'slope_cs <- create_slope_cs(r, cost_function = 'tobler')
#'
#'locs <- sp::spsample(as(raster::extent(r), 'SpatialPolygons'),n=5,'regular')
#'
#'matrix <- cost_matrix(slope_cs, locs, 2)
#'
#'lcp_network <- create_lcp_network(slope_cs, locations = locs,
#'nb_matrix = matrix, cost_distance = FALSE, parallel = FALSE)

cost_matrix <- function(cost_surface, locations, k) {
    
    if (!inherits(cost_surface, "TransitionLayer")) {
        stop("cost_surface argument is invalid. Expecting a TransitionLayer object")
    }
    
    if (!inherits(locations, c("SpatialPoints", "SpatialPointsDataFrame"))) {
        stop("Locations argument is invalid. Expecting SpatialPoints* object")
    }
    
    if (!inherits(k, "numeric")) {
        stop("k argument is invalid. Expecting numeric object")
    }
    
    if (length(locations) < 2) {
        stop("Number of locations invalid. Expecting more than one location")
    }
    
    if (k > length(locations) - 1) {
        stop("k Value exceeds number of locations that each location can connect to. See details for more information.")
    }
    
    origin <- rep(1:length(locations), each = k)
    destination <- rep(0, length(locations), each = k)
    
    for (i in 1:length(locations)) {
        
        distances <- gdistance::costDistance(x = cost_surface, fromCoords = locations[i, ], toCoords = locations[-i, ])
        
        distances <- data.frame(ID = seq(1:length(locations))[-i], costDistance = as.vector(distances))
        
        distances <- distances[order(distances$costDistance), ]
        
        destination[which(origin == i)] <- distances$ID[1:k]
        
    }
    
    matrix <- matrix(data = c(origin, destination), ncol = 2)
    
    return(matrix)
    
}

Try the leastcostpath package in your browser

Any scripts or data that you put into this service are public.

leastcostpath documentation built on June 3, 2022, 9:06 a.m.