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