Я искал способ сделать этот тип графика, используя ggplot. Ответ @camille был действительно полезным! Я также использовал этот ответ здесь , чтобы создать слегка измененный ответ на этот вопрос.
Прошел почти год, но, возможно, кто-то еще ищет этот тип ответа! Возможно, другие пакеты, упомянутые в других ответах, более полезны, но для тех из нас, кто хочет остаться в ggplot, надеюсь, это поможет.
Думаю, я мог бы сделать то, о чем просил ОП (последовательно окрашивая второй уровень), хотя я не уверен, что это оптимальный путь.
Вместо использования geom_col я использовал geom_rect. Это дает нам больше гибкости, а также больше контроля над тем, где рисуется каждый прямоугольник (у сгруппированных баров всегда есть проблема с блоками порядка). Также, как ни странно, в полярных координатах geom_col заканчивается рисованием всех пирогов от 0 до x. Поэтому @camille пришлось поиграться с прозрачными пленками, чтобы получить желаемый результат. В geom_rect мы можем установить xmin и xmax, чтобы получить нужную форму.
Но нам нужно кое-что обработать, чтобы привести данные в форму.
Кроме того, на сюжете, который я пытаюсь сделать, некоторые вторые уровни пусты. Поэтому я немного изменил набор данных, чтобы включить один дополнительный класс первого уровня без класса второго уровня.
Вот мое решение:
library(tidyverse)
library(ggplot2)
library(RColorBrewer)
df <- "name type value
foo all 444
foo type1 123
foo type2 321
bar all 111
bar type3 111
baz all 999
baz type1 456
baz type3 543
boz - 222" %>% read_table2() %>% filter(type != 'all') %>%
mutate(type=ifelse(type=='-', NA, type)) %>% arrange(name, value)
# here I create the columns xmin, xmax, ymin, ymax using cumsum function
# (be VERY careful with ordering of rows!)
# I also created a column 'colour' which I map to the asthetic 'colour' (colour of line of each rectangle)
# it is a boolean saying if a line should or should not be drawn.
# for empty second levels i want to draw an empty space (no fill and no line)
# define a padding space between the levels of the pie chart
padding <- 0.05
# create df for level 0
lvl0 <- tibble(name = "Parent", value = 0, level = 0, fill = NA) %>%
mutate(xmin=0, xmax=1, ymin=0, ymax=value) %>%
mutate(x.avg=0, y.avg=0, colour=FALSE)
print(lvl0)
# create df for level 1
lvl1 <- df %>%
group_by(name) %>%
summarise(value = sum(value)) %>%
ungroup() %>%
mutate(level = 1) %>%
mutate(fill = name) %>%
mutate(xmin=1+padding, xmax=2, ymin=0, ymax=cumsum(value)) %>%
mutate(ymin=lag(ymax, default=0),
x.avg=(xmin+xmax)/2,
y.avg=(ymin+ymax)/2,
colour=TRUE)
print(lvl1)
# create df for level 2
lvl2 <- df %>%
select(name = type, value, fill = name) %>%
mutate(level = 2) %>%
mutate(fill=paste0(fill, '_', name)) %>%
mutate(xmin=2+padding, xmax=3, ymin=0, ymax=cumsum(value)) %>%
mutate(ymin=lag(ymax, default=0),
x.avg=(xmin+xmax)/2,
y.avg=(ymin+ymax)/2,
colour=ifelse(grepl('_NA', fill), FALSE, TRUE))
print(lvl2)
# this is my dirty workaround for defining the colours of levels 1 one 2 independently. Probably not the best way and
# maybe it will not scale very well... But for this small data set it seemed to work...
# number of classes in each level (don't include NA)
n.classes.1 <- 4
n.classes.2 <- 3
n.classes.total <- n.classes.1 + n.classes.2
# get colour pallete for level 1
col.lvl1 <- brewer.pal(n.classes.total,"Dark2")[1:n.classes.1]
names(col.lvl1) <- as.character(unique(lvl1$name))
# get colour pallete for level 2 (don't include NA)
col.lvl2 <- brewer.pal(n.classes.total,"Dark2")[(n.classes.1+1):n.classes.total]
names(col.lvl2) <- as.character(unique(lvl2$name)[!is.na(unique(lvl2$name))])
# compile complete color pallete
fill.pallete <- c(col.lvl1)
for (l1 in as.character(unique(lvl1$name))) {
for (l2 in as.character(unique(lvl2$name))) {
if (!is.na(l2)) {
name.type <- paste0(l1, '_', l2)
aux <- col.lvl2[l2]
names(aux) <- name.type
fill.pallete <- c(fill.pallete, aux)
} else {
# if level2 is NA, then assign transparent colour
name.type <- paste0(l1, '_NA')
aux <- NA
names(aux) <- name.type
fill.pallete <- c(fill.pallete, aux)
}
}
}
print(fill.pallete)
# put all data frames together for ggplot
df.total <- bind_rows(lvl0, lvl1, lvl2) %>%
mutate(name = as.factor(name) %>% fct_reorder2(fill, value)) %>%
arrange(fill, name) %>%
mutate(level = as.factor(level))
print(df.total)
# create plot (it helped me to look at the rectangular coordinates first before changing to polar!)
g <- ggplot(data=df.total, aes(fill = fill)) +
geom_rect(aes(ymax=ymax, ymin=ymin, xmax=xmax, xmin=xmin, colour=colour), size = 0.1) +
scale_fill_manual(values = fill.pallete, , guide = F, na.translate = FALSE) +
scale_color_manual(values = c('TRUE'='gray20', 'FALSE'='#FFFFFF00'),
guide = F, na.translate = FALSE) +
geom_text(aes(x = x.avg, y = y.avg, label = name), size = rel(2.5)) +
scale_x_discrete(breaks = NULL) +
scale_y_continuous(breaks = NULL) +
labs(x = NULL, y = NULL) +
theme_minimal() +
theme(panel.grid=element_blank()) +
coord_polar(theta = "y", start = 0, direction = -1)
print(g)
Это результирующий сюжет .