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