Dear R-users,
As noted by Paul Murrell < p.murrell at auckland.ac.nz > there is errors
in the code for polar plotting I send to R-help under the title "Polar
plot, circular plot (angular data)" at Thu Oct 17 2002 - 12:18:20 CEST.
Thanks!
I have reorganized the code into a structure ('pp'). This allows plots
to be modified to a greater extent by passing arguments by ... argument of the R
graphics functions: lines(), polygon() and text().
However, the use of the 'pp' structure is quite different from the use
of standard plotting functions of R. In order to modify plots the fields of the
'pp' object must be modified directly. Probably, it could benefit from
furter restructuring.
Again, thanks to Ross Ihaka at R-help (Mon May 28 2001) for some of the code
used here.
Best wishes,
Karsten
### Examples
## data
div<-50
pp$theta <- seq(0, 2 * pi, length = div + 1)[-(div+1)]
pp$r<-1:div
rm(div)
## Plotting
# source("polar.plot.object.0.86.R")
pp$default.plot()
pp$standard.plot()
pp$wind.plot() # will not execute unless pp$default() has been called
(in this case by the proceeding plot-commands)
pp$grid.circle.pos<-c(0,25,50)
pp$wind.plot()
# overlay polygons and lines
pp$r <- rnorm(50,35)
pp$default()
pp$rupper<-50
pp$basis()
pp$newplot()
pp$plot.polygon(col="darkgreen", border="darkgreen")
pp$r <- rnorm(50,15)
pp$plot.polygon(col="white", border="white")
pp$r <- rnorm(50,0) * 4 + 28
pp$plot.lines(lwd = 2, type="o", col="red")
pp$plot.grid.labels()
title(main="Overlay red points on white polygon on blue polygon")
#############################
### Fields of object "pp" ###
#############################
pp$r <- NULL # (vector of) radial data.
pp$theta<- NULL # (vector of) angular data (in radians).
## function "pp$default()" set values of several fields:
pp$default <- function() {
pp$theta.zero <<- 0 # origin of angular axis (as direction on the output
plot).
pp$theta.clw <<- FALSE # clockwise oritation of angular axis.
pp$text.lab<<- expression(0, pi/2, pi, 3*pi/2) # default text for angular
axis labels
pp$num.lab <<- NULL # (pretty) numeric angular axis labels in interval
[0;num.lab[. If num.lab is a vector longer than 1 these are used as labels
except the last value. (default = NULL).
pp$rlabel.axis <<- 0 # angular orientation of radial axis (tick marks and
labels) on the output plot.
#
# pp$radial.axis.labels: _method_ (plotting of radial axis labels):
# NULL: no radial labels.
# 1: labels at pretty radial distances (default).
# 2: exclude label at radial distace 0.
# 3: exclude label at maximum radial distance.
# 4: exclude radial labels at distance 0 and at maximum radial distance.
pp$rupper <<- NULL # Upper value for radial axis. May be increased by the
default use of pretty()-function for positioning of grid circles and radial axis
labels. (default = NULL).
pp$grid.circle.pos <<- NULL # radial axis position of grid circles as
numeric vector of minimum length 2. Overrides the default positioning of grid
circles and radial axis labels by pretty()-function. (default = NULL).
pp$tlabel.offset<<-0.2 # radial offset for angular axis labels in fraction
of maximum radial value.
pp$dir<<-8 # number of radial grid lines.
}
###################################
### object pp (version. 0.86) ###
###################################
# dump(ls(), file = "polar.plot.object.0.86.R")
"pp" <-
structure(list(default = function ()
{
pp$theta.zero <<- 0
pp$theta.clw <<- FALSE
pp$text.lab <<- expression(0, pi/2, pi, 3 * pi/2)
pp$num.lab <<- NULL
pp$rlabel.axis <<- 0
pp$rupper <<- NULL
pp$grid.circle.pos <<- NULL
pp$tlabel.offset <<- 0.2
pp$dir <<- 8
}, default.plot = function ()
{
pp$default()
pp$basis()
pp$newplot()
pp$radial.grid()
pp$inner.circular.grid()
pp$outer.circular.grid()
pp$radial.axis.labels()
pp$angular.labels()
pp$angular.tick.marks()
pp$radial.tick.marks()
pp$plot.lines()
print("Made new default plot.")
}, standard.plot = function ()
{
lwd <- 1
pp$default()
pp$basis()
pp$newplot()
pp$radial.grid(lty = 3, lwd = lwd)
pp$inner.circular.grid(lty = 3, lwd = lwd)
pp$outer.circular.grid(lwd = lwd)
pp$radial.axis.labels(pos = 3)
pp$angular.labels(cex = 1.5)
pp$angular.tick.marks(lwd = lwd)
pp$radial.tick.marks(lwd = lwd, len = 0.03)
pp$plot.lines(t = "p", pch = 21, lwd = lwd)
print("Made new standard plot.")
}, wind.plot = function ()
{
lwd <- 2
pp$theta.zero <<- pi/2
pp$theta.clw <<- TRUE
pp$num.lab <<- 360
pp$dir <<- 12
pp$basis()
pp$newplot()
pp$radial.grid(lty = 3, lwd = 1)
pp$inner.circular.grid(lty = 3, lwd = 1)
pp$outer.circular.grid(lwd = lwd)
pp$radial.axis.labels(pos = 3, method = 2, cex = 1.5)
pp$angular.labels(cex = 1.8)
pp$angular.tick.marks(lwd = lwd)
pp$radial.tick.marks(lwd = lwd, len = 0.03)
pp$plot.lines(t = "l", pch = 21, lwd = lwd + 1)
cat("Made new wind plot.\nr-range: ", range(pp$r))
}, plot.grid.labels = function ()
{
pp$radial.grid()
pp$inner.circular.grid()
pp$outer.circular.grid()
pp$radial.axis.labels()
pp$angular.labels()
pp$angular.tick.marks()
pp$radial.tick.marks()
print("Made my grid & labels (pp$plot.grid.labels).")
}, fit.rad = function (x, twop = 2 * pi)
{
for (i in 1:length(x)) {
while (x[i] < 0) x[i] <- x[i] + twop
while (x[i] >= twop) x[i] <- x[i] - twop
}
return(x)
}, fit.rad2 = function (th)
pp$fit.rad(pp$theta.zero + (!pp$theta.clw) * th - (pp$theta.clw) *
th), cartesian = function (r, th)
{
return(cbind(r * cos(th), r * sin(th)))
}, basis = function ()
{
if (is.null(pp$rupper))
pp$rpretty <<- pretty(0:ceiling(max(pp$r)))
if (is.numeric(pp$rupper))
pp$rpretty <<- pretty(0:pp$rupper)
if (is.numeric(pp$grid.circle.pos) & length(pp$grid.circle.pos) >
1)
pp$rpretty <<- pp$grid.circle.pos
pp$lab.dist <<- max(pp$rpretty)
if (!is.null(pp$text.lab) || is.numeric(pp$num.lab)) {
pp$lab.dist <<- max(pp$rpretty) * (1 + pp$tlabel.offset)
}
pp$rDir <<- seq(0, 2 * pi, length = pp$dir + 1)[-(pp$dir +
1)]
print("pp$basis")
}, newplot = function ()
{
plot.new()
ps <- max(pp$lab.dist, max(pp$rpretty))
plot.window(xlim = c(-ps, ps), ylim = c(-ps, ps), asp = 1)
}, radial.grid = function (...)
{
if (pp$dir > 0)
segments(0, 0, max(pp$rpretty) * cos(pp$rDir), max(pp$rpretty) *
sin(pp$rDir), ...)
}, inner.circular.grid = function (...)
{
grid <- seq(0, 2 * pi, length = 360/4 + 1)
for (rad in pp$rpretty) {
if (rad > 0 & rad < max(pp$rpretty))
lines(pp$cartesian(rad, grid), ...)
}
}, outer.circular.grid = function (...)
{
grid <- seq(0, 2 * pi, length = 360/4 + 1)
lines(pp$cartesian(max(pp$rpretty), grid), ...)
}, radial.axis.labels = function (method = 1, ...)
{
if (!is.null(method)) {
if (method == 1)
radLabels <- 1:length(pp$rpretty)
if (method == 2)
radLabels <- 2:length(pp$rpretty)
if (method == 3)
radLabels <- 1:(length(pp$rpretty) - 1)
if (method == 4) {
if (length(pp$rpretty) > 2)
radLabels <- 2:(length(pp$rpretty) - 1)
else radLabels <- NULL
}
if (!is.null(radLabels)) {
text(pp$cartesian(pp$rpretty[radLabels], pp$rlabel.axis),
labels = pp$rpretty[radLabels], ...)
}
}
}, radial.tick.marks = function (len = 0.02, ...)
{
fpos <- pp$cartesian(pp$rpretty, pp$rlabel.axis)
if (len != 0) {
tick <- max(pp$rpretty) * pp$cartesian(len, pp$rlabel.axis +
pi/2)
segments(fpos[, 1], fpos[, 2], fpos[, 1] + tick[1], fpos[,
2] + tick[2], ...)
}
}, angular.labels = function (...)
{
labDir <- NULL
t.lab <- NULL
if (!is.null(pp$text.lab)) {
t.lab <- pp$text.lab
labDir <- seq(0, 2 * pi, length = length(t.lab) + 1)[-(length(t.lab)
+
1)]
}
if (is.numeric(pp$num.lab)) {
if (length(pp$num.lab) == 1 && pp$num.lab%%1 == 0) {
labDir <- seq(0, 2 * pi, length = pp$dir + 1)[-(pp$dir +
1)]
t.lab <- labDir/(2 * pi) * pp$num.lab
}
if (length(pp$num.lab) == 1 && pp$num.lab%%1 != 0) {
t.lab <- pretty(0:(1 + pp$num.lab%/%1))
while (max(t.lab) > pp$num.lab) {
t.lab <- t.lab[-length(t.lab)]
}
labDir <- 2 * pi * t.lab/pp$num.lab
}
if (length(pp$num.lab) > 1 && pp$num.lab >= 0) {
labDir <- 2 * pi * pp$num.lab/pp$num.lab[length(pp$num.lab)]
t.lab <- pp$num.lab[-length(pp$num.lab)]
}
}
pp$labDir2 <<- pp$fit.rad2(labDir)
if (!is.null(pp$text.lab) || is.numeric(pp$num.lab))
text(pp$cartesian(pp$lab.dist, pp$fit.rad2(labDir)),
labels = t.lab, ...)
else return(NULL)
}, angular.tick.marks = function (len = 0.05, ...)
{
if (len != 0) {
if (!is.null(pp$text.lab) || is.numeric(pp$num.lab))
dd <- pp$labDir2
else dd <- pp$rDir
fpos <- pp$cartesian(max(pp$rpretty), dd)
spos <- pp$cartesian((1 + len) * max(pp$rpretty), dd)
segments(fpos[, 1], fpos[, 2], spos[, 1], spos[, 2],
...)
}
else return(NULL)
}, plot.lines = function (...)
points(pp$cartesian(pp$r, pp$fit.rad2(pp$theta)), ...), plot.polygon = function
(...)
polygon(pp$cartesian(pp$r, pp$fit.rad2(pp$theta)), ...)), .Names =
c("default",
"default.plot", "standard.plot", "wind.plot",
"plot.grid.labels",
"fit.rad", "fit.rad2", "cartesian",
"basis", "newplot", "radial.grid",
"inner.circular.grid", "outer.circular.grid",
"radial.axis.labels",
"radial.tick.marks", "angular.labels",
"angular.tick.marks",
"plot.lines", "plot.polygon"))
-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
r-help mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
Send "info", "help", or "[un]subscribe"
(in the "body", not the subject !) To: r-help-request at
stat.math.ethz.ch
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._
