Skip to content

Commit

Permalink
Mainly changes to 3D plotting. No longer depending on scatterplot3d.
Browse files Browse the repository at this point in the history
   plot.anylist.R
	main.panel can now be numeric, etc

   plot3d.R [New file]
   spatstat-internal.Rd
        New internal code for perspective plots of 3D points.
	Internal functions plot3Dpoints and project3Dhom

   pp3.R
   plot.pp3.Rd
	plot.pp3 now uses internal code for plotting.
	plot.pp3 has new arguments.

   options.R
   spatstat.options.Rd
	New option 'par.pp3' sets defaults for plot.pp3

   DESCRIPTION
   NAMESPACE
	spatstat no longer depends on 'scatterplot3d'

   plot.anylist.Rd
   plot.listof.Rd
   demo/spatstat.R
   demo/data.R
   doc/datasets.Rnw
	Removed 'require(scatterplot3d)'

   DESCRIPTION
   NEWS
	updated.
  • Loading branch information
rubak committed Jan 28, 2015
1 parent 4f2d3ec commit 8a21d3f
Showing 16 changed files with 286 additions and 83 deletions.
6 changes: 3 additions & 3 deletions DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
Package: spatstat
Version: 1.40-0.024
Version: 1.40-0.025
Nickname: Team Australia
Date: 2015-01-25
Date: 2015-01-28
Title: Spatial Point Pattern Analysis, Model-fitting, Simulation, Tests
Author: Adrian Baddeley <Adrian.Baddeley@uwa.edu.au>,
Rolf Turner <r.turner@auckland.ac.nz>
@@ -160,7 +160,7 @@ Author: Adrian Baddeley <Adrian.Baddeley@uwa.edu.au>,
Maintainer: Adrian Baddeley <Adrian.Baddeley@uwa.edu.au>
Depends: R (>= 3.1.1), stats, graphics, grDevices, utils
Imports: mgcv, deldir (>= 0.0-21), abind, tensor, polyclip (>= 1.3-0), goftest
Suggests: sm, maptools, gsl, locfit, spatial, rpanel, tkrplot, scatterplot3d, RandomFields (>= 3.0.0), Matrix
Suggests: sm, maptools, gsl, locfit, spatial, rpanel, tkrplot, RandomFields (>= 3.0.0), Matrix
Description: Comprehensive toolbox for analysing spatial data, mainly Spatial Point Patterns, including multitype/marked points and spatial covariates, in any two-dimensional spatial region. Also supports three-dimensional point patterns, space-time point patterns in any number of dimensions, and point patterns on a linear network.
Contains about 2000 functions for plotting spatial data, exploratory data analysis, model-fitting, simulation, spatial sampling, model diagnostics, and formal inference.
Data types include point patterns, line segment patterns, spatial windows, pixel images, tessellations, and linear networks.
2 changes: 2 additions & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
@@ -1418,6 +1418,7 @@ export("pixellate.psp")
export("pixelquad")
export("pknn")
export("plan.legend.layout")
export("plot3Dpoints")
export("plot.addvar")
export("plot.anylist")
export("plot.barplotdata")
@@ -1633,6 +1634,7 @@ export("profilepl")
export("progressreport")
export("project2segment")
export("project2set")
export("project3Dhom")
export("project.ppm")
export("prolongseq")
export("[.psp")
14 changes: 13 additions & 1 deletion NEWS
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@

CHANGES IN spatstat VERSION 1.40-0.024
CHANGES IN spatstat VERSION 1.40-0.025

OVERVIEW

@@ -16,6 +16,8 @@ OVERVIEW

o spatstat no longer uses Fortran.

o spatstat no longer depends on the package 'scatterplot3d'.

o Nickname: 'Team Australia'

NEW FUNCTIONS
@@ -84,6 +86,9 @@ SIGNIFICANT USER-VISIBLE CHANGES
o print.quadrattest
Now respects options('width') and spatstat.options('terse').

o print.pp3
Now respects options('width')

o nnmean
Now yields a vector, instead of a 1-column matrix,
when there is only a single column of marks.
@@ -112,6 +117,13 @@ SIGNIFICANT USER-VISIBLE CHANGES
has changed slightly to use the classes 'anylist' and 'solist'.
There should be no change in behaviour.

