1
2setMethod("length", signature(x="SpatRasterDataset"),
3	function(x) {
4		x@ptr$nsds()
5	}
6)
7
8
9setMethod("sds", signature(x="character"),
10	function(x, ids=0) {
11
12		if (length(x) > 1) {
13			r <- lapply(x, rast)
14			s <- sds(r)
15			names(s) <- tools::file_path_sans_ext(basename(x))
16			return(s)
17		}
18
19		x <- trimws(x[1])
20		if (nchar(x) == 0) {
21			error("sds", "provide valid file name(s)")
22		}
23		f <- .fullFilename(x)
24		r <- methods::new("SpatRasterDataset")
25		ids <- round(ids)-1
26		if (ids[1] < 0) {
27			useids <- FALSE
28		} else {
29			useids <- TRUE
30		}
31		r@ptr <- SpatRasterStack$new(f, ids, useids)
32		messages(r, "sds")
33	}
34)
35
36setMethod("sds", signature(x="missing"),
37	function(x) {
38		r <- methods::new("SpatRasterDataset")
39		r@ptr <- SpatRasterStack$new()
40		r
41	}
42)
43
44
45setMethod("sds", signature(x="SpatRaster"),
46	function(x, ...) {
47		r <- methods::new("SpatRasterDataset")
48		r@ptr <- SpatRasterStack$new()
49		r@ptr$add(x@ptr, varnames(x)[1], longnames(x)[1], units(x)[1], FALSE)
50		dots <- list(...)
51		nms <- names(dots)
52		if (is.null(nms)) nms = ""
53		nms <- rep_len(nms, length(dots))
54		for (i in seq_along(dots)) {
55			if (inherits(dots[[i]], "SpatRaster")) {
56				r@ptr$add(dots[[i]]@ptr, nms[i], "", "", FALSE)
57			}
58		}
59		messages(r, "sds")
60	}
61)
62
63setMethod("sds", signature(x="list"),
64	function(x) {
65		r <- methods::new("SpatRasterDataset")
66		r@ptr <- SpatRasterStack$new()
67		nms <- names(x)
68		if (is.null(nms)) nms <- rep("", length(x))
69		for (i in seq_along(x)) {
70			if (inherits(x[[i]], "SpatRaster")) {
71				r@ptr$add(x[[i]]@ptr, nms[i], "", "", FALSE)
72			}
73		}
74		messages(r, "sds")
75	}
76)
77
78setMethod("sds", signature(x="stars"),
79	function(x) {
80		s <- from_stars(x)
81		if (inherits(s, "SpatRaster")) {
82			sds(s)
83		} else {
84			s
85		}
86	}
87)
88
89setMethod("sds", signature(x="stars_proxy"),
90	function(x) {
91		s <- from_stars(x)
92		if (inherits(s, "SpatRaster")) {
93			sds(s)
94		} else {
95			s
96		}
97	}
98)
99
100
101setMethod("c", signature(x="SpatRasterDataset"),
102	function(x, ...) {
103
104		x@ptr <- x@ptr$subset((1:x@ptr$nsds()) -1 ) # why? make a copy?
105
106		dots <- list(...)
107		nms <- names(dots)
108
109		for (i in seq_along(dots)) {
110			if (inherits(dots[[i]], "SpatRasterDataset")) {
111				sdsnms <- names(dots[[i]])
112				for (j in 1:(length(dots[[i]]))) {
113					if (!x@ptr$add(dots[[i]][[j]]@ptr, sdsnms[j], "", "", FALSE)) {
114						messages(x, "c")
115					}
116				}
117
118			} else if (inherits(dots[[i]], "SpatRaster")) {
119				if (is.null(nms)) error("c", "arguments must be named")
120				if (!x@ptr$add(dots[[i]]@ptr, nms[i], "", "", FALSE)) {
121					messages(x, "c")
122				}
123			} else {
124				error("c", "arguments must be SpatRaster or SpatRasterDataset")
125			}
126		}
127		messages(x, "c")
128	}
129)
130
131
132setReplaceMethod("[", c("SpatRasterDataset","numeric","missing"),
133	function(x, i, j, value) {
134		if (any(!is.finite(i)) | any(i<1)) {
135			error("`[`", "invalid index")
136		}
137		stopifnot(inherits(value, "SpatRaster"))
138		i <- sort(i)
139		for (j in i) {
140			if (j == (length(x)+1)) {
141				x@ptr$add(value@ptr, "", "", "", FALSE)
142			} else {
143				x@ptr$replace(j-1, value@ptr)
144			}
145		}
146		messages(x, "`[`")
147	}
148)
149
150
151setMethod("[", c("SpatRasterDataset", "numeric", "missing"),
152function(x, i, j, ... ,drop=TRUE) {
153	i <- positive_indices(i, length(x), " [ ")
154
155	if (drop && (length(i) == 1)) {
156		ptr <- x@ptr$getsds(i-1)
157		x <- rast()
158		x@ptr <- ptr
159	} else {
160		x@ptr <- x@ptr$subset(i-1)
161	}
162	messages(x, "`[`")
163})
164
165setMethod("[", c("SpatRasterDataset", "numeric", "numeric"),
166function(x, i, j, ... ,drop=TRUE) {
167	y <- x[i,drop=drop]
168	if (inherits(y, "SpatRaster")) {
169		return(y[[j]])
170	}
171	nd <- y@ptr$nsds()
172	x@ptr <- SpatRasterStack$new()
173	nms <- y@ptr$names
174	for (k in seq_along(1:nd)) {
175		r <- y[k][[j]]
176		x@ptr$add(r@ptr, nms[k], "", "", FALSE)
177	}
178	messages(x, "`[`")
179})
180
181
182setMethod("[", c("SpatRasterDataset", "logical", "missing"),
183function(x, i, j, ... ,drop=TRUE) {
184	x[which(i), ..., drop=drop]
185})
186
187setMethod("[", c("SpatRasterDataset", "character", "missing"),
188function(x, i, j, ... ,drop=TRUE) {
189	i <- match(i, names(x))
190	if (any(is.na(i))) {
191		error("`[`", "unknown name(s) provided")
192	}
193	x[i, ..., drop=drop]
194})
195
196setMethod("[[", c("SpatRasterDataset", "ANY", "ANY"),
197function(x, i, j, ... ,drop=TRUE) {
198	mi <- missing(i)
199	mj <- missing(j)
200
201	if ((mi) && (mj)) {
202		`[`(x, ..., drop=drop)
203	} else if (mi) {
204		`[`(x, j=j, ..., drop=drop)
205	} else if (mj) {
206		`[`(x, i=i, ..., drop=drop)
207	} else {
208		`[`(x, i=i, j=j, ..., drop=drop)
209	}
210})
211
212
213setMethod("$", "SpatRasterDataset",
214	function(x, name) {
215		x[name]
216	}
217)
218
219
220
221setMethod("src", signature(x="missing"),
222	function(x) {
223		r <- methods::new("SpatRasterCollection")
224		r@ptr <- SpatRasterCollection$new()
225		r
226	}
227)
228
229
230setMethod("src", signature(x="SpatRaster"),
231	function(x, ...) {
232		src(list(x, ...))
233	}
234)
235
236
237setMethod("src", signature(x="list"),
238	function(x) {
239		n <- length(x)
240		ptr <- SpatRasterCollection$new()
241		if (n > 0) {
242			for (i in 1:n) {
243				if (inherits(x[[i]], "SpatRaster")) {
244					ptr$add(x[[i]]@ptr)
245				} else {
246					name <- names(x[[i]])
247					cls <- class(x[[i]])
248					error("src", "list elements should be 'SpatRaster'\n", name, "is of class: ", cls)
249				}
250			}
251		}
252		x <- new("SpatRasterCollection")
253		x@ptr <- ptr
254		x
255	}
256)
257
258
259setMethod("length", signature(x="SpatRasterCollection"),
260	function(x) {
261		x@ptr$length()
262	}
263)
264
265setMethod("[", c("SpatRasterCollection", "numeric", "missing"),
266function(x, i, j, ... ,drop=TRUE) {
267	i <- positive_indices(i, length(x), " [ ")
268	if (drop && (length(i) == 1)) {
269		ptr <- x@ptr$x[i][[1]]
270		x <- rast()
271		x@ptr <- ptr
272	} else {
273		s <- x@ptr$x[i]
274		ptr <- SpatRasterCollection$new()
275		for (i in 1:length(s)) {
276			ptr$add(s[[i]])
277		}
278		x@ptr <- ptr
279	}
280	messages(x, "`[`")
281})
282
283