• Plotting a sunburst diagram



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
WMBIT-ET GlutNP-CT-L6b GlutOB-CR GlutDG-IMN GlutOB-IMN GABACTX-CGE GABACTX-MGE GABACLA-EPd-CTX Car3 GlutIT EP-CLA GlutL5/6 IT TPE-ENT GlutL6 IT CTX GlutL5 IT CTX GlutL4/5 IT CTX GlutL2/3 IT CTX GlutL2/3 IT ENT GlutL2/3 IT PIR-ENTl GlutIT AON-TT-DP GlutL2 IT ENT-po GlutMEA Slc17a7 GlutCOAp Grxcr2 GlutLA-BLA-BMA-PA GlutENTmv-PA-COAp GlutCA1-ProS GlutCA3 GlutL2 IT PPP-APr GlutL2/3 IT PPP GlutL2/3 IT RSP GlutL4 RSP-ACA GlutL5 ET CTX GlutSUB-ProS GlutL5 PPP GlutCA2-FC-IG GlutNLOT Rho GlutL6b EPd GlutL6b/CT ENT GlutL6b CTX GlutL6 CT CTX GlutCT SUB GlutL5 NP CTX GlutNP SUB GlutNP PPP GlutOB Eomes Ms4a15 GlutHPF CR GlutDG GlutDG-PIR Ex IMNOB Meis2 Thsd7b GabaOB Trdn GabaOB-in Frmd7 GabaOB-out Frmd7 GabaOB-mi Frmd7 GabaOB Dopa-GabaOB-STR-CTX Inh IMNVip GabaSncg GabaRHP-COA Ndnf GabaLamp5 GabaLamp5 Lhx6 GabaPvalb chandelier GabaPvalb GabaSst GabaCLA-EPd-CTX Car3 Glut_1CLA-EPd-CTX Car3 Glut_2IT EP-CLA Glut_1IT EP-CLA Glut_2IT EP-CLA Glut_3IT EP-CLA Glut_4L5/6 IT TPE-ENT Glut_1L5/6 IT TPE-ENT Glut_2L5/6 IT TPE-ENT Glut_3L5/6 IT TPE-ENT Glut_4L5/6 IT TPE-ENT Glut_5L5/6 IT TPE-ENT Glut_6L6 IT CTX Glut_1L6 IT CTX Glut_2L6 IT CTX Glut_3L6 IT CTX Glut_4L6 IT CTX Glut_5L5 IT CTX Glut_1L5 IT CTX Glut_2L5 IT CTX Glut_3L5 IT CTX Glut_4L5 IT CTX Glut_5L4/5 IT CTX Glut_1L4/5 IT CTX Glut_2L4/5 IT CTX Glut_3L4/5 IT CTX Glut_4L4/5 IT CTX Glut_5L4/5 IT CTX Glut_6L2/3 IT CTX Glut_1L2/3 IT CTX Glut_2L2/3 IT CTX Glut_3L2/3 IT CTX Glut_4L2/3 IT ENT Glut_1L2/3 IT ENT Glut_2L2/3 IT ENT Glut_3L2/3 IT ENT Glut_4L2/3 IT ENT Glut_5L2/3 IT ENT Glut_6L2/3 IT PIR-ENTl Glut_1L2/3 IT PIR-ENTl Glut_2L2/3 IT PIR-ENTl Glut_3L2/3 IT PIR-ENTl Glut_4L2/3 IT PIR-ENTl Glut_5L2/3 IT PIR-ENTl Glut_6L2/3 IT PIR-ENTl Glut_7IT AON-TT-DP Glut_1IT AON-TT-DP Glut_2IT AON-TT-DP Glut_3IT AON-TT-DP Glut_4IT AON-TT-DP Glut_5L2 IT ENT-po Glut_1L2 IT ENT-po Glut_2L2 IT ENT-po Glut_3L2 IT ENT-po Glut_4MEA Slc17a7 Glut_1MEA Slc17a7 Glut_2MEA Slc17a7 Glut_3COAp Grxcr2 Glut_1COAp Grxcr2 Glut_2LA-BLA-BMA-PA Glut_1LA-BLA-BMA-PA Glut_2LA-BLA-BMA-PA Glut_3LA-BLA-BMA-PA Glut_4LA-BLA-BMA-PA Glut_5LA-BLA-BMA-PA Glut_6ENTmv-PA-COAp Glut_1ENTmv-PA-COAp Glut_2ENTmv-PA-COAp Glut_3CA1-ProS Glut_1CA1-ProS Glut_2CA1-ProS Glut_3CA1-ProS Glut_4CA1-ProS Glut_5CA1-ProS Glut_6CA3 Glut_1CA3 Glut_2CA3 Glut_3CA3 Glut_4CA3 Glut_5L2 IT PPP-APr Glut_1L2 IT PPP-APr Glut_2L2 IT PPP-APr Glut_3L2 IT PPP-APr Glut_4L2/3 IT PPP Glut_1L2/3 IT PPP Glut_2L2/3 IT PPP Glut_3L2/3 IT RSP Glut_1L2/3 IT RSP Glut_2L4 RSP-ACA Glut_1L5 ET CTX Glut_1L5 ET CTX Glut_2L5 ET CTX Glut_3L5 ET CTX Glut_4L5 ET CTX Glut_5L5 ET CTX Glut_6SUB-ProS Glut_1SUB-ProS Glut_2SUB-ProS Glut_3L5 PPP Glut_1CA2-FC-IG Glut_1CA2-FC-IG Glut_2NLOT Rho Glut_1L6b EPd Glut_1L6b EPd Glut_2L6b EPd Glut_3L6b/CT ENT Glut_1L6b/CT ENT Glut_2L6b/CT ENT Glut_3L6b/CT ENT Glut_4L6b CTX Glut_1L6b CTX Glut_2L6b CTX Glut_3L6b CTX Glut_4L6 CT CTX Glut_1L6 CT CTX Glut_2L6 CT CTX Glut_3L6 CT CTX Glut_4L6 CT CTX Glut_5L6 CT CTX Glut_6CT SUB Glut_1CT SUB Glut_2L5 NP CTX Glut_1L5 NP CTX Glut_2L5 NP CTX Glut_3L5 NP CTX Glut_4L5 NP CTX Glut_5NP SUB Glut_1NP SUB Glut_2NP PPP Glut_1OB Eomes Ms4a15 Glut_1OB Eomes Ms4a15 Glut_2OB Eomes Ms4a15 Glut_3OB Eomes Ms4a15 Glut_4OB Eomes Ms4a15 Glut_5HPF CR Glut_1DG Glut_1DG Glut_2DG Glut_3DG Glut_4DG-PIR Ex IMN_1DG-PIR Ex IMN_2DG-PIR Ex IMN_3OB Meis2 Thsd7b Gaba_1OB Meis2 Thsd7b Gaba_2OB Meis2 Thsd7b Gaba_3OB Meis2 Thsd7b Gaba_4OB Meis2 Thsd7b Gaba_5OB Trdn Gaba_1OB Trdn Gaba_2OB-in Frmd7 Gaba_1OB-in Frmd7 Gaba_2OB-in Frmd7 Gaba_3OB-in Frmd7 Gaba_4OB-in Frmd7 Gaba_5OB-in Frmd7 Gaba_6OB-in Frmd7 Gaba_7OB-in Frmd7 Gaba_8OB-out Frmd7 Gaba_1OB-out Frmd7 Gaba_2OB-out Frmd7 Gaba_3OB-mi Frmd7 Gaba_1OB Dopa-Gaba_1OB Dopa-Gaba_2OB Dopa-Gaba_3OB Dopa-Gaba_4OB-STR-CTX Inh IMN_1OB-STR-CTX Inh IMN_2OB-STR-CTX Inh IMN_3OB-STR-CTX Inh IMN_4OB-STR-CTX Inh IMN_5OB-STR-CTX Inh IMN_6OB-STR-CTX Inh IMN_7Vip Gaba_1Vip Gaba_2Vip Gaba_3Vip Gaba_4Vip Gaba_5Vip Gaba_6Vip Gaba_7Vip Gaba_8Vip Gaba_9Vip Gaba_10Vip Gaba_11Vip Gaba_12Sncg Gaba_1Sncg Gaba_2Sncg Gaba_3Sncg Gaba_4Sncg Gaba_5Sncg Gaba_6Sncg Gaba_7Sncg Gaba_8RHP-COA Ndnf Gaba_1RHP-COA Ndnf Gaba_2RHP-COA Ndnf Gaba_3RHP-COA Ndnf Gaba_4RHP-COA Ndnf Gaba_5RHP-COA Ndnf Gaba_6Lamp5 Gaba_1Lamp5 Gaba_2Lamp5 Gaba_3Lamp5 Gaba_4Lamp5 Lhx6 Gaba_1Pvalb chandelier Gaba_1Pvalb Gaba_1Pvalb Gaba_2Pvalb Gaba_3Pvalb Gaba_4Pvalb Gaba_5Pvalb Gaba_6Pvalb Gaba_7Pvalb Gaba_8Pvalb Gaba_9Sst Gaba_1Sst Gaba_2Sst Gaba_3Sst Gaba_4Sst Gaba_5Sst Gaba_6Sst Gaba_7Sst Gaba_8Sst Gaba_9Sst Gaba_10Sst Gaba_11Sst Gaba_12Sst Gaba_13Sst Gaba_14Sst Gaba_15Sst Gaba_16Sst Gaba_17Sst Gaba_18Sst Gaba_19
LS0tCnRpdGxlOiAiU3VuYnVyc3QgaGllcmFyY2h5IgphdXRob3I6ICJDaW5keSB2YW4gVmVsdGhvdmVuIgpvdXRwdXQ6CiAgaHRtbF9kb2N1bWVudDoKICAgIHRvYzogdHJ1ZQogICAgdG9jX2Zsb2F0OiB0cnVlCiAgICBjb2RlX2Rvd25sb2FkOiB0cnVlCiAgICBjb2RlX2ZvbGRpbmc6IGhpZGUKZGF0ZTogIjIwMjQtMDItMDYiCi0tLQoKXApcCgojIyBQbG90dGluZyBhIHN1bmJ1cnN0IGRpYWdyYW0KClwKClRoaXMgc2NyaXB0IGNhbiBiZSB1c2VkIHRvIHBsb3QgYSBzdW5idXJzdCBkaWFncmFtIHRvIHJlcHJlc2VudCBhIGhpZXJhcmNoeS4KVGhlIGlucHV0IGNhbiBiZSBhIGRhdGEgZnJhbWUgd2l0aCByb3dzIHJlcHJlc2VudGluZyB0aGUgbGVhZi1sZXZlbCBhbmQgY29sdW1ucyByZXByZXNlbnQgYW5ub3RhdGlvbnMuIFRoaXMgZGF0YSBmcmFtZSBuZWVkcyB0byBiZSByZXN0cnVjdHVyZWQgdG8gYSBwYXJlbnQtY2hpbGQgKGhpZXJhcmNoaWNhbCBuZXR3b3JrIGRhdGEgZnJhbWUpLCB3aGljaCBpcyB3aGF0IHRoZSAnYXMuaGllckRGJyBmdW5jdGlvbiBkb2VzLiAKCmBgYHtyIGtsaXBweSwgZWNobz1GQUxTRSwgaW5jbHVkZT1UUlVFfQprbGlwcHk6OmtsaXBweSgpCmBgYAoKYGBge3Igc2V0dXAsIGluY2x1ZGU9RkFMU0V9IAprbml0cjo6b3B0c19jaHVuayRzZXQod2FybmluZyA9IEZBTFNFLCBtZXNzYWdlID0gRkFMU0UpIApgYGAKCmBgYHtyIGxvYWRpbmcgbGlicywgZWNobz1UfQoKcmVxdWlyZShkcGx5cikKcmVxdWlyZShwbG90bHkpCgpgYGAKCkxldCdzIHN0YXJ0IGJ5IGxvYWRpbmcgc29tZSBkdW1teSBoaWVyYXJjaGljYWwgZGF0YS4gVGhpcyBkYXRhIGlzIGEgc3Vic2V0IG9mIHRoZSBkYXRhIGZyb20KdGhlIFtBbGxlbiBCcmFpbiBDZWxsIEF0bGFzXShodHRwczovL2FsbGVuaW5zdGl0dXRlLmdpdGh1Yi5pby9hYmNfYXRsYXNfYWNjZXNzL2ludHJvLmh0bWwpLgoKYGBge3IsIGVjaG89VCwgZXZhbD1UfQpVUkwgPSAnaHR0cHM6Ly9hbGxlbi1icmFpbi1jZWxsLWF0bGFzLnMzLXVzLXdlc3QtMi5hbWF6b25hd3MuY29tL21ldGFkYXRhL1dNQi10YXhvbm9teS8yMDIzMTIxNS9jbC5kZl9DQ04yMDIzMDcyMjAueGxzeCcKZGF0YSA9IHJpbzo6aW1wb3J0X2xpc3QoVVJMKQoKY29sb3JzIDwtIHJpbzo6aW1wb3J0KCJodHRwczovL2FsbGVuLWJyYWluLWNlbGwtYXRsYXMuczMtdXMtd2VzdC0yLmFtYXpvbmF3cy5jb20vbWV0YWRhdGEvV01CLXRheG9ub215LzIwMjMxMjE1L3ZpZXdzL2NsdXN0ZXJfdG9fY2x1c3Rlcl9hbm5vdGF0aW9uX21lbWJlcnNoaXBfY29sb3IuY3N2IikKYGBgCgpgYGB7ciwgZWNobz1ULCBldmFsPVR9CgpjbC5kZiA8LSBkYXRhJGNsdXN0ZXJfYW5ub3RhdGlvbgpjbC5kZiA8LSBjbC5kZltjbC5kZiRjbGFzc19sYWJlbCAhPSAiTFEiLF0KCmNsLmRmIDwtIGNsLmRmICU+JSBtdXRhdGUoY2x1c3Rlcl9zaXplID0gYyhtdWx0aW9tZS5zaXplICsgdjIuc2l6ZSArIHYzLnNpemUpKQoKIyBhZGQgY29sb3JzIHRvIGNsdXN0ZXIgZGF0YSBmcmFtZQpjb2xvcnMkY2x1c3Rlcl9hbGlhcyA8LSBhcy5jaGFyYWN0ZXIoYXMuaW50ZWdlcihjb2xvcnMkY2x1c3Rlcl9hbGlhcykpCmNsLmRmIDwtIGNsLmRmICU+JSBsZWZ0X2pvaW4oY29sb3JzLCBieT1jKCJjbCI9ImNsdXN0ZXJfYWxpYXMiKSkKCnNlbGVjdC5jb2x1bW5zIDwtIGNvbG5hbWVzKGNsLmRmKVtncmVwKCJec3VwZXJ0eXBlIiwgY29sbmFtZXMoY2wuZGYpKV0Kc3QuZGYgPC0gY2wuZGYgJT4lIGdyb3VwX2J5X2F0KHNlbGVjdC5jb2x1bW5zKSAlPiUgc3VtbWFyaXNlKG49bigpKQoKc2VsZWN0LmNvbHVtbnMgPC0gY29sbmFtZXMoY2wuZGYpW2dyZXAoIl5zdWJjbGFzcyIsIGNvbG5hbWVzKGNsLmRmKSldCnNjLmRmIDwtIGNsLmRmICU+JSBncm91cF9ieV9hdChzZWxlY3QuY29sdW1ucykgJT4lIHN1bW1hcmlzZShuPW4oKSkKCnNlbGVjdC5jb2x1bW5zIDwtIGNvbG5hbWVzKGNsLmRmKVtncmVwKCJeY2xhc3MiLCBjb2xuYW1lcyhjbC5kZikpXQpjLmRmIDwtIGNsLmRmICU+JSBncm91cF9ieV9hdChzZWxlY3QuY29sdW1ucykgJT4lIHN1bW1hcmlzZShuPW4oKSkKCmBgYAoKCmBgYHtyLCBlY2hvPVQsIGV2YWw9VH0KZGV2dG9vbHM6OnNvdXJjZV9naXN0KCJodHRwczovL2dpc3QuZ2l0aHViLmNvbS9jdmFudmVsdC9lZjI5ZTE1ODFiMzBiOTc1OGVjMWJiYTFiODMyMjYxOSIpCmBgYAoKCgpgYGB7ciBjcmVhdGUgc3VuYnVyc3QuZGYsIGZpZy53aWR0aD0xMiwgZmlnLmhlaWdodD00LCBlY2hvPVR9CmNsLmRmIDwtIGNsLmRmW2NsLmRmJGNsYXNzX2lkICVpbiUgYygxOjcpLF0Kc3VuYnVyc3RERiA8LSBhcy5zdW5idXJzdERGKGNsLmRmLCAKICAgICAgICAgICAgICAgICAgICAgICAgICAgbGV2ZWxzPWMoImNsYXNzIiwic3ViY2xhc3MiLCJzdXBlcnR5cGUiKSwKICAgICAgICAgICAgICAgICAgICAgICAgICAgIHZhbHVlQ29sID0gImNsdXN0ZXJfc2l6ZSIsIAogICAgICAgICAgICAgICAgICAgICAgICAgICAgcm9vdG5hbWU9IldNQiIpCmBgYAoKYGBge3IgY3JlYXRlIHBsb3QsIGZpZy53aWR0aD0xMSwgZmlnLmhlaWdodD0yLCBldmFsPVQsIGVjaG89VH0KcCA8LSBwbG90X2x5KCkgJT4lCiAgICAgIGFkZF90cmFjZShpZHMgPSBzdW5idXJzdERGJGlkcywKICAgICAgICAgICAgICAgIGxhYmVscyA9IHN1bmJ1cnN0REYkbGFiZWxzLAogICAgICAgICAgICAgICAgcGFyZW50cyA9c3VuYnVyc3RERiRwYXJlbnQsCiAgICAgICAgICAgICAgICB2YWx1ZXMgPSBzdW5idXJzdERGJHZhbHVlcywKICAgICAgICAgICAgICAgIHR5cGUgPSAnc3VuYnVyc3QnLAogICAgICAgICAgICAgICAgc29ydD1GQUxTRSwKICAgICAgICAgICAgICAgIG1hcmtlciA9IGxpc3QoY29sb3JzID0gc3VuYnVyc3RERiRjb2xvciksCiAgICAgICAgICAgICAgICBkb21haW4gPSBsaXN0KGNvbHVtbiA9IDEpLAogICAgICAgICAgICAgICAgYnJhbmNodmFsdWVzID0gJ3RvdGFsJwogICAgICAgICAgICAgICAgKSU+JQogICAgICBsYXlvdXQoZ3JpZCA9IGxpc3QoY29sdW1ucyA9MSwgcm93cyA9IDEpLAogICAgICAgICAgICAgIG1hcmdpbiA9IGxpc3QobCA9IDAsIHIgPSAwLCBiID0gMCwgdCA9IDApCiAgICAgICkKCgoKYGBgCgpgYGB7ciBwbG90IHRyZWUsIGZpZy53aWR0aD02LCBmaWcuaGVpZ2h0PTYsZWNobz1UfQpwCmBgYAoKCg==