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