用 echarts4r 包绘制嵌套环形图时遇到图层叠加问题

yuanfan

咸鱼楼主最近打算用echarts4r包来画花，使用嵌套环形图的形式，最里面第一层当做花蕊，第二层当做花瓣，粗略代码如下：

library(echarts4r)

data1 <- data.frame(name = 'A',
                    value1 = 1)

data2 <- data.frame(name2 = rep('B', 8),
                    value2 = rep(3, 8))


#第一层的外圈半径需要小于第二层的内圈半径
data1 |>
  e_charts(name) |>
  e_pie(value1,
        radius = c("0%", "8%"),
        color='#FF6A6A') |>
  e_data(data2, value2) |>
  e_pie(value2,
        radius = c("10%", "40%"),
        color='#FF3030',
         itemStyle = list(
      borderRadius = 40,
      borderColor = '#fff',
      borderWidth = 5
    )) |>
  e_labels(show = FALSE)|>
  e_legend(show=FALSE)

得到图案，如下：

但是本咸鱼希望能够改变花瓣的形状，于是想要在上面的基础上再叠加一层，然后将第三层的图案颜色设置为近乎白色，可是却发现第三层的图案颜色设置了也不起作用，而是直接沿用了第二层的颜色，代码如下：

data3 <- data.frame(name3 = rep('B', 24),
                    value3 = rep(3, 24))

#第一层的外圈半径需要小于第二层的内圈半径
data1 |>
  e_charts(name) |>
  e_pie(value1,
        radius = c("0%", "8%"),
        color = '#FF6A6A') |>
  e_data(data2, value2) |>
  e_pie(
    value2,
    radius = c("10%", "40%"),
    color = '#FF3030',
    itemStyle = list(
      borderRadius = 40,
      borderColor = '#fff',
      borderWidth = 5
    )
  ) |>
#引入第三层
  e_data(data3, value3) |>
  e_pie(
    value3,
    radius = c("35%", "45%"),
    color = 'white', 设置第三层的颜色
    itemStyle = list(
      borderRadius = 40,
      borderColor = '#fff',
      borderWidth = 5
    )
  ) |>
  e_labels(show = FALSE) |>
  e_legend(show = FALSE)

最终效果如下：

不知道是不是我哪里参数设置有问题，还是这个包本身的问题，请小伙伴们帮忙看看。

另，如果有其他可以实现的画图包也烦请告知，咸鱼想要达到的效果是：绘制一朵花，有花蕊，有花瓣，且能改变花瓣的形状。

yihui

yuanfan 说老实话我不太看得懂上面的代码，再次凭瞎子多年的直觉猜答案：把那个颜色设置移进 itemStyle 里就好了。完整代码：

library(echarts4r)

data1 <- data.frame(name = 'A',
                    value1 = 1)

data2 <- data.frame(name2 = rep('B', 8),
                    value2 = rep(3, 8))

data3 <- data.frame(name3 = rep('B', 24),
                    value3 = rep(3, 24))

#第一层的外圈半径需要小于第二层的内圈半径
data1 |>
  e_charts(name) |>
  e_pie(value1,
        radius = c("0%", "8%"),
        color = '#FF6A6A') |>
  e_data(data2, value2) |>
  e_pie(
    value2,
    radius = c("10%", "40%"),
    color = '#FF3030',
    itemStyle = list(
      borderRadius = 40,
      borderColor = '#fff',
      borderWidth = 5
    )
  ) |>
  #引入第三层
  e_data(data3, value3) |>
  e_pie(
    value3,
    radius = c("35%", "45%"),
    itemStyle = list(
      color = 'white', # <- <- 就是这里 <- <-
      borderRadius = 40,
      borderColor = '#fff',
      borderWidth = 5
    )
  ) |>
  e_labels(show = FALSE) |>
  e_legend(show = FALSE)

咸鱼楼主居然能把一锅大饼烙出一朵花，不得不说这创意有点厉害。

看了这朵小花后，我惭愧地低头看了看胸前的红领巾……

yuanfan

yihui

……红领巾……

我的24K纯金狗眼已被戳瞎。奉劝其他小伙伴们不要去戳那个黑幕，即使戳了也不要运行那段代码，绝对不要把灯泡放嘴里啊喂。

tctcab

毫无难度～

df=expand.grid(x=(1:8),y=seq(300,600,1)) 
df$size=df$y^2

df.middle=data.frame(x=0,y=0,size=600^2)
df.outer=data.frame(x=seq(0,8,1/3))
df.outer$y=800
df.outer$size=400^2


p <- ggplot(df, aes(x, y, size = size)) +
  geom_point(color = "#FF3030") +
  geom_point(data = df.middle, color = "#FF6A6A") +
  geom_point(data = df.outer, color = "white") +
  ylim(0, 1100) +
  xlim(0, 8) +
  scale_size(range = c(7, 20)) +
  coord_polar(start = .4) +
  theme_void() +
  theme(legend.position = "none")
p

yuanfan

tctcab
厉害。这些花瓣的边缘怎么好像并不平滑。

Cloud2016

yuanfan 我本来没有去运行那段代码，但是被你这么带的，我跑看了下，我知道为啥原博客没有附图了。

tctcab

摸个鱼

yuanfan

tctcab

