如何在没有 coord_polar 的情况下制作堆积圆图

Question

我有一个类似这样的数据集：

x <- 100 - abs(rnorm(1e6, 0, 5))
y <- 50 + rnorm(1e6, 0, 3)
dist <- sqrt((x - 100)^2 + (y - 50)^2)
z <- exp(-(dist / 8)^2)

可视化如下：

data.frame(x, y, z) %>%  
  ggplot() + geom_point(aes(x, y, color = z))

我想做的是一个堆叠的半圆图，在后续层中 z 的平均值。我认为可以通过geom_col和coord_polar()的组合来完成，虽然我能得到的最远的是

data.frame(x, y, z, dist) %>% 
  mutate(dist_fct = cut(dist, seq(0, max(dist), by = 5))) %>% 
  ggplot() + geom_bar(aes(x = 1, y = 1, fill = dist_fct), stat = 'identity', position = 'fill') +
  coord_polar()

这显然与预期相去甚远（层应大小相等，图应剪裁在右半边）。

问题是由于进一步使用annotate_custom()，我不能真正使用coord_polar()。所以我的问题是：

• 没有coord_polar()可以这样绘制吗？
• 如果不行，用coord_polar()怎么办？

结果应该类似于下面的图形，除了绘制由点构成的图层之外，我只想将图层作为一个整体绘制，颜色定义为图层内的平均值z。

Answer 1

如果您想要简单的半径带，也许像您在问题中所描绘的那样，这样的事情会起作用：

# your original sample data
x <- 100 - abs(rnorm(1e6, 0, 5))
y <- 50 + rnorm(1e6, 0, 3)
dist <- sqrt((x - 100)^2 + (y - 50)^2)

nbr_bands <- 6  # set nbr of bands to plot 

# calculate width of bands
band_width <- max(dist)/(nbr_bands-1)

# dist div band_width yields an integer 0 to nbr bands
# as.factor makes it categorical, which is what you want for the plot
band = as.factor(dist %/% (band_width))

library(dplyr)
library(ggplot2)
data.frame(x, y, band) %>%  
  ggplot() + geom_point(aes(x, y, color = band)) + coord_fixed() +
  theme_dark()  # dark theme

编辑详细说明：

正如您第一次尝试的那样，最好使用非常方便的cut() 函数来计算半径颜色类别。

为绘图颜色组获取分类（离散）颜色而不是连续阴影的一种方法是将 aes color= 设置为因子列。

要直接从cut() 获取因子，您可以使用选项ordered_result=TRUE：

band <- cut(dist, nbr_bands, ordered_result=TRUE, labels=1:nbr_bands)  # also use `labels=` to specify your own labels

data.frame(x, y, band) %>%
  ggplot() + geom_point(aes(x, y, color = band)) + coord_fixed() 

或者更简单地说，您可以使用不带选项的cut() 并使用as.factor() 转换为因子：

band <- as.factor( cut(dist, nbr_bands, labels=FALSE) )

data.frame(x, y, band) %>%
  ggplot() + geom_point(aes(x, y, color = band)) + coord_fixed() 

Answer 2

听起来您可能会发现 ggforce 包中的圆弧绘图功能很有用：

# data
set.seed(1234)
df <- data.frame(x = 100 - abs(rnorm(1e6, 0, 5)),
                 y = 50 + rnorm(1e6, 0, 3)) %>%  
  mutate(dist = sqrt((x - 100)^2 + (y - 50)^2)) %>%
  mutate(z = exp(-(dist / 8)^2))

# define cut-off values
cutoff.values <- seq(0, ceiling(max(df$dist)), by = 5)

df %>%
  # calculate the mean z for each distance band
  mutate(dist_fct = cut(dist, cutoff.values)) %>%
  group_by(dist_fct) %>%
  summarise(z = mean(z)) %>%
  ungroup() %>%

  # add the cutoff values to the dataframe for inner & outer radius
  arrange(dist_fct) %>%
  mutate(r0 = cutoff.values[-length(cutoff.values)],
         r = cutoff.values[-1]) %>%

  # add coordinates for circle centre
  mutate(x = 100, y = 50) %>%

  # plot
  ggplot(aes(x0 = x, y0 = y, 
             r0 = r0, r = r, 
             fill = z)) +
  geom_arc_bar(aes(start = 0, end = 2 * pi), 
               color = NA) + # hide outline

  # force equal aspect ratio in order to get true circle
  coord_equal(xlim = c(70, 100), expand = FALSE)

