1#to be removed 2 3#setAs('RasterLayerSparse', 'RasterLayer', function(from){ raster(from) } ) 4 5setClass ("RasterLayerSparse", 6 contains = "RasterLayer", 7 representation ( 8 index = "vector" 9 ), 10 prototype ( 11 index = vector(mode="numeric") 12 ) 13) 14 15setMethod('raster', signature(x='RasterLayerSparse'), 16 function(x) { 17 r <- raster(x@extent, nrows=x@nrows, ncols=x@ncols, crs=.getCRS(x)) 18 if (length(stats::na.omit(x@data@values)) > 0) { 19 v <- rep(NA, ncell(r)) 20 v[x@index] <- x@data@values 21 setValues(r, v) 22 } else { 23 r 24 } 25 } 26) 27 28 29setClass (".RasterBrickSparse", 30 contains = "RasterBrick", 31 representation ( 32 index = "vector" 33 ), 34 prototype ( 35 index = vector(mode="numeric") 36 ) 37) 38 39 40 41setAs('RasterLayer', 'RasterLayerSparse', 42 function(from){ 43 x <- methods::new('RasterLayerSparse') 44 v <- stats::na.omit(cbind(1:ncell(from), getValues(from))) 45 setValues(x, v[,2], v[,1]) 46 } 47) 48 49 50 51 52setMethod("Arith", signature(e1='RasterLayerSparse', e2='numeric'), 53 function(e1, e2){ 54 55 if (!hasValues(e1)) { stop('RasterLayerSparse has no values') } 56 stopifnot(length(e2) == 1) 57 setValues(e1, methods::callGeneric(as.numeric(e1@data@values), e2)) 58 } 59) 60 61setMethod("Arith", signature(e1='numeric', e2='RasterLayerSparse'), 62 function(e1, e2){ 63 if (!hasValues(e2)) { stop('RasterLayerSparse has no values') } 64 stopifnot(length(e1) == 1) 65 setValues(e2, methods::callGeneric(as.numeric(e2@data@values), e1) ) 66 } 67) 68 69 70 71 72setMethod("Math", signature(x='RasterLayerSparse'), 73 function(x){ 74 75 if (!hasValues(x)) { 76 return(x) 77 } 78# funname <- as.character(sys.call(sys.parent())[[1]]) 79 funname <- .Generic 80 81 82 if (substr(funname, 1, 3) == 'cum' ) { 83 setValues(x, do.call(funname, list(x@data@values))) 84 } else { 85 setValues(x, methods::callGeneric(x@data@values)) 86 } 87 } 88) 89 90 91 92setMethod('setValues', signature(x='RasterLayerSparse'), 93 94 function(x, values, index=NULL, ...) { 95 96 stopifnot(is.vector(values)) 97 if (!(is.numeric(values) | is.integer(values) | is.logical(values))) { 98 stop('values must be numeric, integer or logical.') 99 } 100 if (is.null(index)) { 101 if (! hasValues(x)) { 102 stop('you must supply an index argument if the RasterLayerSparse does not have values') 103 } 104 stopifnot(length(x@index) == length(values)) 105 } else { 106 stopifnot(is.vector(index)) 107 stopifnot(length(index) == length(values)) 108 stopifnot(all(index > 0 | index <= ncell(x))) 109 x@index <- index 110 } 111 x@data@inmemory <- TRUE 112 x@data@fromdisk <- FALSE 113 x@file@name <- "" 114 x@file@driver <- "" 115 x@data@values <- values 116 x <- setMinMax(x) 117 return(x) 118 } 119) 120 121 122setMethod('getValues', signature(x='RasterLayerSparse', row='numeric', nrows='missing'), 123 function(x, row, nrows) { 124 getValues(x, row=row, nrows=1) 125 } 126) 127 128 129setMethod('getValues', signature(x='RasterLayerSparse', row='numeric', nrows='numeric'), 130function(x, row, nrows, format='') { 131 row <- round(row) 132 nrows <- round(nrows) 133 stopifnot(validRow(x, row)) 134 stopifnot(nrows > 0) 135 row <- min(x@nrows, max(1, row)) 136 endrow <- max(min(x@nrows, row+nrows-1), row) 137 nrows <- endrow - row + 1 138 nc <- ncol(x) 139 140 startcell <- cellFromRowCol(row, 1) 141 lastcell <- cellFromRowCol(endrow, nc) 142 143 if (inMemory(x)){ 144 i <- which(x@index >= startcell & x@index <= lastcell) 145 if (length(i) > 0) { 146 v <- cellFromRowColCombine(x, row:endrow, 1:nc) 147 m <- match(i, v) 148 v[] <- NA 149 v[m] <- x@data@values[i] 150 } else { 151 v <- rep(NA, nrows * x@ncols) 152 } 153 } else if ( fromDisk(x) ) { 154 # not yet implemented 155 ## v <- .readRasterLayerValues(x, row, nrows) 156 } else { 157 v <- rep(NA, nrows * x@ncols) 158 } 159 if (format=='matrix') { 160 v <- matrix(v, nrow=nrows, byrow=TRUE) 161 rownames(v) <- row:(row+nrows-1) 162 colnames(v) <- 1:ncol(v) 163 } 164 return(v) 165} 166) 167setMethod('getValuesBlock', signature(x='RasterLayerSparse'), 168 function(x=1, row, nrows=1, col=1, ncols=(ncol(x)-col+1), format='', ...) { 169 170 row <- max(1, min(x@nrows, round(row[1]))) 171 lastrow <- min(x@nrows, row + round(nrows[1]) - 1) 172 nrows <- lastrow - row + 1 173 col <- max(1, min(x@ncols, round(col[1]))) 174 lastcol <- col + round(ncols[1]) - 1 175 ncols <- lastcol - col + 1 176 177 startcell <- cellFromRowCol(x, row, col) 178 lastcell <- cellFromRowCol(x, lastrow, lastcol) 179 180 if (!(validRow(x, row))) { stop(paste(row, 'is not a valid rownumber')) } 181 182 if ( inMemory(x) ) { 183 i <- which(x@index >= startcell & x@index <= lastcell) 184 if (length(i) > 0) { 185 res <- cellFromRowColCombine(x, row:lastrow, col:lastcol) 186 m <- match(i, res) 187 res[] <- NA 188 res[m] <- x@data@values[i] 189 } else { 190 res <- rep(NA, nrows * ncols) 191 } 192 } else if ( fromDisk(x) ) { 193 # not yet implemented 194 #if (! fromDisk(x)) { 195 # return(rep(NA, times=(lastcell-startcell+1))) 196 #} 197 #res <- .readRasterLayerValues(x, row, nrows, col, ncols, is.open) 198 199 } else { 200 res <- rep(NA, nrows * ncols) 201 } 202 203 204 if (format=='matrix') { 205 res = matrix(res, nrow=nrows , ncol=ncols, byrow=TRUE ) 206 colnames(res) <- col:lastcol 207 rownames(res) <- row:lastrow 208 } 209 res 210 } 211 212) 213 214 215 216setMethod("getValues", signature(x='RasterLayerSparse', row='missing', nrows='missing'), 217function(x, format='') { 218 219 cr <- c(x@ncols, x@nrows) 220 221 if ( inMemory(x) ) { 222 i <- x@index 223 v <- x@data@values 224 x <- rep(NA, ncell(x)) 225 x[i] <- v 226 } else if ( fromDisk(x) ) { 227 # not yet implemented 228 ### x <- .readRasterLayerValues(x, 1, x@nrows) 229 } else { 230 x <- rep(NA, ncell(x)) 231 } 232 233 if (format=='matrix') { 234 x <- matrix(x, ncol=cr[1], nrow=cr[2], byrow=TRUE) 235 } 236 237 return( x ) 238} 239) 240 241