gganatogram

Create anatogram images for different organisms.
This package uses the tissue coordinates from the figure in Expression Atlas. https://www.ebi.ac.uk/gxa/home
https://github.com/ebi-gene-expression-group/anatomogram

Install

Install from github using devtools.

shiny

I have now included a shiny app for gganatogram.
An online version can be found at shinapps.io.
https://jespermaag.shinyapps.io/gganatogram/
Unfortunately, there is a limit of 25h per month of app activity, so if you know R/Rstudio, please run it locally.
To run it locally, use the following command.

library(shiny)
runGitHub( "gganatogram", "jespermaag",  subdir = "shiny") 

Usage

This package requires ggplot2 and ggpolypath which loads when loading the package


library(gganatogram)
library(dplyr)
library(viridis)
library(gridExtra)
hgMale <- gganatogram(data=hgMale_key, fillOutline='#a6bddb', organism='human', sex='male', fill="colour") + theme_void()
hgFemale <- gganatogram(data=hgFemale_key, fillOutline='#a6bddb', organism='human', sex='female', fill="colour") + theme_void()
mmMale <- gganatogram(data=mmMale_key, fillOutline='#a6bddb', organism='mouse', sex='male', fill="colour") + theme_void()
mmFemale <- gganatogram(data=mmFemale_key, outline = T, fillOutline='#a6bddb', organism='mouse', sex='female', fill="colour")  +theme_void()  

grid.arrange(hgMale, hgFemale, mmMale, mmFemale, ncol=4)



hgMale <- gganatogram(data=hgMale_key, fillOutline='#440154FF', organism='human', sex='male', fill="value") + theme_void() +  scale_fill_viridis()
hgFemale <- gganatogram(data=hgFemale_key, fillOutline='#440154FF', organism='human', sex='female', fill="value") + theme_void() +  scale_fill_viridis()
mmMale <- gganatogram(data=mmMale_key, fillOutline='#440154FF', organism='mouse', sex='male', fill="value") + theme_void() +  scale_fill_viridis()
mmFemale <- gganatogram(data=mmFemale_key, outline = T, fillOutline='#440154FF', organism='mouse', sex='female', fill="value")  +theme_void()   +  scale_fill_viridis()

grid.arrange(hgMale, hgFemale, mmMale, mmFemale, ncol=2)

In order to use the function gganatogram, you need to have a data frame with organ, colour, and value if you want to.

organPlot <- data.frame(organ = c("heart", "leukocyte", "nerve", "brain", "liver", "stomach", "colon"), 
 type = c("circulation", "circulation",  "nervous system", "nervous system", "digestion", "digestion", "digestion"), 
 colour = c("red", "red", "purple", "purple", "orange", "orange", "orange"), 
 value = c(10, 5, 1, 8, 2, 5, 5), 
 stringsAsFactors=F)

 head(organPlot)
#>       organ           type colour value
#> 1     heart    circulation    red    10
#> 2 leukocyte    circulation    red     5
#> 3     nerve nervous system purple     1
#> 4     brain nervous system purple     8
#> 5     liver      digestion orange     2
#> 6   stomach      digestion orange     5

Using the function gganatogram with the filling the organs based on colour.

gganatogram(data=organPlot, fillOutline='#a6bddb', organism='human', sex='male', fill="colour")

Of course, we can use the ggplot themes and functions to adjust the plots

gganatogram(data=organPlot, fillOutline='#a6bddb', organism='human', sex='male', fill="colour") + 
theme_void()

We can also plot all tissues available using hgMale_key

We can also skip plotting the outline of the graph

organPlot %>%
    dplyr::filter(type %in% c('circulation', 'nervous system')) %>%
gganatogram(outline=F, fillOutline='#a6bddb', organism='human', sex='male', fill="colour") + 
theme_void()

We can fill the tissues based on the values given to each organ

gganatogram(data=organPlot, fillOutline='#a6bddb', organism='human', sex='male', fill="value") + 
theme_void() +
scale_fill_gradient(low = "white", high = "red")

We can also use facet_wrap to compare groups. First create add two data frames together with different values and the conditions in the type column

compareGroups <- rbind(data.frame(organ = c("heart", "leukocyte", "nerve", "brain", "liver", "stomach", "colon"), 
  colour = c("red", "red", "purple", "purple", "orange", "orange", "orange"), 
 value = c(10, 5, 1, 8, 2, 5, 5), 
 type = rep('Normal', 7), 
 stringsAsFactors=F),
 data.frame(organ = c("heart", "leukocyte", "nerve", "brain", "liver", "stomach", "colon"), 
  colour = c("red", "red", "purple", "purple", "orange", "orange", "orange"), 
 value = c(5, 5, 10, 8, 2, 5, 5), 
 type = rep('Cancer', 7), 
 stringsAsFactors=F))
