如何自动递归地绘制 3 个不同的正多边形？

Question

我想绘制 3 个正多边形 - 正方形（4 条边）、六边形（6 条边）和十二边形（12 条边），其方式与下图类似：

到目前为止，我一直在对ggforce包进行硬编码以实现我的目标：

library(ggplot2)
library(ggforce)

df = data.frame(name = c("dodecagon", "square", "hexagon"),
                x0 = c(0.5, 0.5, 0.63),
                y0 = c(0.5, 0.745, 0.74),
                sides = c(12, 4, 6),
                angle = c(0, 0, -0.5),
                r = c(0.2, 0.07, 0.09))

ggplot(data = df) +
        geom_regon(aes(x0 = x0, y0 = y0, sides = sides, angle = angle, r = r, fill = name)) +
        coord_fixed(xlim = c(0, 1), ylim = c(0, 1))

其产生：

正如您所看到的，多边形没有很好地对齐，并且需要非常长的时间才能真正实现我想要实现的目标。

本质上，我想要一个函数，它以十二边形（12 边多边形）的数量作为参数，并在十二边形周围绘制正方形（4 边多边形）和六边形（6 边多边形）。

PS 它不必使用 来完成ggforce，但我更希望最终有一个ggplot2情节。

Answer 1

我不确定执行此操作的简单方法是什么，但让我向您展示困难的方法。首先，定义一个函数，在给定中心坐标和半径（即其顶点所在圆的半径）的情况下，生成正十二边形坐标的数据框：

dodecagon <- function(x = 0, y = 0, r = 1) {
  theta <- seq(pi/12, 24 * pi/12, pi/6)
  data.frame(x = x + r * cos(theta), y = y + r * sin(theta))
}

现在定义函数，它采用线段的坐标并返回代表正方形和六边形的 x、y 坐标的数据框：

square <- function(x1, x2, y1, y2) {
  theta <- atan2(y2 - y1, x2 - x1) + pi/2
  r <- sqrt((x2 - x1)^2 + (y2 - y1)^2)
  data.frame(x = c(x1, x2, x2 + r * cos(theta), x1 + r * cos(theta), x1),
             y = c(y1, y2, y2 + r * sin(theta), y1 + r * sin(theta), y1))
}

hexagon <- function(x1, x2, y1, y2) {
  theta <- atan2(y2 - y1, x2 - x1)
  r <- sqrt((x2 - x1)^2 + (y2 - y1)^2)
  data.frame(x = c(x1, x2, x2 + r * cos(theta + pi / 3),
                   x2 + r * cos(theta + pi / 3) + r * cos(theta + 2 * pi / 3),
                   x1 + r * cos(theta + 2 * pi / 3) + r * cos(theta + pi / 3),
                   x1 + r * cos(theta + 2 * pi / 3), 
                   x1),
           y = c(y1, y2, y2 + r * sin(theta + pi / 3),
                   y2 + r * sin(theta + pi / 3) + r * sin(theta + 2 * pi / 3),
                   y1 + r * sin(theta + 2 * pi / 3) + r * sin(theta + pi / 3),
                   y1 + r * sin(theta + 2 * pi / 3), 
                   y1))
}

最后，编写一个函数来协调前 3 个坐标，以返回所有坐标的单个数据框，按形状类型进行标记，并为每个多边形使用唯一的编号：

pattern <- function(x = 0, y = 0, r = 1) {
  d <- cbind(dodecagon(x, y, r), shape = "dodecagon", part = 0)
  squares <- lapply(list(1:2, 3:4, 5:6, 7:8, 9:10, 11:12),
                    function(i) {
                    cbind(
                      square(d$x[i[2]], d$x[i[1]], d$y[i[2]], d$y[i[1]]),
                      shape = "square", part = i[2]/2)
                    })
  hexagons <- lapply(list(2:3, 4:5, 6:7, 8:9, 10:11, c(12, 1)),
                     function(i) {
                     cbind(
                      hexagon(d$x[i[2]], d$x[i[1]], d$y[i[2]], d$y[i[1]]),
                      shape = "hexagon", part = i[1]/2 + 6)
                    })
  rbind(d, do.call(rbind, squares), do.call(rbind, hexagons))
}

完成所有这些后，绘图就很简单了：

pattern <- function(x = 0, y = 0, r = 1) {
  d <- cbind(dodecagon(x, y, r), shape = "dodecagon", part = 0)
  squares <- lapply(list(1:2, 3:4, 5:6, 7:8, 9:10, 11:12),
                    function(i) {
                    cbind(
                      square(d$x[i[2]], d$x[i[1]], d$y[i[2]], d$y[i[1]]),
                      shape = "square", part = i[2]/2)
                    })
  hexagons <- lapply(list(2:3, 4:5, 6:7, 8:9, 10:11, c(12, 1)),
                     function(i) {
                     cbind(
                      hexagon(d$x[i[2]], d$x[i[1]], d$y[i[2]], d$y[i[1]]),
                      shape = "hexagon", part = i[1]/2 + 6)
                    })
  rbind(d, do.call(rbind, squares), do.call(rbind, hexagons))
}

或者，复制你的原始图形：

library(ggplot2)

ggplot(data = pattern(), aes(x, y, fill = shape, group = part)) + 
  geom_polygon() +
  coord_equal()