1# Author: Robert J. Hijmans 2# Date : March 2011 3# Version 1.0 4# Licence GPL v3 5 6 7.quickStack <- function(files, nbands=1, band=1, native=FALSE) { 8 r <- raster(files[[1]], native=native) 9 if (length(nbands) == 1) { 10 nbands <- rep(nbands, length(files)) 11 } else { 12 stopifnot(length(files == length(nbands))) 13 } 14 nbands <- as.integer(nbands) 15 band <- as.integer(band) 16 17 if (length(band) == 1) { 18 band <- rep(band, length(files)) 19 } else { 20 stopifnot(length(files == length(band))) 21 } 22 23 r@data@haveminmax <- FALSE 24 r@file@nbands <- nbands[1] 25 r@data@band <- band[1] 26 27 ln <- extension(basename(unlist(files)), '') 28 s <- stack(r) 29 s@layers <- sapply(1:length(files), 30 function(i){ 31 r@file@name <- files[[i]] 32 r@file@nbands <- nbands[i] 33 r@data@band <- band[i] 34 r@data@names <- ln[i] 35 r 36 } 37 ) 38 s 39} 40 41 42 43 44.quickStackOneFile <- function(filename, bands=NULL, native=FALSE) { 45 b <- brick(filename, native=native) 46 .stackFromBrick(b, bands=bands) 47} 48 49 50 51.stackFromBrick <- function(b, bands=NULL) { 52 53 nbands <- nlayers(b) 54 if (is.null(bands)) { 55 bands <- 1:nbands 56 } else { 57 if (is.character(bands)) { 58 bands <- match(bands, names(b)) 59 } 60 bands <- bands[bands %in% 1:nbands] 61 if (length(bands)==0) { 62 bands <- 1:nbands 63 } 64 } 65 bands <- as.integer(bands) 66 67 havemnmx <- b@data@haveminmax 68 if (havemnmx) { 69 mn <- minValue(b) 70 mx <- maxValue(b) 71 } 72 ln <- names(b) 73 74 if (inMemory(b)) { 75 r <- b[[ bands[1] ]] 76 s <- stack(r) 77 78 if (length(bands) > 1) { 79 80 if (havemnmx) { 81 s@layers <- sapply( bands, function(i) { 82 r@data@values <- b@data@values[,i] 83 r@data@names <- ln[i] 84 r@data@min <- mn[i] 85 r@data@max <- mx[i] 86 r 87 }) 88 } else { 89 s@layers <- sapply(bands, function(i){ 90 r@data@values <- b@data@values[,i] 91 r@data@names <- ln[i] 92 r 93 }) 94 } 95 } 96 return(s) 97 98 } 99 100 101 102 r <- raster(b, bands[1]) 103 s <- stack(r) 104 if (length(bands) > 1) { 105 106 if (havemnmx) { 107 s@layers <- sapply(bands, function(i){ 108 r@data@band <- i 109 r@data@names <- ln[i] 110 r@data@min <- mn[i] 111 r@data@max <- mx[i] 112 r 113 }) 114 } else { 115 s@layers <- sapply(bands, function(i){ 116 r@data@band <- i 117 r@data@names <- ln[i] 118 r 119 }) 120 } 121 } 122 s 123} 124