1# Author: Robert J. Hijmans
2# Date :  June 2013
3# Version 1.0
4# Licence GPL v3
5
6setMethod("which.max", "RasterLayer",
7	function(x) {
8		m <- maxValue(x, warn=FALSE)
9		if (is.na(m)) {
10			return(NA)
11		}
12		if (canProcessInMemory(x)) {
13			v <- values(x)
14			return(which( v >= m))
15		}
16		x <- x >= m - 0.00000001
17		pts <- rasterToPoints(x, function(y) y == 1)
18		cellFromXY(x, pts[,1:2,drop=FALSE])
19	}
20)
21
22
23
24setMethod("which.min", "RasterLayer",
25	function(x) {
26		m <- minValue(x, warn=FALSE)
27		if (is.na(m)) {
28			return(NA)
29		}
30		if (canProcessInMemory(x)) {
31			v <- values(x)
32			return(which( v <= m))
33		}
34		xx <- x <= m + 0.000001
35		pts <- rasterToPoints(xx, function(y) y == 1)
36		cellFromXY(xx, pts[,1:2,drop=FALSE])
37	}
38)
39
40
41setMethod("which.min", "RasterStackBrick",
42	function(x) {
43		r <- raster(x)
44		nl <- nlayers(x)
45		if (canProcessInMemory(x)) {
46			x <- values(x)
47			i <- rowSums(is.na(x)) < nl
48			y <- rep(NA, nrow(x))
49			if (sum(i) > 0) {
50				y[i] <- apply(x[i,], 1, which.min)
51			}
52			return( setValues(r, y) )
53		} else {
54			tr <- blockSize(x)
55			x <- readStart(x)
56			out <- raster(x)
57			out <- writeStart(out, '')
58			for (i in 1:tr$n) {
59				v <- getValues(x, row=tr$row[i], nrows=tr$nrows[i])
60				j <- rowSums(is.na(v)) < nl
61				y <- rep(NA, nrow(v))
62				if (sum(j) > 0) {
63					y[j] <- apply(v[j,], 1, which.min)
64				}
65				out <- writeValues(out, y, tr$row[i])
66			}
67			out <- writeStop(out)
68			x <- readStop(x)
69			return(out)
70		}
71	}
72)
73
74
75
76setMethod("which.max", "RasterStackBrick",
77	function(x) {
78		r <- raster(x)
79		nl <- nlayers(x)
80		if (canProcessInMemory(x)) {
81			x <- values(x)
82			i <- rowSums(is.na(x)) < nl
83			y <- rep(NA, nrow(x))
84			if (sum(i) > 0) {
85				y[i] <- apply(x[i,], 1, which.max)
86			}
87			return( setValues(r, y) )
88		} else {
89			tr <- blockSize(x)
90			x <- readStart(x)
91			out <- raster(x)
92			out <- writeStart(out, '')
93			for (i in 1:tr$n) {
94				v <- getValues(x, row=tr$row[i], nrows=tr$nrows[i])
95				j <- rowSums(is.na(v)) < nl
96				y <- rep(NA, nrow(v))
97				if (sum(j) > 0) {
98					y[j] <- apply(v[j,], 1, which.max)
99				}
100				out <- writeValues(out, y, tr$row[i])
101			}
102			out <- writeStop(out)
103			x <- readStop(x)
104			return(out)
105		}
106	}
107)
108
109