1# Author: Robert J. Hijmans
2# Date :  September 2009
3# Version 0.9
4# Licence GPL v3
5
6
7setMethod('brick', signature(x='missing'),
8	function(nrows=180, ncols=360, xmn=-180, xmx=180, ymn=-90, ymx=90, nl=1, crs) {
9		e <- extent(xmn, xmx, ymn, ymx)
10		if (missing(crs)) {
11			if (e@xmin > -400 & e@xmax < 400 & e@ymin > -90.1 & e@ymax < 90.1) {
12				crs ="+proj=longlat +datum=WGS84"
13			} else {
14				crs=""
15			}
16		}
17		b <- brick(e, nrows=nrows, ncols=ncols, crs=crs, nl=nl)
18		return(b)
19	}
20)
21
22
23
24setMethod('brick', signature(x='character'),
25	function(x, ...) {
26		.rasterObjectFromFile(x, objecttype='RasterBrick', ...)
27	}
28)
29
30
31setMethod('brick', signature(x='RasterLayer'),
32	function(x, ..., values=TRUE, nl=1, filename='') {
33
34		nl <- max(round(nl), 0)
35		if (!hasValues(x)) {
36			values <- FALSE
37		}
38
39		if (!values) {
40			b <- brick(x@extent, nrows=nrow(x), ncols=ncol(x), crs=x@crs, nl=nl)
41			if (rotated(x)) {
42				b@rotated <- TRUE
43				b@rotation <- x@rotation
44			}
45			return(b)
46		}
47
48		filename <- trim(filename)
49		dots <- list(...)
50		fformat <- dots$format
51		if (is.null(fformat)) { fformat <- .filetype(filename=filename) }
52		datatype <- dots$datatype
53		if (is.null(datatype)) { datatype <- .datatype() }
54		overwrite <- dots$overwrite
55		if (is.null(overwrite)) { overwrite <- .overwrite() }
56		progress <- dots$progress
57		if (is.null(progress)) { progress <- .progress() }
58
59		x <- stack(x, ...)
60
61		brick(x, values=values, filename=filename, format=fformat, datatype=datatype, overwrite=overwrite, progress=progress)
62	}
63)
64
65
66setMethod('brick', signature(x='RasterStack'),
67	function(x, values=TRUE, nl, filename='', ...){
68
69		e <- x@extent
70		b <- brick(xmn=e@xmin, xmx=e@xmax, ymn=e@ymin, ymx=e@ymax, nrows=x@nrows, ncols=x@ncols, crs=x@crs)
71		if (rotated(x)) {
72			b@rotated <- TRUE
73			b@rotation <- x@rotation
74		}
75
76		if (missing(nl)) {
77			nl <- nlayers(x)
78			if (nl < 1) {
79				values <- FALSE
80			}
81		} else {
82			nl <- max(round(nl), 0)
83			values <- FALSE
84		}
85
86		b@data@nlayers <- as.integer(nl)
87
88		filename <- trim(filename)
89
90		if (values) {
91
92			b@data@names <- names(x)[1:nl]
93			if (canProcessInMemory(b, nl*2)) {
94				b <- setValues( b, getValues(x)[,1:nl])
95				if (any(is.factor(x))) {
96					b@data@isfactor <- is.factor(x)
97					b@data@attributes <- levels(x)
98				}
99				if (filename != '') {
100					b <- writeRaster(b, filename, ...)
101				}
102				return(b)
103
104			} else {
105
106				b <- writeStart(b, filename=filename, ...)
107				tr <- blockSize(b)
108				pb <- pbCreate(tr$n, ...)
109				x <- readStart(x)
110
111				for (i in 1:tr$n) {
112					vv <- getValues(x, row=tr$row[i], nrows=tr$nrows[i])
113					b <- writeValues(b, vv, tr$row[i])
114					pbStep(pb, i)
115				}
116				pbClose(pb)
117				b <- writeStop(b)
118				x <- readStop(x)
119				return(b)
120			}
121
122		} else {
123			b@data@min <- rep(Inf, b@data@nlayers)
124			b@data@max <- rep(-Inf, b@data@nlayers)
125			return(b)
126		}
127	}
128)
129
130setMethod('brick', signature(x='RasterBrick'),
131	function(x, nl, ...){
132		if (missing(nl)) {
133			nl <- nlayers(x)
134		}
135		e <- x@extent
136		b <- brick(xmn=e@xmin, xmx=e@xmax, ymn=e@ymin, ymx=e@ymax, nrows=x@nrows, ncols=x@ncols, crs=x@crs)
137		b@data@nlayers <- as.integer(nl)
138		b@data@min <- rep(Inf, nl)
139		b@data@max <- rep(-Inf, nl)
140		if (rotated(x)) {
141			b@rotated <- TRUE
142			b@rotation <- x@rotation
143		}
144		return(b)
145	}
146)
147
148
149
150setMethod('brick', signature(x='Extent'),
151	function(x, nrows=10, ncols=10, crs="", nl=1) {
152		nr = as.integer(round(nrows))
153		nc = as.integer(round(ncols))
154		if (nc < 1) { stop("ncols should be > 0") }
155		if (nr < 1) { stop("nrows should be > 0") }
156		b <- methods::new("RasterBrick", extent=x, ncols=nc, nrows=nr)
157
158		prj <- sp::CRS(as.character(NA), doCheckCRSArgs=FALSE)
159		try(prj <- .getCRS(crs))
160		projection(b) <- prj
161		nl <- max(round(nl), 0)
162		b@data@nlayers <- as.integer(nl)
163		b@data@isfactor <- rep(FALSE, nl)
164		return(b)
165	}
166)
167
168
169setMethod('brick', signature(x='SpatialGrid'),
170	function(x){
171		b <- brick()
172		extent(b) <- extent(x)
173		crs(b) <- x@proj4string
174		dim(b) <- c(x@grid@cells.dim[2], x@grid@cells.dim[1])
175
176		if (class(x) == 'SpatialGridDataFrame') {
177
178			x <- x@data
179
180			b@data@isfactor <- rep(FALSE, ncol(x))
181
182			isfact <- sapply(x, function(i) is.factor(i) | is.character(i))
183			b@data@isfactor <- isfact
184			if (any(isfact)) {
185				for (i in which(isfact)) {
186					rat <- data.frame(table(x[[i]]))
187					rat <- data.frame(1:nrow(rat), rat[,2], rat[,1])
188					colnames(rat) <- c("ID", "COUNT", colnames(x)[i])
189					b@data@attributes[[i]] <- rat
190					x[,i] <- as.integer(x[,i])
191				}
192			}
193
194			b <- setValues(b, as.matrix(x))
195			b@data@names <- colnames(x)
196		}
197		return(b)
198	}
199)
200
201
202setMethod('brick', signature(x='SpatialPixels'),
203	function(x) {
204		if (inherits( x, 'SpatialPixelsDataFrame')) {
205			x <- as(x, 'SpatialGridDataFrame')
206		} else {
207			x <- as(x, 'SpatialGrid')
208		}
209		return(brick(x))
210	}
211)
212
213
214setMethod('brick', signature(x='array'),
215	function(x, xmn=0, xmx=1, ymn=0, ymx=1, crs="", transpose=FALSE) {
216		dm <- dim(x)
217		if (is.matrix(x)) {
218			stop('cannot coerce a matrix to a RasterBrick')
219		}
220		if (length(dm) != 3) {
221			stop('array has wrong number of dimensions (needs to be 3)')
222		}
223		b <- brick(xmn=xmn, xmx=xmx, ymn=ymn, ymx=ymx, crs=crs, nl=dm[3])
224		names(b) <- dimnames(x)[[3]]
225
226		if (transpose) {
227			dim(b) <- c(dm[2], dm[1], dm[3])
228		} else {
229			dim(b) <- dm
230			# aperm etc suggested by Justin McGrath
231			# https://r-forge.r-project.org/forum/message.php?msg_id=4312
232			x = aperm(x, perm=c(2,1,3))
233		}
234		attributes(x) <- list()
235		dim(x) <- c(dm[1] * dm[2], dm[3])
236		setValues(b, x)
237	}
238)
239
240
241
242# setMethod('brick', signature(x='big.matrix'),
243	# function(x, template, filename='', ...) {
244		# stopifnot(inherits(template, 'BasicRaster'))
245		# stopifnot(nrow(x) == ncell(template))
246		# r <- brick(template)
247		# filename <- trim(filename)
248		# names(r) <- colnames(x)
249		# if (canProcessInMemory(r)) {
250			# r <- setValues(r, x[])
251			# if (filename != '') {
252				# r <- writeRaster(r, filename, ...)
253			# }
254		# } else {
255			# tr <- blockSize(r)
256			# pb <- pbCreate(tr$n, ...)
257			# r <- writeStart(r, filename, ...)
258			# for (i in 1:tr$n) {
259				# r <- writeValues(r, x[tr$row[i]:(tr$row[i]+tr$nrows[i]-1), ], tr$row[i] )
260				# pbStep(pb)
261			# }
262			# r <- writeStop(r)
263			# pbClose(pb)
264		# }
265		# return(r)
266	# }
267# )
268
269
270
271
272setMethod('brick', signature(x='kasc'),
273	function(x) {
274		as(x, 'RasterBrick')
275	}
276)
277
278
279
280
281setMethod('brick', signature(x='grf'),
282	function(x) {
283		as(x, 'RasterBrick')
284	}
285)
286
287
288
289
290setMethod('brick', signature(x='list'),
291	function(x) {
292		x <- stack(x)
293		brick(x)
294	}
295)
296
297
298
299setMethod('brick', signature(x='SpatRaster'),
300	function(x) {
301		as(x, "Raster")
302	}
303)
304
305