How to draw rotated axes in R? - r

Question

I want to plot the results from a six factor personality test as a circumplex.
The test in question is the Allgemeiner Interessen-Struktur-Test (AIST-R; Bergmann & Eder, 2005) [General Interest Structure Test], which measures vocational choice based on the theory of J. L. Holland (Holland codes, RIASEC). You can use the answers below to plot the "Felddarstellung" [field representation] recommended in the manual in stead of the interest profile to better visualize the vector of differentiation.
The resulting graphic should look similar to this:
The test results are given as angles and lengths.
How can I draw an axis or geometric vector in R from a starting point with a specific length, without defining the end coordinates (as required by arrows)?
How can I add tickmarks to such a vector?
How can I define the points of a polygon (here in grey) in a similar manner, i.e. by providing an angle and a distance from the origin, instead of coordinates)?
I can of course calculate the endpoints, but I would like to avoid this. Also, I wouldn't know how to add tick marks to an arrow.
My attempts that did not work:
par(pin = c(4, 4))
plot(0, 0, type = "n", xlim = c(-60, 60), ylim = c(-60, 60))
symbols(c(0, 0, 0), c(0, 0, 0), circles = c(60, 1.5, 1.5), inches = FALSE, add = TRUE, fg = c("black", "black", "white"), bg = c("transparent", "#000000", "transparent"))
arrows(0, 0, length = c(60, 60, 60, 60, 60, 60), angle = c(0, 60, 120, 180, 240, 300))

Answer 1