绘图生成在我的机器上花费了

Answer 3

我不确定这是否能满足所有要求，但这应该是一个开始。为了减少绘图时间，我将数据汇总到一个网格中，这样您就可以使用geom_raster。我并不完全了解中断和您使用的所有内容，因此您可能想要调整一些我如何划分数据以制作不同的乐队。我用cut_interval 和cut_width 尝试了几种方法——这将是插入不同选项的好地方，例如带的数量或宽度。

由于您提到要获得每个频段的平均 z，我将按网格化的 x 和 y 和切分 dist 进行分组，然后使用 z 的平均值来设置频段。我采取了一个步骤来制作示例中的标签——你可能想要反转它们或调整它们的位置——但这来自于获取每个波段的因子水平的数量。

library(tidyverse)
set.seed(555)
n <- 1e6

df <- data_frame(
  x = 100 - abs(rnorm(n, 0, 5)), 
  y = 50 + rnorm(n, 0, 3), 
  dist = sqrt((x - 100)^2 + (y - 50)^2), 
  z = exp(-(dist / 8)^2)
) %>%
  mutate(brk = cut(dist, seq(0, max(dist), by = 5), include.lowest = T))

summarized <- df %>%
  filter(!is.na(brk)) %>%
  mutate(x_grid = floor(x), y_grid = floor(y)) %>%
  group_by(x_grid, y_grid, brk) %>%
  summarise(avg_z = mean(z)) %>%
  ungroup() %>%
  # mutate(z_brk = cut_width(avg_z, width = 0.15)) %>%
  mutate(z_brk = cut_interval(avg_z, n = 9)) %>%
  mutate(brk_num = as.numeric(z_brk))

head(summarized)
#> # A tibble: 6 x 6
#>   x_grid y_grid brk         avg_z z_brk           brk_num
#>    <dbl>  <dbl> <fct>       <dbl> <fct>             <dbl>
#> 1     75     46 (20,25] 0.0000697 [6.97e-05,0.11]       1
#> 2     75     47 (20,25] 0.000101  [6.97e-05,0.11]       1
#> 3     75     49 (20,25] 0.0000926 [6.97e-05,0.11]       1
#> 4     75     50 (20,25] 0.0000858 [6.97e-05,0.11]       1
#> 5     75     52 (20,25] 0.0000800 [6.97e-05,0.11]       1
#> 6     76     51 (20,25] 0.000209  [6.97e-05,0.11]       1

要制作标签，请将数据汇总为每个波段有一行——我通过取网格化 x 的最小值，然后使用 y 的平均值来做到这一点，这样它们就会出现在情节的中间。

labels <- summarized %>%
  group_by(brk_num) %>%
  summarise(min_x = min(x_grid)) %>%
  ungroup() %>%
  mutate(y_grid = mean(summarized$y_grid))

head(labels)
#> # A tibble: 6 x 3
#>   brk_num min_x y_grid
#>     <dbl> <dbl>  <dbl>
#> 1       1    75   49.7
#> 2       2    88   49.7
#> 3       3    90   49.7
#> 4       4    92   49.7
#> 5       5    93   49.7
#> 6       6    94   49.7

geom_raster 非常适合这些情况，即您的数据位于均匀间隔的网格中，而每个位置只需要统一的平铺。此时，汇总数据有 595 行，而不是原来的 100 万行，因此绘制时间应该不是问题。

ggplot(summarized) +
  geom_raster(aes(x = x_grid, y = y_grid, fill = z_brk)) +
  geom_label(aes(x = min_x, y = y_grid, label = brk_num), data = labels, size = 3, hjust = 0.5) +
  theme_void() +
  theme(legend.position = "none", panel.background = element_rect(fill = "gray40")) +
  coord_fixed() +
  scale_fill_brewer(palette = "PuBu")

^{由reprex package (v0.2.1) 于 2018 年 11 月 4 日创建}