gganatogram(data=compareGroups, fillOutline='#a6bddb', organism='human', sex='male', fill="value") + 
theme_void() +
facet_wrap(~type) +
scale_fill_gradient(low = "white", high = "red") 

You can also split the tissues into types while retaining the outline

gganatogram(data=hgMale_key, outline = T, fillOutline='#a6bddb', organism='human', sex='male', fill="colour") +
facet_wrap(~type, ncol=4) +
theme_void()

Added female option

All female tissues

You can also split the tissues into types while retaining the outline

gganatogram(data=hgFemale_key, outline = T, fillOutline='#a6bddb', organism='human', sex='female', fill="colour") +
facet_wrap(~type, ncol=4) +
theme_void()

To display the female reproductive system with outline.

hgFemale_key %>%
    dplyr::filter(type=='reproductive') %>%
    gganatogram( outline = T, fillOutline='#a6bddb', organism='human', sex='female', fill="colour")  +
    theme_void()  +
    coord_cartesian(xlim = c(30, 75), ylim = c(-110, -80))

Cellular structures

I have now included cellular substructures, using the cell.svg from the Protein Atlas. If you use the main cell figure (hopefully more will be added), please cite Thul PJ et al. 2017

The cellular data can be access using cell_key

To plot the whole cell with colours or values, use the following command. If you want to specify a background colour, you either have to remove the cytosol or change the colour of cytosol to the desired colour.

gganatogram(data=cell_key[['cell']], outline = T, fillOutline='steelblue', organism="cell", fill="colour")  +theme_void()   + coord_fixed()



gganatogram(data=cell_key[['cell']], outline = T, fillOutline='lightgray', organism="cell", fill="value")  +theme_void() +  coord_fixed() +  scale_fill_viridis()

To see all the subsstructures individually, you can plot the data one at a time

figureList <- list()
for (i in 1:nrow(cell_key[['cell']])) {
    figureList[[i]] <- gganatogram(data=cell_key[['cell']][i,], outline = T, fillOutline='steelblue', organism="cell", fill="colour")  +theme_void() +ggtitle(cell_key[['cell']][i,]$organ) + theme(plot.title = element_text(hjust=0.5, size=16)) + coord_fixed()
}

do.call(grid.arrange,  c(figureList[1:4], ncol=2))


do.call(grid.arrange,  c(figureList[5:8], ncol=2))


do.call(grid.arrange,  c(figureList[9:12], ncol=2))


do.call(grid.arrange,  c(figureList[13:16], ncol=2))


do.call(grid.arrange,  c(figureList[17:20], ncol=2))


do.call(grid.arrange,  c(figureList[21:24], ncol=2))

Other organisms i.e. tier 2 organisms

Expression atlas contains other organisms than human and mice, however, these are not as well anotated.
All the expression atlas anatograms can be found here https://ebi-gene-expression-group.github.io/anatomogram/
Unfortunately, I won’t be able to add other organs to these since I’m neither an anatomist nor artist.
If anyone would like to add more organs, I would love for you to contribute.

To create these plots, I have added two other objects other_key and other_list.
These are lists within lists, and to plot all the organs from an organisms use other_key[[“organism”]] as data, and “organism” as organism.
Also, the organ names are so far a mix of UBERON and plant ids.

To plot bos_taurus use the following command. Unfortunately, I have not managed to add the correct names yet.

Here is a way to loop through all the other organisms and plot their organs.

library(gridExtra)
plotList <- list()
for (organism in names(other_key)) {
    plotList[[organism]] <- gganatogram(data=other_key[[organism]], outline = T, fillOutline='white', organism=organism, sex='female', fill="colour")  +
                theme_void() +
                ggtitle(organism) + 
                theme(plot.title = element_text(hjust=0.5, size=9)) + 
                coord_fixed()
}

do.call(grid.arrange,  c(plotList[1:4], ncol=2))


do.call(grid.arrange,  c(plotList[5:8], ncol=2))


do.call(grid.arrange,  c(plotList[9:12], ncol=2))


do.call(grid.arrange,  c(plotList[13:16], ncol=2))


do.call(grid.arrange,  c(plotList[17:20], ncol=2))


do.call(grid.arrange,  c(plotList[21:24], ncol=2))