The following uses base functions and a couple of functions that we define ourselves.
While you requested a method that doesn't require calculating coordinates of segments' end points, I think this is impossible. However, we can define a simple helper function that uses some basic trigonometry to calculate the coordinates given the angle (clockwise from the positive y-axis) and the segment length. We do this below, as well as defining a function that plots a rotated axis.
get.coords <- function(a, d, x0, y0) {
a <- ifelse(a <= 90, 90 - a, 450 - a)
data.frame(x = x0 + d * cos(a / 180 * pi),
y = y0+ d * sin(a / 180 * pi))
}
rotatedAxis <- function(x0, y0, a, d, symmetrical=FALSE, tickdist, ticklen, ...) {
if(isTRUE(symmetrical)) {
axends <- get.coords(c(a, a + 180), d, x0, y0)
tick.d <- c(seq(0, d, tickdist), seq(-tickdist, -d, -tickdist))
} else {
axends <- rbind(get.coords(a, d, x0, y0), c(x0, y0))
tick.d <- seq(0, d, tickdist)
}
invisible(lapply(apply(get.coords(a, d=tick.d, x0, y0), 1, function(x) {
get.coords(a + 90, c(-ticklen, ticklen), x[1], x[2])
}), function(x) lines(x$x, x$y, ...)))
lines(axends$x, axends$y, ...)
}
get.coords takes arguments a (a vector of angles), d (a vector of segment lengths), and x0 and y0, the coordinates of the known point. Vectors a and d are recycled as necessary. The function returns a data.frame with elements x and y giving the coordinates corresponding to each angle/length pair.
rotatedAxis plots an axis between x0, y0 and the point d units away along the line at angle a. If symmetrical is TRUE, the axis extends d units in opposite directions. Tick marks, of height ticklen are plotted tickdist units apart.
Plotting of the circle uses get.coords to calculate coordinates along the circumference, and plots the line connecting these with polygon (inspired by #timriffe).
Below we use these functions to replicate the plot provided by the OP.
# Set up plotting device
plot.new()
plot.window(xlim=c(-70, 70), ylim=c(-70, 70), asp=1)
# Plot circle with radius = 60 units and centre at the origin.
polygon(get.coords(seq(0, 360, length.out=1000), 60, 0, 0), lwd=2)
# Plot a polygon with vertices along six axes, at distances of 17, 34, 44, 40,
# 35, and 10 units from the centre.
poly.pts <- get.coords(seq(0, 300, 60), c(17, 34, 44, 40, 35, 10), 0, 0)
polygon(poly.pts$x, poly.pts$y, col='gray', lwd=2)
# Plot the rotated axes
rotatedAxis(0, 0, a=60, d=60, symmetrical=TRUE, tickdist=10, ticklen=1)
rotatedAxis(0, 0, a=120, d=60, symmetrical=TRUE, tickdist=10, ticklen=1)
rotatedAxis(0, 0, a=180, d=60, symmetrical=TRUE, tickdist=10, ticklen=1)
# Add text labels to circumference
text.coords <- get.coords(seq(0, 300, 60), 65, 0, 0)
text(text.coords$x, text.coords$y, c('I', 'A', 'S', 'E', 'C', 'R'))
# Plot a second point and connect to centre by a line
point2 <- get.coords(145, 50, 0, 0)
points(point2, pch=20, cex=2)
segments(0, 0, point2$x, point2$y, lwd=3)
# Plot central point
points(0, 0, pch=21, bg=1, col=0, lwd=2, cex=2)
(Edit: I heavily edited this post - without changing it's general message drastically - in order to make it easier to read and more generally applicable. Additions/changes include that I now define a function to plot rotated axes, plot the circle by calculating coordinates of vertices along the circumference and plotting with polygon, as inspired by #timriffe.)

Answer 2

A solution based on the comment by Thomas and the answer by jbaums.
I used jbaums' method to draw the axes, because I did not want the unbroken circular grid provided by plotrix.
I did not use jbaums' method to draw the circle, because that has a wavy/bumpy line.
I call par(new = TRUE) twice, because the scale in jbaums answer is a tenth of the true scale and I couldn't figure out how to adjust that.
I manually placed the lables, which I'm not happy with.
There's also a lot of superfluous code in there, but I left it in case someone wants to use it to work on their own version.
Here's the code:
# test results
R <- 95
I <- 93
A <- 121
S <- 111
E <- 114
C <- 80
dimensions <- c("R", "I", "A", "S", "E", "C")
values <- c(R, I, A, S, E, C)
RIASEC <- data.frame(
"standard.values" = values,
"RIASEC" = dimensions
)
person.typ <- paste(
head(
RIASEC[
with(
RIASEC,
order(-standard.values)
),
]$RIASEC,
3
),
collapse = ""
)
# length of vector
vi1 <- 0
vi2 <- I
va1 <- 0.8660254 * A
va2 <- 0.5 * A
vs1 <- 0.8660254 * S
vs2 <- -0.5 * S
ve1 <- 0
ve2 <- -E
vc1 <- -0.8660254 * C
vc2 <- -0.5 * C
vr1 <- -0.8660254 * R
vr2 <- 0.5 * R
vek1 <- va1 + vi1 + vr1 + vc1 + ve1 + vs1 # x-axix
vek2 <- vr2 + vi2 + va2 + vs2 + ve2 + vc2 # y-axis
vektor <- sqrt(vek1^2 + vek2^2) # vector length
# angle of vector
if (vek1 == 0) {tg <- 0} else {tg <- vek2 / vek1}
wink <- atan(tg) * 180 / pi
if (vek1 > 0) {
winkel <- 90 - wink
} else if (vek1 == 0) {
if (vek2 >= 0) {winkel <- 360}
else if (vek2 < 0) {winkel <- 180}
} else if (vek1 < 0) {
if (vek2 <= 0) {winkel <- 270 - wink}
else if (vek2 >= 0) {winkel <- 270 - wink}
}
library(plotrix)
axis.angle <- c(0, 60, 120, 180, 240, 300)
axis.rad <- axis.angle * pi / 180
value.length <- values - 70
dev.new(width = 5, height = 5)
radial.plot(value.length, axis.rad, labels = dimensions, start = pi-pi/6, clockwise=TRUE,
rp.type="p", poly.col = "grey", show.grid = TRUE, grid.col = "transparent", radial.lim = c(0,60))
radial.plot.labels(value.length + c(4, 2, -2, 1, 1, 4), axis.rad, radial.lim = c(0,60), start = pi-pi/6, clockwise = TRUE, labels = values, pos = c(1,2,3,1,2,1))
get.coords <- function(a, d, x0=0, y0=0) {
a <- ifelse(a <= 90, 90 - a, 450 - a)
data.frame(x = x0 + d * cos(a / 180 * pi), y = y0+ d * sin(a / 180 * pi) )
}
par(new = TRUE)
plot(NA, xlim = c(-6, 6), ylim=c(-6, 6), type='n', xlab='', ylab='', asp = 1,
axes=FALSE, new = FALSE, bg = "transparent")
circumf.pts <- get.coords(seq(60, 360, 60), 6)
segments(circumf.pts$x[1:3], circumf.pts$y[1:3],
circumf.pts$x[4:6], circumf.pts$y[4:6])
ticks.locs <- lapply(seq(60, 360, 60), get.coords, d=1:6)
ticks <- c(apply(do.call(rbind, ticks.locs[c(1, 4)]), 1, function(x)
get.coords(150, c(-0.1, 0.1), x[1], x[2])),
apply(do.call(rbind, ticks.locs[c(2, 5)]), 1, function(x)
get.coords(30, c(-0.1, 0.1), x[1], x[2])),
apply(do.call(rbind, ticks.locs[c(3, 6)]), 1, function(x)
get.coords(90, c(-0.1, 0.1), x[1], x[2])))
lapply(ticks, function(x) segments(x$x[1], x$y[1], x$x[2], x$y[2]))
par(new = TRUE)
plot(NA, xlim = c(-60, 60), ylim=c(-60, 60), type='n', xlab='', ylab='', asp = 1,
axes=FALSE, new = FALSE, bg = "transparent")
segments(0, 0, vek1, vek2, lwd=3)
points(vek1, vek2, pch=20, cex=2)
symbols(c(0, 0, 0), c(0, 0, 0), circles = c(60, 2, 1.3), inches = FALSE, add = TRUE, fg = c("black", "white", "black"), bg = c("transparent", "white", "black"))
And here's the graphic: