1# Author: Robert J. Hijmans 2# Date : February 2009 3# Version 0.9 4# Licence GPL v3 5 6 7rasterToPoints <- function(x, fun=NULL, spatial=FALSE, ...) { 8 9 nl <- nlayers(x) 10 if (nl > 1) { 11 if (! is.null(fun)) { 12 stop('you can only supply a fun argument if "x" has a single layer') 13 } 14 } 15 16 17 if (! inherits(x, 'RasterStack' )) { 18 if ( ! fromDisk(x) & ! inMemory(x) ) { 19 if (spatial) { 20 return(sp::SpatialPoints(coords=xyFromCell(x, 1:ncell(x)), proj4string=x@crs) ) 21 } else { 22 return(xyFromCell(x, 1:ncell(x))) 23 } 24 } 25 } 26 27 laynam <- names(x) 28 29 if (canProcessInMemory(x, 3)) { 30 31 xyv <- cbind(xyFromCell(x, 1:ncell(x)), getValues(x)) 32 if (nl > 1) { 33 notna <- apply(xyv[,3:ncol(xyv), drop=FALSE], 1, function(x){ sum(is.na(x)) < length(x) }) 34 xyv <- xyv[notna, ,drop=FALSE] 35 } else { 36 xyv <- stats::na.omit(xyv) 37 attr(xyv, 'na.action') <- NULL 38 } 39 if (!is.null(fun)) { 40 xyv <- subset(xyv, fun(xyv[,3])) 41 } 42 43 } else { 44 45 xyv <- matrix(NA, ncol=2+nlayers(x), nrow=0) 46 colnames(xyv) <- c('x', 'y', names(x)) 47 X <- xFromCol(x, 1:ncol(x)) 48 Y <- yFromRow(x, 1:nrow(x)) 49 50 tr <- blockSize(x) 51 pb <- pbCreate(tr$n, label='rasterize', ...) 52 53 if (nl > 1) { 54 55 for (i in 1:tr$n) { 56 r <- tr$row[i]:(tr$row[i]+tr$nrows[i]-1) 57 xyvr <- cbind(rep(X, tr$nrows[i]), rep(Y[r], each=ncol(x)), getValues(x, row=tr$row[i], nrows=tr$nrows[i])) 58 notna <- rowSums(is.na(xyvr[ , 3:ncol(xyvr), drop=FALSE])) < (ncol(xyvr)-2) 59 xyvr <- xyvr[notna, ,drop=FALSE] 60 xyv <- rbind(xyv, xyvr) 61 pbStep(pb, i) 62 } 63 64 } else { 65 # faster 66 for (i in 1:tr$n) { 67 r <- tr$row[i]:(tr$row[i]+tr$nrows[i]-1) 68 v <- getValues(x, row=tr$row[i], nrows=tr$nrows[i]) 69 xyvr <- cbind(rep(X, tr$nrows[i]), rep(Y[r], each=ncol(x)), v) 70 xyvr <- subset(xyvr, !is.na(v)) 71 if (!is.null(fun)) { 72 xyvr <- subset(xyvr, fun(xyvr[,3])) 73 } 74 xyv <- rbind(xyv, xyvr) 75 pbStep(pb, i) 76 } 77 } 78 pbClose(pb) 79 80 } 81 82 if (spatial) { 83 if (nrow(xyv) == 0) { 84 xyv <- rbind(xyv, 0) 85 v <- data.frame(xyv[ ,-c(1:2), drop=FALSE]) 86 colnames(v) <- laynam 87 s <- sp::SpatialPointsDataFrame(coords=xyv[,1:2,drop=FALSE], data=v, proj4string=x@crs ) 88 return(s[0,]) 89 } else { 90 v <- data.frame(xyv[ ,-c(1:2), drop=FALSE]) 91 colnames(v) <- laynam 92 return( sp::SpatialPointsDataFrame(coords=xyv[,1:2,drop=FALSE], data=v, proj4string=x@crs ) ) 93 } 94 95 } else { 96 colnames(xyv)[3:ncol(xyv)] <- laynam 97 return(xyv) 98 } 99} 100 101