1# Author: Robert J. Hijmans 2# Date : June 2020 3# Version 1.0 4# License GPL v3 5 6 7setMethod("cells", signature(x="SpatRaster", y="missing"), 8 function(x, y) { 9 # is this useful? 10 which(!is.na(values(x))) 11 } 12) 13 14setMethod("cells", signature(x="SpatRaster", y="numeric"), 15 function(x, y) { 16 opt <- spatOptions() 17 v <- x@ptr$is_in_cells(y, opt) 18 x <- messages(x, "cells") 19 v <- lapply(v, function(i) i+1) 20 names(v) <- names(x) 21 v 22 } 23) 24 25 26setMethod("cells", signature("SpatRaster", "SpatVector"), 27 function(x, y, method="simple", weights=FALSE, exact=FALSE, touches=is.lines(y)) { 28 method = match.arg(tolower(method), c("simple", "bilinear")) 29 opt <- spatOptions() 30 d <- x@ptr$vectCells(y@ptr, touches[1], method[1], weights[1], exact[1], opt) 31 if (geomtype(y) == "points") { 32 d <- matrix(d, nrow=nrow(y), byrow=TRUE) 33 d <- cbind(1:nrow(y), d) 34 if (method == "bilinear") { 35 colnames(d) <- c("ID", "c1", "c2", "c3", "c4", "w1", "w2", "w3", "w4") 36 d[,2:5] <- d[,2:5] + 1 37 } else { 38 colnames(d) <- c("ID", "cell") 39 d[,2] <- d[,2] + 1 40 } 41 return (d) 42 } 43 cn <- c("ID", "cell") 44 if (weights[1] || exact[1]) { 45 d <- matrix(d, ncol=3) 46 cn <- c(cn, "weights") 47 } else { 48 d <- matrix(d, ncol=2) 49 } 50 d[,1:2] <- d[,1:2] + 1 51 colnames(d) <- cn 52 d 53 } 54) 55 56 57#setMethod("cells", signature("SpatRaster", "SpatExtent"), 58# function(x, y, ...) { 59# p <- as.polygons(y, crs=crs(x)) 60# cells(x, p)[,2] 61# } 62#) 63 64#setMethod("cells", signature("SpatRaster", "SpatExtent"), 65# function(x, y, ...) { 66# e <- align(y, x) 67# s <- res(x)/2 68# e <- as.vector(y) + c(s[1], -s[1], s[2], -s[2]) 69# r <- rowFromY(x, e[4:3])-1 70# c <- colFromX(x, e[1:2]) 71# cc <- c[1]:c[2] 72# rr <- (r[1]:r[2]) * ncol(x) 73# rep(rr, each=length(cc)) + cc 74# } 75#) 76 77 78setMethod("cells", signature("SpatRaster", "SpatExtent"), 79 function(x, y) { 80 opt <- spatOptions() 81 x@ptr$extCells(y@ptr) + 1 82 } 83) 84