1check_spatstat <- function(pkg="spatstat.geom") { 2 if (!requireNamespace(pkg, quietly = TRUE)) { 3 stop(paste("package ", pkg, 4 " required; please install it (or the full spatstat package) first")) 5 } else { 6 spst_ver <- try(packageVersion("spatstat"), silent = TRUE) 7 if(!inherits(spst_ver, "try-error") && spst_ver < 2.0-0) { 8 stop(paste("You have an old version of spatstat installed which is", 9 " incompatible with ", pkg, 10 ". Please update spatstat (or uninstall it).", sep="")) 11 } 12 } 13} 14 15 16# as.ppp method to be used in spatstat: 17 18as.ppp.SpatialPoints = function(X) { 19 if (!is.na(sp::is.projected(X)) && !sp::is.projected(X)) 20 stop("Only projected coordinates may be converted to spatstat class objects") 21 check_spatstat("spatstat.geom") 22 bb <- bbox(X) 23 colnames(bb) <- NULL 24 W = spatstat.geom::owin(bb[1,], bb[2,]) 25 cc = coordinates(X) 26 spatstat.geom::ppp(cc[,1], cc[,2], window = W, marks = NULL, check=FALSE) 27} 28 29setAs("SpatialPoints", "ppp", function(from) as.ppp.SpatialPoints(from)) 30 31# Mike Sumner 20101011 32as.ppp.SpatialPointsDataFrame = function(X) { 33 if (!is.na(sp::is.projected(X)) && !sp::is.projected(X)) 34 stop("Only projected coordinates may be converted to spatstat class objects") 35 check_spatstat("spatstat.geom") 36 bb <- bbox(X) 37 colnames(bb) <- NULL 38 W <- spatstat.geom::owin(bb[1,], bb[2,]) 39 nc <- ncol(X) 40 marks <- if(nc == 0) NULL else slot(X, "data") 41# if(nc > 1) 42# warning(paste(nc-1, "columns of data frame discarded")) 43 cc <- coordinates(X) 44 spatstat.geom::ppp(cc[,1], cc[,2], window = W, marks = marks, check=FALSE) 45} 46 47setAs("SpatialPointsDataFrame", "ppp", function(from) as.ppp.SpatialPointsDataFrame(from)) 48 49as.owin.SpatialGridDataFrame = function(W, ..., fatal) { 50 if (!is.na(sp::is.projected(W)) && !sp::is.projected(W)) 51 stop("Only projected coordinates may be converted to spatstat class objects") 52 check_spatstat("spatstat.geom") 53 # W = from 54 m = t(!is.na(as(W, "matrix"))) 55 spatstat.geom::owin(bbox(W)[1,], bbox(W)[2,], mask = m[nrow(m):1,]) 56} 57 58setAs("SpatialGridDataFrame", "owin", function(from) as.owin.SpatialGridDataFrame(from)) 59 60as.owin.SpatialPixelsDataFrame = function(W, ..., fatal) { 61 if (!is.na(sp::is.projected(W)) && !sp::is.projected(W)) 62 stop("Only projected coordinates may be converted to spatstat class objects") 63 check_spatstat("spatstat.geom") 64 # W = from 65 m = t(!is.na(as(W, "matrix"))) 66 spatstat.geom::owin(bbox(W)[1,], bbox(W)[2,], mask = m[nrow(m):1,]) 67} 68 69setAs("SpatialPixelsDataFrame", "owin", function(from) as.owin.SpatialPixelsDataFrame(from)) 70 71as.owin.SpatialPolygons = function(W, ..., fatal) { 72 # W = from 73 if (!is.na(sp::is.projected(W)) && !sp::is.projected(W)) 74 stop("Only projected coordinates may be converted to spatstat class objects") 75 if (!inherits(W, "SpatialPolygons")) 76 stop("W must be a SpatialPolygons object") 77 res <- .SP2owin(W) 78 res 79} 80 81setAs("SpatialPolygons", "owin", function(from) as.owin.SpatialPolygons(from)) 82 83# methods for coercion to Spatial Polygons by Adrian Baddeley 84 85owin2Polygons <- function(x, id="1") { 86 check_spatstat("spatstat.geom") 87 stopifnot(spatstat.geom::is.owin(x)) 88 x <- spatstat.geom::as.polygonal(x) 89 closering <- function(df) { df[c(seq(nrow(df)), 1), ] } 90 check_spatstat("spatstat.utils") 91 pieces <- lapply(x$bdry, 92 function(p) {Polygon(coords=closering(cbind(p$x,p$y)), 93 hole=spatstat.utils::is.hole.xypolygon(p)) }) 94 z <- Polygons(pieces, id) 95 return(z) 96} 97 98as.SpatialPolygons.tess <- function(x) { 99 check_spatstat("spatstat.geom") 100 stopifnot(spatstat.geom::is.tess(x)) 101 y <- spatstat.geom::tiles(x) 102 nam <- names(y) 103 z <- list() 104 for(i in seq(y)) { 105 zi <- try(owin2Polygons(y[[i]], nam[i]), silent=TRUE) 106 if (inherits(zi, "try-error")) { 107 warning(paste("tile", i, "defective\n", as.character(zi))) 108 } else { 109 z[[i]] <- zi 110 } 111 } 112 return(SpatialPolygons(z)) 113} 114 115setAs("tess", "SpatialPolygons", function(from) as.SpatialPolygons.tess(from)) 116 117 118as.SpatialPolygons.owin <- function(x) { 119 check_spatstat("spatstat.geom") 120 stopifnot(spatstat.geom::is.owin(x)) 121 y <- owin2Polygons(x) 122 z <- SpatialPolygons(list(y)) 123 return(z) 124} 125 126setAs("owin", "SpatialPolygons", function(from) as.SpatialPolygons.owin(from)) 127 128 129 130# methods for 'as.psp' for sp classes by Adrian Baddeley 131 132as.psp.Line <- function(from, ..., window=NULL, marks=NULL, fatal) { 133 check_spatstat("spatstat.geom") 134 xy <- slot(from, "coords") 135 df <- as.data.frame(cbind(xy[-nrow(xy), , drop=FALSE], xy[-1, , 136drop=FALSE])) 137 if(is.null(window)) { 138 xrange <- range(xy[,1]) 139 yrange <- range(xy[,2]) 140 window <- spatstat.geom::owin(xrange, yrange) 141 } 142 return(spatstat.geom::as.psp(df, window=window, marks=marks)) 143} 144 145setAs("Line", "psp", function(from) as.psp.Line(from)) 146 147as.psp.Lines <- function(from, ..., window=NULL, marks=NULL, fatal) { 148 check_spatstat("spatstat.geom") 149 y <- lapply(slot(from, "Lines"), as.psp.Line, window=window) 150 z <- do.call(spatstat.geom::superimpose,c(y,list(W=window))) 151 if(!is.null(marks)) 152 spatstat.geom::marks(z) <- marks 153 return(z) 154} 155 156setAs("Lines", "psp", function(from) as.psp.Lines(from)) 157 158as.psp.SpatialLines <- function(from, ..., window=NULL, marks=NULL, 159 characterMarks=FALSE, fatal) { 160 if (!is.na(sp::is.projected(from)) && !sp::is.projected(from)) 161 stop("Only projected coordinates may be converted to spatstat class objects") 162 check_spatstat("spatstat.geom") 163 if(is.null(window)) { 164 w <- slot(from, "bbox") 165 window <- spatstat.geom::owin(w[1,], w[2,]) 166 } 167 lin <- slot(from, "lines") 168 y <- lapply(lin, as.psp.Lines, window=window) 169 id <- row.names(from) 170 if(is.null(marks)) 171 for (i in seq(y)) 172 spatstat.geom::marks(y[[i]]) <- if(characterMarks) id[i] else factor(id[i]) 173# modified 110401 Rolf Turner 174 z <- do.call(spatstat.geom::superimpose, c(y, list(W = window))) 175 if(!is.null(marks)) 176 spatstat.geom::marks(z) <- marks 177 return(z) 178} 179 180setAs("SpatialLines", "psp", function(from) as.psp.SpatialLines(from)) 181 182as.psp.SpatialLinesDataFrame <- function(from, ..., window=NULL, marks=NULL, fatal) { 183 if (!is.na(sp::is.projected(from)) && !sp::is.projected(from)) 184 stop("Only projected coordinates may be converted to spatstat class objects") 185 check_spatstat("spatstat.geom") 186 y <- as(from, "SpatialLines") 187 z <- spatstat.geom::as.psp(y, window=window, marks=marks) 188 if(is.null(marks)) { 189 # extract marks from first column of data frame 190 df <- from@data 191 if(is.null(df) || (nc <- ncol(df)) == 0) 192 return(z) 193 if(nc > 1) 194 warning(paste(nc-1, "columns of data frame discarded")) 195 marx <- df[,1] 196 nseg.Line <- function(x) { return(nrow(x@coords)-1) } 197 nseg.Lines <- function(x) { return(sum(unlist(lapply(x@Lines, nseg.Line)))) } 198 nrep <- unlist(lapply(y@lines, nseg.Lines)) 199 spatstat.geom::marks(z) <- rep(marx, nrep) 200 } 201 return(z) 202} 203 204setAs("SpatialLinesDataFrame", "psp", function(from) as.psp.SpatialLinesDataFrame(from)) 205 206# 111117 from psp to SpatialLines, Rolf Turner, Adrian Baddeley, Mathieu Rajerison 207 208as.SpatialLines.psp <- function(from) { 209 210 ends2line <- function(x) Line(matrix(x, ncol=2, byrow=TRUE)) 211 munch <- function(z) { Lines(ends2line(as.numeric(z[1:4])), ID=z[5]) } 212 213 ends <- as.data.frame(from)[,1:4] 214 ends[,5] <- row.names(ends) 215 y <- apply(ends, 1, munch) 216 SpatialLines(y) 217} 218 219setAs("psp", "SpatialLines", function(from) as.SpatialLines.psp(from)) 220