o plot.pp3
Now produces a genuine perspective view.
New arguments control the eye position for the perspective view.

o spatstat.options
New option 'par.points3d' sets default arguments for plot.pp3.

o diagnose.ppm
New arguments xlab, ylab, rlab control labels in the 4-panel plot.

8 changes: 7 additions & 1 deletion R/options.R
Original file line number Diff line number Diff line change
@@ -3,7 +3,7 @@
#
# Spatstat options and other internal states
#
# $Revision: 1.59 $ $Date: 2014/11/12 10:24:25 $
# $Revision: 1.60 $ $Date: 2015/01/28 06:23:21 $
#
#

@@ -300,6 +300,12 @@ warn.once <- function(key, ...) {
check=is.list,
valid="a list"
),
par.pp3=list(
## default graphics parameters for 'plot.pp3'
default=list(),
check=is.list,
valid="a list"
),
print.ppm.SE=list(
## under what conditions to print estimated SE in print.ppm
default="poisson",
5 changes: 3 additions & 2 deletions R/plot.anylist.R
Original file line number Diff line number Diff line change
@@ -4,7 +4,7 @@
## Plotting functions for 'solist', 'anylist', 'imlist'
## and legacy class 'listof'
##
## $Revision: 1.5 $ $Date: 2014/12/01 06:20:21 $
## $Revision: 1.6 $ $Date: 2015/01/28 07:02:36 $
##

plot.anylist <- plot.solist <- plot.listof <-
@@ -129,7 +129,8 @@ plot.anylist <- plot.solist <- plot.listof <-
if(is.null(main.panel))
main.panel <- names(x)
else {
stopifnot(is.character(main.panel) || is.expression(main.panel))
if(!is.expression(main.panel))
main.panel <- as.character(main.panel)
nmp <- length(main.panel)
if(nmp == 1)
main.panel <- rep.int(main.panel, n)
167 changes: 167 additions & 0 deletions R/plot3d.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,167 @@
#' perspective plot of 3D
#'
#' $Revision: 1.3 $ $Date: 2015/01/28 05:12:58 $
#'


project3Dhom <- local({

check3dvector <- function(x) {
xname <- deparse(substitute(x))
if(!(is.numeric(x) && length(x) == 3))
stop(paste(xname, "should be a numeric vector of length 3"),
call.=FALSE)
return(NULL)
}

normalise <- function(x) {
len <- sqrt(sum(x^2))
if(len == 0) stop("Attempted to normalise a vector of length 0")
return(x/len)
}

innerprod <- function(a, b) sum(a*b)

crossprod <- function(u, v) {
c(u[2] * v[3] - u[3] * v[2],
-(u[1] * v[3] - u[3] * v[1]),
u[1] * v[2] - u[2] * v[1])
}

project3Dhom <- function(xyz, eye=c(0,-3,1), org=c(0,0,0), vert=c(0,0,1)) {
## xyz: data to be projected (matrix n * 3)
stopifnot(is.matrix(xyz) && ncol(xyz) == 3)
## eye: eye position (x,y,z)
check3dvector(eye)
## org: origin (x,y,z) becomes middle of projection plane
check3dvector(org)
## vert: unit vector in direction to become the 'vertical'
if(!missing(vert)) {
check3dvector(vert)
vert <- normalise(vert)
}
## vector pointing into screen
vin <- normalise(org - eye)
## projection of vertical onto screen
vup <- normalise(vert - innerprod(vert, vin) * vin)
## horizontal axis in screen
vhoriz <- crossprod(vin, vup)
##
dbg <- FALSE
if(dbg) {
cat("vin=")
print(vin)
cat("vup=")
print(vup)
cat("vhoriz=")
print(vhoriz)
}
## homogeneous coordinates
hom <- t(t(xyz) - eye) %*% cbind(vhoriz, vup, vin)
colnames(hom) <- c("x", "y", "d")
return(hom)
}

project3Dhom
})

plot3Dpoints <- local({

plot3Dpoints <- function(xyz, eye=c(2,-3,2), org=c(0,0,0),
...,
xlim=c(0,1), ylim=c(0,1), zlim=c(0,1),
add=FALSE, box=TRUE,
main, cex=par('cex'),
box.back=list(col="pink"),
box.front=list(col="blue", lwd=2)
) {
if(missing(main)) main <- short.deparse(substitute(xyz))
stopifnot(is.matrix(xyz) && ncol(xyz) == 3)
if(nrow(xyz) > 0) {
if(missing(xlim)) xlim <- range(pretty(xyz[,1]))
if(missing(ylim)) ylim <- range(pretty(xyz[,2]))
if(missing(zlim)) zlim <- range(pretty(xyz[,3]))
if(missing(org)) org <- c(mean(xlim), mean(ylim), mean(zlim))
}
if(!add) {
bb <- plot3Dbox(xlim, ylim, zlim, eye=eye, org=org, do.plot=FALSE)
plot(bb$xlim, bb$ylim, axes=FALSE, asp=1, type="n",
xlab="", ylab="", main=main)
}
do.call(plot3DboxPart,
resolve.defaults(list(xlim=xlim,
ylim=ylim,
zlim=zlim,
eye=eye, org=org,
part="back"),
box.back,
list(...)))
uv <- project3Dhom(xyz, eye=eye, org=org)
uv <- as.data.frame(uv)
dord <- order(uv$d, decreasing=TRUE)
with(uv[dord, ,drop=FALSE], points(x/d, y/d, cex=cex * min(d)/d, ...))
do.call(plot3DboxPart,
resolve.defaults(list(xlim=xlim,
ylim=ylim,
zlim=zlim,
eye=eye, org=org,
part="front"),
box.front,
list(...)))
return(invisible(NULL))
}

vertexind <- data.frame(i=rep(1:2,4),
j=rep(rep(1:2,each=2),2),
k=rep(1:2, each=4))

edgepairs <- data.frame(from=c(1, 1, 2, 3, 1, 2, 5, 3, 5, 4, 6, 7),
to = c(2, 3, 4, 4, 5, 6, 6, 7, 7, 8, 8, 8))

vertexfrom <- vertexind[edgepairs$from,]
vertexto <- vertexind[edgepairs$to,]

hamming <- function(a, b) sum(abs(a-b))

## determine projected positions of box vertices
## and optionally plot the box
plot3Dbox <- function(xlim=c(0,1), ylim=xlim, zlim=ylim,
eye=c(0,-3,1), org=c(0,0,0),
do.plot=TRUE) {
fromxyz <- with(vertexfrom, cbind(xlim[i], ylim[j], zlim[k]))
toxyz <- with(vertexto, cbind(xlim[i], ylim[j], zlim[k]))
fromuv <- project3Dhom(fromxyz, eye=eye, org=org)
touv <- project3Dhom(toxyz, eye=eye, org=org)
xfrom <- fromuv[,1]/fromuv[,3]
xto <- touv[,1]/touv[,3]
yfrom <- fromuv[,2]/fromuv[,3]
yto <- touv[,2]/touv[,3]
if(do.plot)
segments(xfrom, yfrom, xto, yto)
return(invisible(list(xlim=range(xfrom, xto), ylim=range(yfrom, yto))))
}

## plot either back or front of box
plot3DboxPart <- function(xlim=c(0,1), ylim=xlim, zlim=ylim,
eye=c(0,-3,1), org=c(0,0,0),
part=c("front", "back"), ...) {
part <- match.arg(part)
boxvert <- with(vertexind, cbind(xlim[i], ylim[j], zlim[k]))
pvert <- project3Dhom(boxvert, eye=eye, org=org)
xyvert <- pvert[,c("x","y")]/pvert[,"d"]
## find vertex which is furthest away
nback <- which.max(pvert[,"d"])
nearback <- with(edgepairs, (from==nback) | (to==nback))
ind <- if(part == "back") nearback else !nearback
## draw lines
with(edgepairs[ind,],
segments(xyvert[from, 1],
xyvert[from, 2],
xyvert[to, 1],
xyvert[to, 2],
...))
}

plot3Dpoints
})

56 changes: 30 additions & 26 deletions R/pp3.R
Original file line number Diff line number Diff line change
@@ -3,7 +3,7 @@
#
# class of three-dimensional point patterns in rectangular boxes
#
# $Revision: 1.15 $ $Date: 2014/10/24 00:22:30 $
# $Revision: 1.19 $ $Date: 2015/01/28 06:31:28 $
#

box3 <- function(xrange=c(0,1), yrange=xrange, zrange=yrange, unitname=NULL) {
@@ -51,7 +51,7 @@ print.box3 <- function(x, ...) {
"]", sep="")
v <- paste(unlist(lapply(x[1:3], bracket)), collapse=" x ")
s <- summary(unitname(x))
cat(paste("Box:", v, s$plural, s$explain, "\n"))
splat("Box:", v, s$plural, s$explain)
invisible(NULL)
}

@@ -110,10 +110,10 @@ is.pp3 <- function(x) { inherits(x, "pp3") }
npoints.pp3 <- function(x) { nrow(x$data) }

print.pp3 <- function(x, ...) {
cat("Three-dimensional point pattern\n")
splat("Three-dimensional point pattern")
sd <- summary(x$data)
np <- sd$ncases
cat(paste(np, ngettext(np, "point", "points"), "\n"))
splat(np, ngettext(np, "point", "points"))
print(x$domain)
invisible(NULL)
}
@@ -131,36 +131,40 @@ summary.pp3 <- function(object, ...) {
}

print.summary.pp3 <- function(x, ...) {
cat("Three-dimensional point pattern\n")
cat(paste(x$np, ngettext(x$np, "point", "points"), "\n"))
splat("Three-dimensional point pattern")
splat(x$np, ngettext(x$np, "point", "points"))
print(x$dom)
u <- x$u
v <- x$v
cat(paste("Volume", v, "cubic",
if(v == 1) u$singular else u$plural,
u$explain, "\n"))
cat(paste("Average intensity", x$intensity,
"points per cubic", u$singular, u$explain,
"\n"))
splat("Volume", v, "cubic",
if(v == 1) u$singular else u$plural,
u$explain)
splat("Average intensity", x$intensity,
"points per cubic", u$singular, u$explain)
invisible(NULL)
}

plot.pp3 <- function(x, ...) {
plot.pp3 <- function(x, ..., eye=NULL, org=NULL, theta=25, phi=15) {
xname <- short.deparse(substitute(x))
if(!require("scatterplot3d"))
stop("Package scatterplot3d is needed to plot 3D point patterns\n")
coo <- coords(x)
cnam <- names(coo)
do.call("scatterplot3d",
resolve.defaults(list(x=coo[,1],
y=coo[,2],
z=coo[,3]),
coo <- as.matrix(coords(x))
xlim <- x$domain$xrange
ylim <- x$domain$yrange
zlim <- x$domain$zrange
if(is.null(org)) org <- c(mean(xlim), mean(ylim), mean(zlim))
if(is.null(eye)) {
theta <- theta * pi/180
phi <- phi * pi/180
d <- 2 * diameter(x$domain)
eye <- org + d * c(cos(phi) * c(sin(theta), -cos(theta)), sin(phi))
}
deefolts <- spatstat.options('par.pp3')
## determine default eye position and centre of view
do.call(plot3Dpoints,
resolve.defaults(list(xyz=coo, eye=eye, org=org),
list(...),
list(main=xname),
list(xlab=cnam[1],
ylab=cnam[2],
zlab=cnam[3]),
list(xlim=x$domain$xrange,
deefolts,
list(main=xname,
xlim=x$domain$xrange,
ylim=x$domain$yrange,
zlim=x$domain$zrange)))
}
5 changes: 1 addition & 4 deletions demo/data.R
Original file line number Diff line number Diff line change
@@ -88,10 +88,7 @@ plot(split(nbfires)$"2000", which.marks="fire.type",
plot(nztrees)
plot(trim.rectangle(as.owin(nztrees), c(0,5), 0), add=TRUE, lty=3)

enable3d <- ("scatterplot3d" %in% row.names(installed.packages()))
if(enable3d) {
plot(osteo[1:10,], tick.marks=FALSE, xlab="", ylab="", zlab="")
}
plot(osteo[1:10,], tick.marks=FALSE, xlab="", ylab="", zlab="")

plot(paracou, cols=2:3, chars=c(16,3))

Loading

0 comments on commit 8a21d3f

Please sign in to comment.