-
Notifications
You must be signed in to change notification settings - Fork 4
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
Showing
7 changed files
with
311 additions
and
5 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,162 @@ | ||
| #' persp.ppp.R | ||
| #' | ||
| #' Perspective plot for marked point pattern | ||
| #' | ||
| #' Copyright (C) Adrian Baddeley 2024 | ||
| #' GPL Public Licence >= 2.0 | ||
| #' | ||
| #' $Revision: 1.3 $ $Date: 2024/09/07 01:34:04 $ | ||
|
|
||
| persp.ppp <- local({ | ||
|
|
||
| persp.ppp <- function(x, ..., main, grid=TRUE, ngrid=10, | ||
| col.grid="grey", col.base="white", | ||
| win.args=list(), | ||
| spike.args=list(), | ||
| neg.args=list(), which.marks=1, | ||
| zlab=NULL, zlim=NULL, | ||
| zadjust=1) { | ||
| if(missing(main)) main <- short.deparse(substitute(x)) | ||
| W <- Window(x) | ||
| R <- Frame(x) | ||
| marx <- marks(x) | ||
| dotargs <- list(...) | ||
| #' ensure numeric marks | ||
| mf <- markformat(marx) | ||
| switch(mf, | ||
| none = { | ||
| stop("point pattern must have marks", call.=FALSE) | ||
| }, | ||
| vector = { | ||
| if(is.null(zlab)) zlab <- "mark" | ||
| }, | ||
| dataframe = { | ||
| if(missing(which.marks)) { | ||
| marx <- numeric.columns(marx) | ||
| } | ||
| cn <- colnames(marx) | ||
| stopifnot(length(which.marks) == 1) | ||
| if(is.character(which.marks)) { | ||
| k <- match(which.marks, cn) | ||
| if(is.na(k)) | ||
| stop(paste("unrecognised selection of mark column", | ||
| sQuote(which.marks)), | ||
| call.=FALSE) | ||
| which.marks <- k | ||
| } | ||
| if(missing(zlab)) zlab <- colnames(marx)[which.marks] | ||
| marx <- marx[,which.marks] | ||
| }, | ||
| stop("marks should be a vector or a data frame", call.=FALSE) | ||
| ) | ||
| marx <- as.numeric(marx) | ||
| #' rescale marks to a scale commensurate with window | ||
| #' (to achieve appropriate default scale in persp.default) | ||
| maxmark <- max(abs(marx)) | ||
| if(maxmark > .Machine$double.eps) { | ||
| marx <- marx * (max(sidelengths(R))/maxmark) | ||
| } | ||
| #' set up perspective transformation and plot horizontal plane | ||
| Rplus <- grow.rectangle(R, fraction=1/(2*ngrid)) | ||
| Z <- as.im(0, W=Rplus, dimyx=rev(ngrid)+1) | ||
| if(is.null(zlim)) zlim <- range(marx, 0) | ||
| check.range(zlim) | ||
| col.grid.used <- if(grid && (zlim[1] >= 0)) col.grid else NA | ||
| argh <- resolve.defaults(list(x=Z, main=main, | ||
| border=col.grid.used, | ||
| col=col.base), | ||
| dotargs, | ||
| list(axes=FALSE, box=FALSE, | ||
| zlim=zlim, zlab=zlab, | ||
| #' do not independently rescale x & y | ||
| scale=FALSE, | ||
| #' expand=0.1 is default in persp.default | ||
| expand=zadjust * 0.1)) | ||
| M <- do.call.matched(persp.im, argh, | ||
| funargs=graphicsPars("persp")) | ||
| #' create spikes | ||
| S <- xyzsegmentdata(x$x, x$y, 0, | ||
| x$x, x$y, marx) | ||
| if(grid) { | ||
| if(zlim[1] < 0) { | ||
| #' first draw downward spikes | ||
| downward <- (marx < 0) | ||
| if(any(downward)) { | ||
| SD <- S[downward, , drop=FALSE] | ||
| spectiveSegments(SD, neg.args, spike.args, ..., M=M) | ||
| S <- S[!downward, , drop=FALSE] | ||
| } | ||
| #' plot baseline grid | ||
| spectiveFlatGrid(R, ngrid, M, col=col.grid) | ||
| } | ||
| } | ||
| if(!is.rectangle(W)) { | ||
| #' plot window | ||
| spectiveFlatPolygons(W, M, win.args, dotargs) | ||
| } | ||
| #' draw upward spikes | ||
| if(nrow(S) > 0) { | ||
| spectiveSegments(S, spike.args, dotargs, M=M) | ||
| } | ||
| #' | ||
| invisible(M) | ||
| } | ||
|
|
||
| xyzsegmentdata <- function(x0, y0, z0, x1, y1, z1) { | ||
| data.frame(x0=x0, y0=y0, z0=z0, x1=x1, y1=y1, z1=z1) | ||
| } | ||
|
|
||
| trans3dz <- function(x,y,z,pmat) { | ||
| tr <- cbind(x, y, z, 1) %*% pmat | ||
| list(x = tr[, 1]/tr[, 4], | ||
| y = tr[, 2]/tr[, 4], | ||
| z = tr[, 3]/tr[, 4]) | ||
| } | ||
|
|
||
| spectiveFlatGrid <- function(B, ngrid, M, ...) { | ||
| ## arguments ... should be lists of parameters | ||
| B <- Frame(B) | ||
| xr <- B$xrange | ||
| yr <- B$yrange | ||
| ngrid <- ensure2vector(ngrid) | ||
| xx <- seq(xr[1], xr[2], length.out=ngrid[1]+1) | ||
| yy <- seq(yr[1], yr[2], length.out=ngrid[2]+1) | ||
| horiz <- xyzsegmentdata(xr[1], yy, 0, xr[2], yy, 0) | ||
| vert <- xyzsegmentdata(xx, yr[1], 0, xx, yr[2], 0) | ||
| spectiveSegments(horiz, ..., M=M) | ||
| spectiveSegments(vert, ..., M=M) | ||
| invisible(NULL) | ||
| } | ||
|
|
||
| spectiveFlatPolygons <- function(W, M, ...) { | ||
| ## arguments ... should be lists of parameters | ||
| Wbdry <- as.polygonal(W)$bdry | ||
| Pbdry <- lapply(Wbdry, | ||
| function(p, M) { | ||
| as.list(trans3dz(p$x, p$y, 0, M))[c("x","y")] | ||
| }, M=M) | ||
| P <- owin(poly=Pbdry, check=FALSE, fix=FALSE) | ||
| do.call(plot.owin, | ||
| resolve.defaults(list(quote(P)), | ||
| ..., | ||
| list(add=TRUE))) | ||
| } | ||
|
|
||
| spectiveSegments <- function(df, ..., M) { | ||
| ## arguments ... should be lists of parameters | ||
| a0 <- with(df, trans3dz(x0, y0, z0, M)) | ||
| a1 <- with(df, trans3dz(x1, y1, z1, M)) | ||
| do.call.matched(segments, | ||
| resolve.defaults( | ||
| list(x0=a0$x, | ||
| y0=a0$y, | ||
| x1=a1$x, | ||
| y1=a1$y), | ||
| ...)) | ||
| invisible(NULL) | ||
| } | ||
|
|
||
| persp.ppp | ||
| }) | ||
|
|
||
|
|
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,133 @@ | ||
| \name{persp.ppp} | ||
| \alias{persp.ppp} | ||
| \title{ | ||
| Perspective Plot of Marked Point Pattern | ||
| } | ||
| \description{ | ||
| For a spatial point pattern with numeric marks, | ||
| generate a perspective plot in which each data point is | ||
| shown as a vertical spike, with height proportional to the mark value. | ||
| } | ||
| \usage{ | ||
| \method{persp}{ppp}(x, \dots, main, grid = TRUE, ngrid = 10, | ||
| col.grid = "grey", col.base = "white", | ||
| win.args=list(), spike.args = list(), neg.args = list(), | ||
| which.marks = 1, zlab = NULL, zlim = NULL, zadjust = 1) | ||
| } | ||
| \arguments{ | ||
| \item{x}{ | ||
| A spatial point pattern (object of class \code{"ppp"}) | ||
| with numeric marks, or a data frame of marks. | ||
| } | ||
| \item{\dots}{ | ||
| Additional graphical arguments passed to | ||
| \code{\link{persp.default}} to determine the perspective view | ||
| (for example the rotation angle \code{theta} and the elevation angle | ||
| \code{phi}) | ||
| or passed to \code{\link[graphics]{segments}} to control the drawing | ||
| (for example \code{lwd} for line width). | ||
| } | ||
| \item{main}{ | ||
| Optional main title for the plot. | ||
| } | ||
| \item{grid}{ | ||
| Logical value specifying whether to draw a grid of reference lines | ||
| on the horizontal plane. | ||
| } | ||
| \item{ngrid}{ | ||
| Number of grid lines to draw in each direction, if \code{grid=TRUE}. | ||
| An integer, or a pair of integers specifying the number of grid | ||
| lines along the horizontal and vertical axes respectively. | ||
| } | ||
| \item{col.grid}{ | ||
| Colour of grid lines, if \code{grid=TRUE}. | ||
| } | ||
| \item{col.base}{ | ||
| Colour with which to fill the horizontal plane. | ||
| } | ||
| \item{win.args}{ | ||
| List of arguments passed to \code{\link{plot.owin}} | ||
| to control the drawing of the window of \code{x}. | ||
| Applicable only when the window is not a rectangle. | ||
| } | ||
| \item{spike.args}{ | ||
| List of arguments passed to \code{\link[graphics]{segments}} | ||
| to control the drawing of the spikes. | ||
| } | ||
| \item{neg.args}{ | ||
| List of arguments passed to \code{\link[graphics]{segments}} | ||
| applicable only to those spikes which have negative height | ||
| (corresponding to a mark value which is negative). | ||
| } | ||
| \item{which.marks}{ | ||
| Integer, or character name, identifying the column of marks which | ||
| should be used, when \code{marks(x)} is a data frame. | ||
| } | ||
| \item{zlab}{ | ||
| Optional. Label for the vertical axis. | ||
| Character string or expression. | ||
| } | ||
| \item{zlim}{ | ||
| Optional. Range of values on the vertical axis. | ||
| A numeric vector of length 2. | ||
| } | ||
| \item{zadjust}{ | ||
| Scale adjustment factor controlling the height of spikes. | ||
| } | ||
| } | ||
| \details{ | ||
| The function \code{\link[graphics]{persp}} is generic. This is the | ||
| method for spatial point patterns (objects of class \code{"ppp"}). | ||
| The argument \code{x} must be a point pattern with numeric marks, | ||
| or with a data frame of marks. | ||
|
|
||
| A perspective view will be plotted. The eye position is determined by | ||
| the arguments \code{theta} and \code{phi} | ||
| passed to \code{\link[graphics]{persp.default}}. | ||
|
|
||
| First the horizontal plane is drawn in perspective view, | ||
| using a faint grid of lines to help suggest the perspective. | ||
| Next the observation window of \code{x} is placed on the horizontal | ||
| plane and its edges are drawn in perspective view. | ||
| Finally for each data point in \code{x}, a vertical spike is erected | ||
| at the spatial location of the data point, with height equal to the | ||
| mark value of the point. | ||
|
|
||
| If any mark values are negative, the corresponding spikes will | ||
| penetrate below the horizontal plane. They can be drawn in a different | ||
| colour by specifying \code{neg.args} as shown in the examples. | ||
|
|
||
| Like all spatial plots in the \pkg{spatstat} family, | ||
| \code{persp.ppp} does not independently rescale | ||
| the \eqn{x} and \eqn{y} coordinates. A long narrow window will be | ||
| represented as a long narrow window in the perspective view. | ||
| To override this and allow the coordinates to be independently | ||
| rescaled, use the argument \code{scale=TRUE} which will be passed | ||
| to \code{\link[graphics]{persp.default}}. | ||
| } | ||
| \value{ | ||
| (Invisibly) the perspective transformation matrix. | ||
| } | ||
| \author{ | ||
| Adrian Baddeley. | ||
| } | ||
| \examples{ | ||
| persp(longleaf, theta=-30, phi=35, spike.args=list(lwd=3), zadjust=1.5) | ||
|
|
||
| # negative mark values | ||
| X <- longleaf | ||
| marks(X) <- marks(X) - 20 | ||
| persp(X, theta=80, phi=35, neg.args=list(col="red"), | ||
| spike.args=list(lwd=3), zadjust=1.2) | ||
|
|
||
| # irregular window | ||
| Australia <- Window(austates) | ||
| Y <- runifrect(70, Frame(Australia))[Australia] | ||
| marks(Y) <- runif(npoints(Y)) | ||
| persp(Y, theta=30, phi=20, col.base="lightblue", | ||
| win.args=list(col="pink", border=NA), | ||
| spike.args=list(lwd=2), zadjust=1.5) | ||
|
|
||
| } | ||
| \keyword{hplot} | ||
| \keyword{spatial} |