Как сделать сложный круг без координат

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

что явно далеко от ожидания (слои должны быть одинакового размера, участок должен быть обрезан в правой половине).

Проблема в том, что я не могу использовать coord_polar() из-за дальнейшего использования annotate_custom(). Итак, мой вопрос:

• можно построить как это можно сделать без coord_polar()?
• Если нет, то как это можно сделать с помощью coord_polar()?

Результат должен быть аналогичен приведенному ниже графику, за исключением рисования слоев, построенных из точек. Я хотел бы построить только слои целиком со цветом, определенным как среднее значение z внутри слоя.

Answer 1

Звучит так, как будто вы можете использовать функции построения кругов и дуг из пакета 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)

Генерация участка заняла <1 с на моей машине. Ваш может отличаться. </p>

Answer 2

Я не уверен, что это удовлетворяет все, но это должно быть началом. Чтобы сократить время построения графика, я суммирую данные в сетке, что позволяет использовать 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 строк вместо исходного 1 миллиона, поэтому время для построения графика не должно быть проблемой.

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

^{Создано в 2018-11-04 пакетом Представить (v0.2.1)}

Answer 3

Если вам нужны простые радиусные полосы, возможно, что-то подобное будет работать так, как вы изобразили в своем вопросе:

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