1 2 3setClass("PackedSpatVector", 4 representation ( 5 type = "character", 6 crs = "character", 7 coordinates = "matrix", 8 index = "matrix", 9 attributes = "data.frame" 10 ), 11 prototype ( 12 type= "", 13 crs = "" 14 ) 15) 16 17 18setClass("PackedSpatRaster", 19 representation ( 20 definition = "character", 21 values = "matrix", 22 attributes = "list" 23 ), 24 prototype ( 25 attributes = list() 26 ) 27) 28 29 30.packVector <- function(x) { 31 vd <- methods::new("PackedSpatVector") 32 vd@type <- geomtype(x) 33 vd@crs <- as.character(crs(x)) 34 stopifnot(vd@type %in% c("points", "lines", "polygons")) 35 g <- geom(x) 36 vd@coordinates <- g[, c("x", "y")] 37 j <- c(1,2, grep("hole", colnames(g))) 38 g <- g[,j] 39 i <- which(!duplicated(g)) 40 vd@index <- cbind(g[i, ], start=i) 41 vd 42} 43 44setMethod("wrap", signature(x="Spatial"), 45 function(x) { 46 pv <- .packVector(x) 47 if (methods::.hasSlot(x, "data")) { 48 pv@attributes <- x@data 49 } 50 pv 51 } 52) 53 54 55setMethod("wrap", signature(x="SpatVector"), 56 function(x) { 57 pv <- .packVector(x) 58 pv@attributes <- as.data.frame(x) 59 pv 60 } 61) 62 63 64setMethod("vect", signature(x="PackedSpatVector"), 65 function(x) { 66 p <- methods::new("SpatVector") 67 p@ptr <- SpatVector$new() 68 if (!is.na(x@crs)) { 69 crs(p) <- x@crs 70 } 71 if (nrow(x@coordinates) == 0) { 72 return(p) 73 } 74 75 n <- ncol(x@index) 76 reps <- diff(c(x@index[,n], nrow(x@coordinates)+1)) 77 i <- rep(1:nrow(x@index), reps) 78 if (n == 2) { 79 p@ptr$setGeometry(x@type, x@index[i,1], x@index[i,2], x@coordinates[,1], x@coordinates[,2], rep(0, nrow(x@coordinates))) 80 } else { 81 p@ptr$setGeometry(x@type, x@index[i,1], x@index[i,2], x@coordinates[,1], x@coordinates[,2], x@index[i,3]) 82 } 83 if (nrow(x@attributes) > 0) { 84 values(p) <- x@attributes 85 } 86 messages(p, "pack") 87 } 88) 89 90setMethod("show", signature(object="PackedSpatVector"), 91 function(object) { 92 print(paste("This is a", class(object), "object. Use 'terra::vect()' to unpack it")) 93 } 94) 95 96 97 98 99 100setMethod("as.character", signature(x="SpatRaster"), 101 function(x) { 102 e <- as.vector(ext(x)) 103 crs <- crs(x) 104 crs <- ifelse(is.na(crs), ", crs=''", paste0(", crs='", crs, "'")) 105 crs <- gsub("\n[ ]+", "", crs) 106 nms <- paste0(", names=c('", paste(names(x), collapse="', '"), "')") 107 paste0("rast(", 108 "ncols=", ncol(x), 109 ", nrows=", nrow(x), 110 ", nlyrs=", nlyr(x), 111 ", xmin=",e[1], 112 ", xmax=",e[2], 113 ", ymin=",e[3], 114 ", ymax=",e[4], 115 nms, 116 crs, ")" 117 ) 118 } 119) 120#eval(parse(text=as.character(s))) 121 122 123setMethod("wrap", signature(x="SpatRaster"), 124 function(x) { 125 r <- methods::new("PackedSpatRaster") 126 r@definition <- as.character(x) 127 r@values <- values(x) 128 if (any(is.factor(x))) { 129 r@attributes <- levels(x) 130 } 131 r 132 } 133) 134 135 136setMethod("rast", signature(x="PackedSpatRaster"), 137 function(x) { 138 r <- eval(parse(text=x@definition)) 139 values(r) <- x@values 140 if (length(x@attributes) > 0) { 141 levels(r) <- x@attributes 142 } 143 r 144 } 145) 146 147setMethod("show", signature(object="PackedSpatRaster"), 148 function(object) { 149 print(paste("This is a", class(object), "object. Use 'terra::rast()' to unpack it")) 150 } 151) 152