1# Author: Robert J. Hijmans
2# Date :  January 2009
3# Version 1.0
4# Licence GPL v3
5
6
7setReplaceMethod("[", c("RasterLayer", "RasterLayer", "missing"),
8	function(x, i, j, value) {
9
10		i <- crop(i, x)
11
12		if (inherits(value, 'RasterLayer')) {
13			value <- getValues(value)
14		}
15
16		if (! hasValues(i) ) {
17			i <- cellsFromExtent(x, i)
18
19		} else if (compareRaster(x, i, stopiffalse=FALSE, showwarning=FALSE)) {
20			i <- as.logical( getValues(i) )
21
22		} else {
23			j <- as.logical( getValues(i) )
24			i <- cellsFromExtent(x, i)[j]
25			x[i] <- value
26			return(x)
27		}
28
29		.replace(x, i, value=value, recycle=1)
30	}
31)
32
33
34
35setReplaceMethod("[", c("RasterLayer","missing","missing"),
36	function(x, i, j, value) {
37
38		if (length(value) == ncell(x)) {
39			x <- try( setValues(x, value))
40		} else if (length(value) == 1) {
41			x <- try( setValues(x, rep(value, times=ncell(x))) )
42		} else {
43			v <- try( vector(length=ncell(x)) )
44			if (! inherits(x, "try-error")) {
45				v[] <- value
46				x <- try( setValues(x, v) )
47			}
48		}
49		if (inherits(x, "try-error")) {
50			stop('cannot replace values on this raster (it is too large')
51		}
52		return(x)
53	}
54)
55
56
57.replace <- function(x, i, value, recycle=1) {
58
59	if ( is.logical(i) ) {
60		i <- which(i)
61	} else {
62		i <- stats::na.omit(i)
63	}
64	if (any(i < 1)) {
65		if (!all(i < 1)) {stop("you cannot mix negative and positive subscript")}
66		j <- i
67		i <- 1:ncell(x)
68		i <- i[j]
69	}
70
71	nl <- nlayers(x)
72  # recycling
73	if (nl > 1 & recycle > 0) {
74		rec2 <- ceiling(nl / recycle)
75		if (rec2 > 1) {
76			add <- ncell(x)*recycle * (0:(rec2-1))
77			i <- as.vector(t((matrix(rep(i, rec2), nrow=rec2, byrow=TRUE)) + add))
78		}
79	}
80	j <- i > 0 & i <= (ncell(x)*nl)
81
82	if (!all(j)) {
83		i <- i[j]
84		if (length(value) > 1) {
85			value <- value[j]
86		}
87	}
88
89
90	if ( inMemory(x) ) {
91		if (inherits(x, 'RasterStack')) {
92			x <- brick( x, values=TRUE )
93			# this may go to disk, hence we check again below
94		}
95	}
96
97	if ( inMemory(x) & hasValues(x) ) {
98		x@data@values[i] <- value
99		x <- setMinMax(x)
100		x <- .clearFile(x)
101		return(x)
102
103	} else if (canProcessInMemory(x)) {
104		if (inherits(x, 'RasterStack')) {
105			x <- brick( x, values=TRUE )
106			if (!inMemory(x)) {
107				x <- readAll(x)
108			}
109			x <- .clearFile(x)
110			x@data@values[i] <- value
111			x <- setMinMax(x)
112		} else if ( fromDisk(x) ) {
113			x <- readAll(x)
114			x <- .clearFile(x)
115			x@data@values[i] <- value
116			x <- setMinMax(x)
117		} else {
118			vals <- rep(NA, times=ncell(x)*nl)
119			vals[i] <- value
120			x <- setValues(x, vals)
121		}
122		return(x)
123
124	} else {
125
126		tr <- blockSize(x)
127		pb <- pbCreate(tr$n, label='replace')
128		hv <- hasValues(x)
129		if (nl==1) {
130			if (! length(value) %in% c(1, length(i))) {
131				stop('cannot replace values in large Raster objects if their length is not 1 or the number of cells to be replaced')
132			}
133			r <- raster(x)
134			r <- writeStart(r, filename=rasterTmpFile(), overwrite=TRUE )
135			for (k in 1:tr$n) {
136				# cells <- cellFromRowCol(x, tr$row[k], 1):cellFromRowCol(x, tr$row[k]+tr$nrows[k]-1, ncol(x))
137				cell1 <- cellFromRowCol(x, tr$row[k], 1)
138				cell2 <- cell1 + tr$nrows[k] * ncol(x) - 1
139				if (hv) {
140					v <- getValues(x, row=tr$row[k], nrows=tr$nrows[k])
141				} else {
142					v <- rep(NA, 1+cell2-cell1)
143				}
144				j <- which(i >= cell1 & i <= cell2)
145				if (length(j) > 0) {
146					localcells <- i[j] - (cell1-1)
147					if (length(value) == length(i)) {
148						v[localcells] <- value[j]
149					} else {
150						v[localcells] <- value
151					}
152				}
153				r <- writeValues(r, v, tr$row[k])
154				pbStep(pb, k)
155			}
156			r <- writeStop(r)
157			pbClose(pb)
158			return(r)
159
160		} else {
161			if (! length(value) %in% c(1, length(i))) {
162				stop('length of replacement values does not match the length of the index')
163			}
164			r <- brick(x, values=FALSE)
165			r <- writeStart(r, filename=rasterTmpFile(), overwrite=TRUE )
166#			add <- (0:(nl-1)) * ncell(x)
167# remove the added cells again....
168
169			nc <- ncol(x)
170			ii <- (i-1) %% ncell(x) + 1
171			for (k in 1:tr$n) {
172				startcell <- cellFromRowCol(x, tr$row[k], 1)
173				endcell <- cellFromRowCol(x, tr$row[k]+tr$nrows[k]-1, ncol(x))
174				if (hv) {
175					v <- getValues(x, row=tr$row[k], nrows=tr$nrows[k])
176				} else {
177					v <- matrix(NA, nrow=tr$nrows[k] * nc, ncol=nl)
178				}
179
180				j <- i[ii >= startcell & ii <= endcell] - startcell + 1
181				if (length(j) > 0) {
182					jj <- (j %/% ncell(x)) * tr$nrow[k] * ncol(x) + (j %% ncell(x))
183					if (length(value) == length(i)) {
184						v[jj] <- value[jj]
185					} else {
186						v[jj] <- value
187					}
188				}
189				r <- writeValues(r, v, tr$row[k])
190				pbStep(pb, k)
191			}
192			r <- writeStop(r)
193			pbClose(pb)
194			return(r)
195		}
196	}
197}
198
199
200