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