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