https://github.com/cran/spatstat
Tip revision: 3aca716ce2576a0dab83f08052acd47afed8ee6a authored by Adrian Baddeley on 29 February 2012, 00:00:00 UTC
version 1.25-4
version 1.25-4
Tip revision: 3aca716
iplot.R
#
# interactive plot for ppp objects using rpanel
#
# $Revision: 1.8 $ $Date: 2010/03/08 08:23:04 $
#
#
# Effect:
# when the user types
# iplot(x)
# a pop-up panel displays a standard plot of x and
# buttons allowing control of the plot parameters.
# Coding:
# The panel 'p' contains the following internal variables
# x Original point pattern
# xname Name of x (for main title)
# mtype Type of marks of x
# The following variables in 'p' are controlled by panel buttons etc
# split Logical: whether to split multitype pattern
# pointmap Plot character, or "marks" indicating that marks are used
# charsize Character expansion factor cex
# markscale Mark scale factor markscale
iplot <- function(x, xname) {
if(missing(xname))
xname <- deparse(substitute(x))
verifyclass(x, "ppp")
if(markformat(x) == "dataframe")
marks(x) <- marks(x)[,1]
require(rpanel)
mtype <- if(is.multitype(x)) "multitype" else if(is.marked(x)) "marked" else "unmarked"
##
p <- rp.control(paste("iplot(", xname, ")", sep=""),
x=x, xname=xname, mtype=mtype,
pointmap=if(is.marked(x)) "marks" else "o",
split=FALSE,
size=c(600, 400))
# Split panel into two halves
# Left half of panel: display
# Right half of panel: controls
rp.grid(p, "gdisplay", pos=list(row=0,column=0))
rp.grid(p, "gcontrols", pos=list(row=0,column=1))
#----- Display side ------------
# This line is to placate the package checker
mytkr <- NULL
rp.tkrplot(p, mytkr, do.iplot, pos=list(row=0,column=0,grid="gdisplay"))
redraw <- function(panel) {
rp.tkrreplot(p, mytkr)
panel
}
#----- Control side ------------
nextrow <- 0
pozzie <- function(n=nextrow) list(row=n,column=0,grid="gcontrols")
# main title
rp.textentry(p, xname, action=redraw, title="Plot title",
pos=pozzie(0))
nextrow <- 1
# split ?
if(mtype == "multitype") {
rp.checkbox(p, split, initval=FALSE,
title="Split according to marks", action=redraw,
pos=pozzie(1))
nextrow <- 2
}
# plot character or mark style
ptvalues <- c("o", "bullet", "plus")
ptlabels <- c("open circles", "filled circles", "crosshairs")
if(is.marked(x)) {
ptvalues <- c("marks", ptvalues)
ptlabels <- if(mtype == "multitype")
c("Symbols depending on mark", ptlabels)
else c("Circles proportional to mark", ptlabels)
}
pointmap <- ptvalues[1]
rp.radiogroup(p, pointmap, values=ptvalues, labels=ptlabels,
title="how to plot points", action=redraw,
pos=pozzie(nextrow))
nextrow <- nextrow+1
# plot character size
charsize <- 1
rp.slider(p, charsize, 0, 5, action=redraw,
title="symbol expansion factor (cex)", initval=1, showvalue=TRUE,
pos=pozzie(nextrow))
nextrow <- nextrow+1
# mark scale
if(mtype == "marked") {
marx <- x$marks
marx <- marx[is.finite(marx)]
scal <- mark.scale.default(marx, x$window)
markscale <- scal
rp.slider(p, markscale, from=scal/10, to = 10*scal, action=redraw,
initval=scal,
title="mark scale factor (markscale)", showvalue=TRUE,
pos=pozzie(nextrow))
nextrow <- nextrow+1
}
# button to print a summary at console
rp.button(p, title="Print summary information",
pos=pozzie(nextrow),
action=function(panel) { print(summary(panel$x)); panel} )
nextrow <- nextrow+1
# quit button
rp.button(p, title="Quit", quitbutton=TRUE, pos=pozzie(nextrow),
action= function(panel) { panel })
#
invisible(NULL)
}
# function that updates the plot when the control panel is operated
do.iplot <- function(panel) {
use.marks <- TRUE
pch <- 16
switch(panel$pointmap,
marks={
use.marks <- TRUE
pch <- NULL
},
o = {
use.marks <- FALSE
pch <- 1
},
bullet = {
use.marks <- FALSE
pch <- 16
},
plus = {
use.marks <- FALSE
pch <- 3
})
y <- panel$x
if(panel$mtype == "multitype" && panel$split)
y <- split(y, un=(panel$pointmap != "marks"))
if(panel$mtype == "marked" && panel$pointmap == "marks")
plot(y, main=panel$xname, use.marks=use.marks, markscale=panel$markscale)
else
plot(y, main=panel$xname, use.marks=use.marks,
pch=pch, cex=panel$charsize)
panel
}