r - 如何在维基百科页面上绘制扇形图

Question

如何绘制 this Wikipedia page 上显示的扇形图?

我已经安装了 nlme与其包装 MathAchieve数据集，但我找不到绘制此图的命令。
nlme pdf 文件是 here .

我也查了this link但它是非英语的。

与 fan.plot来自 plotrix 的函数包，我只能画饼图:
https://sites.google.com/site/distantyetneversoclose/excel-charts/the-pie-doughnut-combination-a-fan-plot

谢谢你的帮助。

Answer 1

我可以想出几种方法来解决这个问题 lattice .您可以使用 xyplot并用 panel.fill 填充面板，或者您可以使用 levelplot .多边形本身必须添加自定义面板和 lpolygon .这是我如何使用 levelplot 完成的.我真的是lattice但是，新手，很可能有一些我不知道的快捷方式。

因为我正在使用 levelplot ，我们首先创建一个包含中值 MathAch 的矩阵MEANSES 的每个组合的分数和 SES .这些将用于绘制单元格颜色。

library(lattice)
library(nlme)
data(MathAchieve)

下面，我转换 SES和 MEANSES使用 cut 成因素，与维基百科示例中的断点。

MathAchieve$SESfac <- as.numeric(cut(MathAchieve$SES, seq(-2.5, 2, 0.5)))
MathAchieve$MEANSESfac <- as.numeric(cut(MathAchieve$MEANSES, 
                                         seq(-1.25, 1, 0.25)))

我不确定如何像维基百科页面上那样绘制四个面板，所以我只是将非少数民族女性划分为子集:

d <- subset(MathAchieve, Sex=='Female' & Minority=='No')

将此数据帧转换为矩阵，我 split将其转换为列表，然后强制返回具有适当维度的矩阵。矩阵的每个单元格包含中值 MathAch对于 SESfac 的特定组合和 MEANSESfac .

l <- split(d$MathAch, list(d$SESfac, d$MEANSESfac))
m.median <- matrix(sapply(l, median), ncol=9)

当我们使用 levelplot我们将可以访问 x和 y ，是“当前”单元格的坐标。为了传递 MathAch的向量至 levelplot ，以便可以为每个单元格绘制多边形，我创建了一个列表矩阵(与 m.median 相同的维度)，其中每个单元格是一个包含 MathAch 的列表向量。

m <- matrix(l, ncol=9)

下面我们创建了 Wolfram Fischer 在维基百科示例中使用的色带。

colramp <- colorRampPalette(c('#fff495', '#bbffaa', '#70ffeb', '#72aaff', 
                              '#bf80ff'))

现在我们定义自定义面板功能。我一直在评论以解释:

fanplot <- function(x, y, z, subscripts, fans, ymin, ymax, 
                    nmax=max(sapply(fans, length)), ...) {
  # nmax is the maximum sample size across all combinations of conditioning
  # variables. For generality, ymin and ymax are limits of the circle around 
  # around which fancharts are plotted. 
  # fans is our matrix of lists, which are used to plot polygons.
  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))
  }
  # getcoords returns coordinates of one or more points, given angle(s), 
  # (i.e., a), distances (i.e., d), and an origin (x0 and y0).

  panel.levelplot(x, y, z, subscripts, ...)

  # Below, we scale the raw vectors of data such that ymin thru ymax map to 
  # 0 thru 360. We then calculate the relevant quantiles (i.e. 25%, 50% and 75%).
  smry <- lapply(fans, function(y) {
    y.scld <- (y - ymin)/(ymax - ymin) * 360
    quantile(y.scld, c(0.25, 0.5, 0.75)) - 90
  })

  # Now we use get.coords to determine relevant coordinates for plotting 
  # polygons and lines. We plot a white line inwards from the circle's edge,
  # with length according to the ratio of the sample size to nmax.
  mapply(function(x, y, smry, n) {
    if(!any(is.na(smry))) {
      lpolygon(rbind(c(x, y), 
                     get.coords(seq(smry['25%'], smry['75%'], length.out=200), 
                                0.3, x, y)), col='gray10', lwd=2)
      llines(get.coords(c(smry['50%'], 180 + smry['50%']), 0.3, 
                        x, y), col=1, lwd=3)
      llines(get.coords(smry['50%'], c(0.3, (1 - n/nmax) * 0.3), 
                        x, y), col='white', lwd=3)
    }
  }, x=x, y=y, smry=smry, n=sapply(fans, length))
}

最后在 levelplot 内使用这个自定义面板功能:

levelplot(m.median, fans=m, ymin=0, ymax=28,
          col.regions=colramp, at=seq(0, 25, 5), panel=fanplot, 
          scales=list(tck=c(1, 0), 
                      x=list(at=seq_len(ncol(m.median) + 1) - 0.5, 
                             labels=seq(-2.5, 2, 0.5)),
                      y=list(at=seq_len(nrow(m.median) + 1) - 0.5, 
                             labels=seq(-1.25, 1, 0.25))), 
          xlab='Socio-economic status of students',
          ylab='Mean socio-economic status for the school')

如果样本量 < 7，我没有将单元格着色为灰色，就像对 Wikipedia page 上的等效图所做的那样，但这可以通过 lrect 来完成如果需要的话。