1# Author: Robert J. Hijmans 2# Date : July 2019 3# Version 1.0 4# License GPL v3 5 6 7 8setMethod("buffer", signature(x="SpatRaster"), 9 function(x, width, filename="", ...) { 10 opt <- spatOptions(filename, ...) 11 x@ptr <- x@ptr$buffer(width, opt) 12 messages(x, "buffer") 13 } 14) 15 16 17setMethod("distance", signature(x="SpatRaster", y="missing"), 18 function(x, y, grid=FALSE, filename="", ...) { 19 opt <- spatOptions(filename, ...) 20 if (grid) { 21 x@ptr <- x@ptr$gridDistance(opt) 22 } else { 23 x@ptr <- x@ptr$rastDistance(opt) 24 } 25 messages(x, "distance") 26 } 27) 28 29 30 31setMethod("distance", signature(x="SpatRaster", y="SpatVector"), 32 function(x, y, filename="", ...) { 33 opt <- spatOptions(filename, ...) 34 if (is.lonlat(x)) { 35 x@ptr <- x@ptr$vectDistanceRasterize(y@ptr, TRUE, opt) 36 } else { 37 x@ptr <- x@ptr$vectDistanceDirect(y@ptr, opt) 38 } 39 messages(x, "distance") 40 } 41) 42 43 44 45mat2wide <- function(m, sym=TRUE, keep=NULL) { 46 if (inherits(m, "dist")) { 47 # sym must be true in this case 48 nr <- attr(m, "Size") 49 x <- rep(1:(nr-1), (nr-1):1) 50 y <- unlist(sapply(2:nr, function(i) i:nr)) 51 cbind(x,y, as.vector(m)) 52 } else { 53 bool <- is.logical(m) 54 if (sym) { 55 m[lower.tri(m)] <- NA 56 } 57 m <- cbind(from=rep(1:nrow(m), each=ncol(m)), to=rep(1:ncol(m), nrow(m)), value=as.vector(t(m))) 58 m <- m[!is.na(m[,3]), , drop=FALSE] 59 if (!is.null(keep)) { 60 m <- m[m[,3] == keep, 1:2, drop=FALSE] 61 } 62 m 63 } 64} 65 66setMethod("distance", signature(x="SpatVector", y="ANY"), 67 function(x, y, sequential=FALSE, pairs=FALSE, symmetrical=TRUE) { 68 if (!missing(y)) { 69 error("distance", "If 'x' is a SpatVector, 'y' should be a SpatVector or missing") 70 } 71 72 if (sequential) { 73 return( x@ptr$distance_self(sequential)) 74 } 75 d <- x@ptr$distance_self(sequential) 76 messages(x, "distance") 77 class(d) <- "dist" 78 attr(d, "Size") <- nrow(x) 79 attr(d, "Diag") <- FALSE 80 attr(d, "Upper") <- FALSE 81 attr(d, "method") <- "spatial" 82 if (pairs) { 83 d <- as.matrix(d) 84 diag(d) <- NA 85 d <- mat2wide(d, symmetrical) 86 } 87 d 88 } 89) 90 91 92setMethod("distance", signature(x="SpatVector", y="SpatVector"), 93 function(x, y, pairwise=FALSE) { 94 d <- x@ptr$distance_other(y@ptr, pairwise) 95 messages(x, "distance") 96 if (!pairwise) { 97 d <- matrix(d, nrow=nrow(x), ncol=nrow(y), byrow=TRUE) 98 } 99 d 100 } 101) 102 103 104setMethod("distance", signature(x="matrix", y="matrix"), 105 function(x, y, lonlat, pairwise=FALSE) { 106 if (missing(lonlat)) { 107 error("distance", "you must set lonlat to TRUE or FALSE") 108 } 109 stopifnot(ncol(x) == 2) 110 stopifnot(ncol(y) == 2) 111 crs <- ifelse(lonlat, "+proj=longlat +datum=WGS84", 112 "+proj=utm +zone=1 +datum=WGS84") 113 x <- vect(x, crs=crs) 114 y <- vect(y, crs=crs) 115 distance(x, y, pairwise) 116 } 117) 118 119 120setMethod("distance", signature(x="matrix", y="ANY"), 121 function(x, y, lonlat, sequential=FALSE) { 122 crs <- ifelse(lonlat, "+proj=longlat +datum=WGS84", 123 "+proj=utm +zone=1 +datum=WGS84") 124 x <- vect(x, crs=crs) 125 distance(x, sequential) 126 } 127) 128 129