5

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:

enter image description here

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))
  • 2
    I think they are called **Radar plots**, see [Star (Spider/Radar) Plots and Segment Diagrams](https://stat.ethz.ch/R-manual/R-devel/library/graphics/html/stars.html) – zx8754 Feb 27 '14 at 09:47
  • 2
    Take a look at `radial.plot` in [**plotrix**](http://cran.r-project.org/web/packages/plotrix/index.html). – Thomas Feb 27 '14 at 09:54
  • You should at least give us some dummy data and have a go yourself using plot with points and lines. – Spacedman Feb 27 '14 at 10:48
  • Why do you all vote to close this question? There are 49,596 R questions on Stack Overflow, how is this off topic? Anyway, I got my answer. Thanks, @Thomas :-) –  Feb 27 '14 at 11:09
  • 3
    Because asking "I want to make this plot, tell me how" shows very little effort, which is a reason for closing, or the answer will be "use function foo" which is another reason for closing. – Spacedman Feb 27 '14 at 11:11
  • 4
    That's like asking me to show the fork I used to try and eat soup, before I knew spoons existed. How does seeing the fork help you help me? But I'll post it. –  Feb 27 '14 at 11:14
  • 1
    I gave you a comment but also voted to close as originally asked. The reason being that Stack Overflow is designed for specific problems that can be answered with clear, concrete, and complete solutions. If the question is: "why isn't this plotting code working with these data?" then it's on-topic because someone can use your data to draw your intended plot. If it's: "what package do I use to make plots like this?" it shows little effort and is difficult to answer with code because nobody knows what you're starting from. – Thomas Feb 27 '14 at 12:36

2 Answers2

9

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.)

enter image description here

Community
  • 1
  • 1
jbaums
  • 27,115
  • 5
  • 79
  • 119
  • Very nice! But your scale is a tenth of the true values: `range(ticks)` shows the values range from -6 to 6. How would I adapt this code to range from -60 to 60, so it can be combined with the plotrix code? –  Feb 27 '14 at 14:55
  • 2
    The scale of ticks can be adjusted by changing to `ticks.locs <- lapply(seq(60, 360, 60), get.coords, d=10*(1:6))`. To be compatible with the rest of my code, we'd have to make a few other adjustments. I ran out of time to explain the code but will come back to it. Do the curves look wavy on your machine as well? I have always had trouble with anti-aliasing on Windows (note even my polygon has wavy lines) - figured it would look ok on other people's systems. – jbaums Feb 27 '14 at 21:21
  • 1
    FYI: I've made some edits to this post to make it more generally useful/flexible (not so specific to the OP's exact problem), by defining a function to plot rotated axes. Wavy line problems experienced earlier have been alleviated by calculating vertices along the circle's circumference and plotting with `polygon`. – jbaums Mar 02 '14 at 02:30
5

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:

enter image description here