如何在可打印的R森伯斯特标签上添加标签和百分比

Question

我正在尝试使用R向朝阳图内的每一层添加标签和百分比-因此看起来像Sunburst。

我可以创建森伯斯特图表（使用this guide)，但我不知道如何添加标签或百分比。我还希望能够打印包含所有标签和百分比的图表。

到目前为止，这是我的代码。

# libraries
library(dplyr)
library(treemap)
library(sunburstR)
library(readxl)
library(vcd)


## Load Arthritis as example
Data <- data.frame(Arthritis)
Data <- Data %>% select(-ID) %>% 
mutate(Age=ifelse(Age<50,"Young","Old")) %>% group_by(Treatment,Sex,Improved,Age) %>% 
summarise(Count=n()) %>% 
mutate(Path=paste(Treatment,Sex,Improved,Age,sep="-")) %>% 
ungroup() %>% 
select(Path,Count)

sunburst(Data)

任何帮助都会很棒。

谢谢。

Answer 1

我建议使用ggsunburst软件包https://github.com/didacs/ggsunburst

library(ggsunburst)
library(dplyr)
library(vcd) # just for the Arthritis dataset
Data <- data.frame(Arthritis)

# compute percentage using tally
# add column leaf, with format "name->attribute:value"
# ggsunburst considers everything after "->" as attributes
# the attribute "size" is used as the size of the arc
df <- Data %>% 
  mutate(Age=ifelse(Age<50,"Young","Old")) %>%
  group_by(Treatment,Sex,Improved,Age) %>% 
  tally() %>%
  mutate(percentage = n/nrow(Data)*100, 
         size=paste("->size:",round(percentage,2),sep=""),
         leaf=paste(Improved,size,sep = "")) %>%
  ungroup() %>%
  select(Treatment,Sex,Age,leaf)

# sunburst_data reads from a file so you need to create one
write.table(df, file = 'data.csv', row.names = F, col.names = F, sep = ",")

# specify node_attributes = "size" to add labels with percentages in terminal nodes
sb <- sunburst_data('data.csv', type = "lineage", sep = ',', node_attributes = "size")

# compute percentages for internal nodes
tre <- Data %>%
  group_by(Treatment) %>%
  tally() %>%
  mutate(percent=n/nrow(Data)*100,
         name=Treatment) %>%
  ungroup() %>%
  select(name,percent)

sex <- Data %>%
  group_by(Treatment,Sex) %>%
  tally() %>%
  mutate(percent=n/nrow(Data)*100,
         name=Sex) %>%
  ungroup() %>%
  select(name,percent)

age <- Data %>%
  mutate(Age=ifelse(Age<50,"Young","Old")) %>%
  group_by(Treatment,Sex,Age) %>%
  tally() %>%
  mutate(percent=n/nrow(Data)*100,
         name=Age) %>%
  ungroup() %>%
  select(name,percent)

x <- rbind(tre, sex, age)
# the rows in x are in the same order as sb$node_labels, cbind works here only because of that
x <- cbind(sb$node_labels, round(x[,"percent"],2))
percent <- x %>% mutate(name_percent = paste(label,percent,"%"))

sunburst(sb, node_labels.min = 0) +
  geom_text(data = sb$leaf_labels, aes(x=x, y=0.1, label=paste(size,"%"), angle=angle, hjust=hjust), size = 2) +
  geom_text(data = percent, aes(x=x, y=y, label=name_percent, angle=pangle), size=2)