Sunburst hierarchy

Plotting a sunburst diagram

This script can be used to plot a sunburst diagram to represent a hierarchy. The input can be a data frame with rows representing the leaf-level and columns represent annotations. This data frame needs to be restructured to a parent-child (hierarchical network data frame), which is what the ‘as.hierDF’ function does.

require(dplyr)
require(plotly)

Let’s start by loading some dummy hierarchical data. This data is a subset of the data from the Allen Brain Cell Atlas.

URL = 'https://allen-brain-cell-atlas.s3-us-west-2.amazonaws.com/metadata/WMB-taxonomy/20231215/cl.df_CCN202307220.xlsx'
data = rio::import_list(URL)

colors <- rio::import("https://allen-brain-cell-atlas.s3-us-west-2.amazonaws.com/metadata/WMB-taxonomy/20231215/views/cluster_to_cluster_annotation_membership_color.csv")

cl.df <- data$cluster_annotation
cl.df <- cl.df[cl.df$class_label != "LQ",]

cl.df <- cl.df %>% mutate(cluster_size = c(multiome.size + v2.size + v3.size))

# add colors to cluster data frame
colors$cluster_alias <- as.character(as.integer(colors$cluster_alias))
cl.df <- cl.df %>% left_join(colors, by=c("cl"="cluster_alias"))

select.columns <- colnames(cl.df)[grep("^supertype", colnames(cl.df))]
st.df <- cl.df %>% group_by_at(select.columns) %>% summarise(n=n())

select.columns <- colnames(cl.df)[grep("^subclass", colnames(cl.df))]
sc.df <- cl.df %>% group_by_at(select.columns) %>% summarise(n=n())

select.columns <- colnames(cl.df)[grep("^class", colnames(cl.df))]
c.df <- cl.df %>% group_by_at(select.columns) %>% summarise(n=n())

devtools::source_gist("https://gist.github.com/cvanvelt/ef29e1581b30b9758ec1bba1b8322619")

cl.df <- cl.df[cl.df$class_id %in% c(1:7),]
sunburstDF <- as.sunburstDF(cl.df, 
                           levels=c("class","subclass","supertype"),
                            valueCol = "cluster_size", 
                            rootname="WMB")

## [1] 1
## [1] 2
## [1] 3

p <- plot_ly() %>%
      add_trace(ids = sunburstDF$ids,
                labels = sunburstDF$labels,
                parents =sunburstDF$parent,
                values = sunburstDF$values,
                type = 'sunburst',
                sort=FALSE,
                marker = list(colors = sunburstDF$color),
                domain = list(column = 1),
                branchvalues = 'total'
                )%>%
      layout(grid = list(columns =1, rows = 1),
              margin = list(l = 0, r = 0, b = 0, t = 0)
      )

p