1# Authors: Robert J. Hijmans
2# Date :  October 2018
3# Version 1.0
4# License GPL v3
5
6positive_indices <- function(i, n, caller=" [ ") {
7	if (!(all(i <= 0) || all(i >= 0))) {
8		error(caller, "you cannot mix positive and negative indices")
9	}
10	i <- stats::na.omit(i)
11	(1:n)[i]
12}
13
14
15setMethod("subset", signature(x="SpatRaster"),
16function(x, subset, filename="", overwrite=FALSE, ...) {
17	if (is.character(subset)) {
18		i <- match(subset, names(x))
19	} else {
20		i <- as.integer(subset)
21		i[(i<1) | (i>nlyr(x))] <- NA
22	}
23	if (any(is.na(i))) {
24		error("subset", paste("undefined layer(s) selected:", paste(subset[is.na(i)], collapse=", ")))
25	}
26	opt <- spatOptions(filename, overwrite, ...)
27	x@ptr <- x@ptr$subset(i-1, opt)
28	messages(x, "subset")
29	return(x)
30} )
31
32
33## expression matching
34setMethod("[", c("SpatRaster", "character", "missing"),
35	function(x, i, j, ... ,drop=TRUE) {
36		i <- grep(i, names(x))
37		subset(x, i, ...)
38	}
39)
40
41## exact matching
42
43setMethod("[[", c("SpatRaster", "character", "missing"),
44function(x, i, j, ... ,drop=TRUE) {
45	subset(x, i, ...)
46})
47
48setMethod("$", "SpatRaster",
49	function(x, name) {
50		subset(x, name)
51	}
52)
53
54setMethod("[[", c("SpatRaster", "logical", "missing"),
55function(x, i, j, ... ,drop=TRUE) {
56	subset(x, which(i), ...)
57})
58
59
60setMethod("[[", c("SpatRaster", "numeric", "missing"),
61function(x, i, j, ... ,drop=TRUE) {
62	i <- positive_indices(i, nlyr(x), " [[ ")
63	subset(x, i, ...)
64})
65
66
67setMethod("subset", signature(x="SpatVector"),
68	function(x, subset, drop=FALSE) {
69		x <- x[which(as.vector(subset)), , drop=drop]
70		messages(x, "subset")
71	}
72)
73
74
75.subset_cols <- function(x, subset, drop=FALSE) {
76	if (is.character(subset)) {
77		i <- stats::na.omit(match(subset, names(x)))
78	} else {
79		i <- positive_indices(subset, ncol(x), "subset")
80	}
81	if (length(i)==0) {
82		i <- 0
83	}
84	if (length(i) < length(subset)) {
85		warn(" [ ", "invalid columns omitted")
86	}
87	x@ptr <- x@ptr$subset_cols(i-1)
88	x <- messages(x, "subset")
89	if (drop) {	# drop geometry
90		.getSpatDF(x@ptr$df)
91	} else {
92		x
93	}
94}
95
96
97setMethod("[", c("SpatVector", "numeric", "missing"),
98function(x, i, j, ... , drop=FALSE) {
99	i <- positive_indices(i, nrow(x), "'['")
100	x@ptr <- x@ptr$subset_rows(i-1)
101	x <- messages(x, "[")
102	if (drop) {
103		as.data.frame(x)
104	} else {
105		x
106	}
107})
108
109setMethod("[", c("SpatVector", "logical", "missing"),
110function(x, i, j, ... , drop=FALSE) {
111	i <- which(i)
112	x@ptr <- x@ptr$subset_rows(i-1)
113	x <- messages(x, "[")
114	if (drop) {
115		as.data.frame(x)
116	} else {
117		x
118	}
119})
120
121setMethod("[", c("SpatVector", "numeric", "numeric"),
122function(x, i, j, ... , drop=FALSE) {
123	i <- positive_indices(i, nrow(x), "'['")
124	j <- positive_indices(j, ncol(x), "'['")
125	p <- x@ptr$subset_rows(i-1)
126	x@ptr <- p$subset_cols(j-1)
127	x <- messages(x, "'['")
128	if (drop) {
129		as.data.frame(x)
130	} else {
131		x
132	}
133})
134
135
136setMethod("[", c("SpatVector", "missing", "numeric"),
137function(x, i, j, ... , drop=FALSE) {
138	j <- positive_indices(j, ncol(x), "'['")
139	x@ptr <- x@ptr$subset_cols(j-1)
140	x <- messages(x, "[")
141	if (drop) {
142		as.data.frame(x)
143	} else {
144		x
145	}
146})
147
148setMethod("[", c("SpatVector", "missing", "character"),
149function(x, i, j, ... , drop=FALSE) {
150	j <- match(j, names(x))
151	j <- stats::na.omit(j)
152	if (length(j) == 0) {
153		j <- 0
154	}
155	x[,j,drop=drop]
156})
157
158setMethod("[", c("SpatVector", "numeric", "character"),
159function(x, i, j, ... , drop=FALSE) {
160	j <- stats::na.omit(match(j, names(x)))
161	if (length(j) == 0) j <- 0
162	x <- x[i,j,drop=drop]
163})
164
165setMethod("[", c("SpatVector", "logical", "character"),
166function(x, i, j, ... , drop=FALSE) {
167	i <- which(i)
168	x[i,j,drop=drop]
169})
170
171
172setMethod("[", c("SpatVector", "logical", "numeric"),
173function(x, i, j, ... , drop=FALSE) {
174	i <- which(i)
175	x[i,j,drop=drop]
176})
177
178
179
180setMethod("[", c("SpatVector", "missing", "missing"),
181function(x, i, j, ... , drop=FALSE) {
182	if (drop) {
183		values(x)
184	} else {
185		x
186	}
187})
188
189