如何在R中绘制旋转的坐标轴？

Question

我想把六因素人格测试的结果绘制成一个圆形图。

所涉及的测试是Allgemeiner Interessen-Struktur-Test（AIST-R; Bergmann & Eder，2005）[一般兴趣结构测试]，该测试基于J.L. Holland理论（Holland codes，RIASEC）测量职业选择。您可以使用下面的答案来绘制手册中推荐的“Felddarstellung” [场地表示]，而不是兴趣概要，以更好地可视化差异向量。

生成的图形应类似于此：

测试结果以角度和长度给出。

• 如何在R中从特定起点绘制轴或几何向量，而无需定义终点坐标（如箭头所需）？

• 如何向这样的向量添加刻度线？

• 如何类似地定义多边形的点（此处为灰色），即通过提供与原点的角度和距离，而不是坐标）？

当然，我可以计算端点，但我想避免这种情况。此外，我不知道如何在箭头上添加刻度线。

---

我的尝试，没有成功的：

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

- user1322720

---

我认为它们被称为雷达图，请参见星形（蜘蛛/雷达）图和分段图。 - zx8754

请查看plotrix中的radial.plot函数。 - Thomas

因为询问“我想画这个图，告诉我怎么做”表现出很少的努力，这是关闭问题的原因之一，或者答案可能是“使用函数foo”，这也是关闭问题的另一个原因。 - Spacedman

这就像让我展示我尝试吃汤时使用的叉子，而在我知道勺子存在之前。看到这个叉子如何帮助你帮助我呢？但我会发帖子。 - user1322720

我给了你一个评论，但也投票关闭了原始问题。原因是Stack Overflow旨在解决可以用明确、具体和完整的解决方案回答的特定问题。如果问题是：“为什么这个绘图代码与这些数据不起作用？”那么它是相关的，因为有人可以使用你的数据来绘制你想要的图形。如果问题是：“我该使用哪个软件包来制作这样的图形？”那么它显示出很少的努力，并且很难用代码回答，因为没有人知道你从哪里开始。 - Thomas

Answer 1

以下使用base函数和我们自己定义的一些函数。

虽然您要求不需要计算线段端点的方法，但我认为这是不可能的。但是，我们可以定义一个简单的辅助函数，使用一些基本的三角函数来计算给定角度（顺时针从正y轴开始）和线段长度的坐标。我们在下面实现了这个函数，并定义了一个绘制旋转轴的函数。

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接受参数a（角度向量），d（线段长度向量）以及x0和y0，表示已知点的坐标。向量a和d将根据需要循环使用。该函数返回一个data.frame，其中元素x和y分别给出与每个角度/长度对应的坐标。

rotatedAxis在x0, y0和距离为d沿着角度为a的直线上的点之间绘制轴。如果symmetrical为TRUE，则轴向两个方向延伸d单位。高度为ticklen的刻度标记以tickdist单位间隔绘制。

圆的绘制使用get.coords计算圆周上的坐标，并使用polygon（灵感来自@timriffe）绘制连接这些坐标的线。

下面我们使用这些函数来复制原始帖子提供的图表。

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

(编辑：我对这篇文章进行了大量编辑，没有大幅改变其一般信息，以使其更易于阅读和更普遍适用。添加/更改包括我现在定义一个函数来绘制旋转轴，通过计算沿周长的顶点坐标并使用 polygon 进行绘制圆形，受 @timriffe 的启发。)

- jbaums

---

非常好！但是你的刻度只有真实值的十分之一：range(ticks)显示的值范围从-6到6。我该如何调整此代码以使其范围从-60到60，以便可以与plotrix代码结合使用？ - user1322720

刻度的比例可以通过更改 ticks.locs <- lapply(seq(60, 360, 60), get.coords, d=10*(1:6)) 进行调整。为了与我的代码兼容，我们需要进行一些其他的调整。我没有时间解释这段代码，但会回来解释的。在你的机器上曲线看起来是波浪形的吗？我一直在Windows上遇到抗锯齿问题（甚至我的多边形也有波浪线），想着在其他人的系统上看起来应该还好。 - jbaums

FYI：我对这篇文章进行了一些编辑，使其更加通用/灵活（不那么特定于原帖的确切问题），通过定义一个函数来绘制旋转轴。之前遇到的波浪线问题已经通过计算圆周上的顶点并使用“polygon”进行绘制得到缓解。 - jbaums

Answer 2

基于Thomas的评论和jbaums的答案，我提供以下解决方案。

• 我使用了jbaums的方法来绘制坐标轴，因为我不想要plotrix提供的未中断的圆形网格。
• 我没有使用jbaums的方法来绘制圆圈，因为那个圆圈有波浪线/颠簸的线条。
• 我两次调用par(new = TRUE)，因为jbaums的答案中的比例是真实比例的十分之一，而我无法弄清如何调整。
• 我手动放置了标签，但我对此并不满意。
• 还有很多多余的代码在里面，但我将其保留以便有人想使用它来开发自己的版本。

以下是代码：

# 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"))

这里是图示:

- user1322720

---

在 plotrix 中有很多有趣的图表：library(plotrix); demo(plotrix,package="plotrix") - crogg01

很高兴你解决了它。 - Thomas