[R] Polar plot, circular plot (angular data): II
Karsten D Bjerre
kdb at kvl.dk
Fri Nov 8 14:55:48 CET 2002
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
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._
More information about the R-help
mailing list