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