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