哦，你用ggplot2画的原理好高大上啊，有没有兴趣再鼓捣稍微复杂一些的呢？比如下面的。

Cloud2016

yuanfan tctcab 感觉二位可以合作来一篇，TC 君负责 ggplot2 的画法。

yihui

yuanfan 早年间有段时期论坛里有一股用 R “不务正业”的风气，我看这股歪风时隔十几年又要刮起来了。

yuanfan 用我残存的一点初中三角函数知识勉强算了一下坐标。我只是路过手痒，上桌搓一把就走，麻将你们继续。我估计楼主的多数花都可以这样蛮力画出来，只是太杀时间了。

# 将坐标矩阵逆时针旋转 theta 度
rotate = function(m, theta) {
  ct = cos(theta); st = sin(theta)
  as.matrix(m) %*% matrix(c(ct, -st, st, ct), 2)
}

# 一层花瓣的坐标矩阵
petal_one = function(n = 8, init = 0, r = 1, N = 100) {
  a = 2 * pi / n / 2  # 每片花瓣夹角的一半
  x1 = r * cos(a)
  y1 = r * sin(a)
  r2 = r * tan(a)
  a2 = pi/2 - a
  x2 = r2 * cos(a2)
  t = seq(-pi/2 - a, pi/2 + a, length.out = N)
  x3 = x1 + x2 + r2 * cos(t)
  y3 = r2 * sin(t)
  xa = c(0,  x1, x3, x1, 0)
  ya = c(0, -y1, y3, y1, 0)
  xy = cbind(xa, ya)
  res = lapply(init + 2 * pi * (seq(n) - 1)/n, function(theta) {
    rbind(rotate(xy, theta), NA)
  })
  do.call(rbind, res)
}

petal_all = function(L = 3, n = 8, ...) {
  res = NULL
  for (i in L:1) {
    init = if (i %% 2 == 0) pi/n else 0
    res = rbind(res, petal_one(n, init, 2 + i/L, ...))
  }
  res
}

# 参数：L 为层数，n 为花瓣数量
draw_flower = function(...) {
  xy = petal_all(...)
  par(mar = rep(1, 4), bg = '#FFFFE0')
  plot(xy, type = 'n', asp = 1, ann = FALSE, axes = FALSE)
  polygon(xy, col = '#FF6A6A', border = 'white', lwd = 5)
  points(0, 0, cex = 10, col = 'white', bg = '#FFA500', pch = 21, lwd = 3)
}

# 默认 3 层 8 瓣
draw_flower()

# 4 层 16 瓣
draw_flower(4, 16)

# 锐化花瓣（五角花瓣）
draw_flower(N = 5)

楼主的花蕊左上角有一段白弧，估计是无意渲染出来的，但造成了画花点晶的光线效果；我画的花蕊缺了那一丁点用来表示亮晶晶的白色反光，相比之下就土了一截。

tctcab

yuanfan
厚礼蟹！居然这么多，直接投都行吧

yuanfan

Cloud2016

记得你说 R 里面有好几个画图系统，要不要凑一桌麻将？

Cloud2016

yuanfan 二人对弈已是难得，不必强求。

Cloud2016

yihui 我之前看过贵厂 Thomas Lin Pedersen 用 R 画了很多艺术作品，甚是惊艳，BG 一下子上去了，见网站 https://www.data-imaginist.com/art
Thomas Lin Pedersen 说不会给出结果，因为那是创造力的杀手，我猜模拟一些二维或三维空间中的随机过程，有可能实现类似的效果。还有一些常、偏微分方程（组）的解也可能实现。要点是先找到有趣的方程。

楼上各位有兴趣的可以凑一桌麻将了。

yuanfan

yihui

土的是我才对，那道白弧是截图的时候无意中弄出来的，原图确实是没有的。

yuanfan

tctcab

已经投了，要不回头 TC 君不卧倒装死了，去审一审那篇？

我今天在B站上正好看到有弹幕刷“厚礼蟹”，这才后知后觉反应过来居然也是一个梗。

yihui

tctcab 如 Cloud2016 所说，感觉这些例子的难点在于数学和物理（我已经都还给老师了），JS 可能是最简单的一环，不过肯定有很多的 JS 库已经把基础工作都做好了。即便有现成的库可以调用，估计我的智商还是差远了，我只能理解简单的几何图形；记得 2004 年左右我用 VB 写过一个随机下雪的程序，那种 y = y + d 的简单移动大概就是我的能力上限了。

回到画花问题上，我估计 R 基础图形系统里的 xspline() 函数可能会有点用，比如楼主花纹系列的第一幅图的圆角也许用 X 样条去算近似坐标会比用三角函数硬算精确坐标更简单一点。

Cloud2016

Cloud2016 又一位搞艺术创作的 R 语言画家 Danielle Navarro

tctcab

跑个题，html5的canvas画布+很多可视化js库有很大的潜力可挖，codepen.io上好多作品让我大开眼界。
echarts4r其实核心也是基于js+html的库，可动还可交互，逼格也挺高。

大家都来学JS吧

举例

yuanfan

楼上的小伙伴们这是要滑向艺术的深渊呐。

听闻谷歌开发了一个名为 Disco Diffusion 的工具，可以做到 AI 画画。出得去的小伙伴可以去瞅瞅，是不是输入一句古诗也能画出图来，比如：夜雨打金荷。