ggplot2

gganatogram

Maag J. L. V. (2018). gganatogram: An R package for modular visualisation of anatograms and tissues based on ggplot2. F1000Research, 7, 1576. https://doi.org/10.12688/f1000research.16409.2
Reference (BibTex)
citation("gganatogram")
#>   @Article{,
#>     title = {gganatogram:  An R package for modular visualisation of anatograms and tissues based on ggplot2},
#>     author = {Jesper Maag},
#>     journal = {f1000research},
#>     year = {2018},
#>     note = {Version 1: Awaiting peer review},
#>     url = {https://f1000research.com/articles/7-1576/v1},
#>   }

 

devtools::install_github("jespermaag/gganatogram")
library(shiny)
runGitHub( "gganatogram", "jespermaag",  subdir = "shiny") 
library(gganatogram)
library(dplyr)
library(viridis)
library(gridExtra)
gganatogram(data=organPlot, fillOutline='#a6bddb', organism='human', sex='male', fill="colour")
gganatogram-merged
# install.packages("remotes")
# remotes::install_github("jespermaag/gganatogram")
library(gganatogram)

gganatogram(data = hgMale_key,
            organism = "human", sex = "male",
            fill = "colour", fillOutline = "#a6bddb") +
  coord_cartesian(xlim = c(30, 75), ylim = c(-40, 0)) +
  theme_void()
# install.packages("remotes")
# remotes::install_github("jespermaag/gganatogram")
library(gganatogram)
# install.packages("dplyr")
library(dplyr)

hgMale_key %>%
  filter(organ %in% c("brain", "heart")) %>%
  gganatogram(organism = "human", sex = "male",
              fill = "colour") +
  theme_void() + 
  coord_fixed()

Interactive Shiny App: https://neuropsy.shinyapps.io/chris/

Shiny App source code
list.of.packages <- c("shiny", "DT", "colourpicker", "viridis", "RColorBrewer", "shinyWidgets", "rhandsontable")
new.packages <- list.of.packages[!(list.of.packages %in% installed.packages()[,"Package"])]
if(length(new.packages)) {
  install.packages(new.packages, repos='http://cran.us.r-project.org')
}
if (! "gganatogram" %in% installed.packages()[,"Package"]){
  devtools::install_github("jespermaag/gganatogram")
}


library(shiny)
library(gganatogram)
library(DT)
library(colourpicker)
library(viridis)
library(RColorBrewer)
library(shinyWidgets)
library(rhandsontable)
# Define server logic required to draw a histogram
shinyServer(function(input, output) {
   
  output$Species <- renderUI({
  
    allSpecies <- c("human_male", "human_female", "mouse_male", "mouse_female", "cell", names(other_key))
    selectInput("SpeciesInput", "Species",
                choices=allSpecies,
                selected=allSpecies[1])
  })
  
  
  output$fill <- renderUI({
    if (is.null(anat_key())) {
      return(NULL)
    }
    selectInput("fillInput", "Fill based on colour or value. Both colour and value can be changed in the table",
                c("colour", "value"),
                selected = c("value"))
  })
  
  

  anat_key <- reactive({
    if (is.null(input$SpeciesInput)) {
      return(NULL)
    }
    selectedSpecies <- input$SpeciesInput
    if (selectedSpecies == "human_male" ) {
      hgMale_key
    } else if (selectedSpecies =="human_female" ) {
      hgFemale_key
    } else if (selectedSpecies=="mouse_male" ) {
      mmMale_key
    } else if (selectedSpecies=="mouse_female" ) {
      mmFemale_key
    } else if (selectedSpecies =="cell" ) {
      cell_key[["cell"]]
    } else {
      other_key[[selectedSpecies]]
    }
  
  })
  
  output$Organs <- renderUI({
    if (is.null(anat_key())) {
      return(NULL)
    }
    organs <- anat_key()$organ
    pickerInput("OrgansInput","Organs - Select before changing value", choices = organs, selected = organs, options = list(`actions-box` = TRUE),multiple = T)
  })
  
  output$valueColour <- renderUI({
    colourOptions <- c('viridis', 'magma', 'inferno', 'plasma', 'cividis', rownames(brewer.pal.info[brewer.pal.info$category != 'qual',]))
    #"magma" (or "A"), "inferno" (or "B"), "plasma" (or "C"), "viridis" (or "D", the default option) and "cividis" (or "E").
    selectInput("colourValue", "Value colour",
                choices=colourOptions,
                selected='viridis')

  })
    
   
  organism <- reactive({
    if (is.null(anat_key())) {
      return(NULL)
    }
    selectedSpecies <- input$SpeciesInput
    if (selectedSpecies == "human_male" | selectedSpecies == "human_female"  ) {
      "human"
    } else if (selectedSpecies=="mouse_male" | selectedSpecies=="mouse_female"  ) {
      "mouse"
    } else if (selectedSpecies =="cell" ) {
      "cell"
    } else {
      selectedSpecies
    }
    
  })
  
  
  
  sex <- reactive({
    if (is.null(anat_key())) {
      return(NULL)
    }
    selectedSpecies <- input$SpeciesInput
    if (selectedSpecies == "human_male" | selectedSpecies == "mouse_male"  ) {
      "male"
    } else if (selectedSpecies=="mouse_female" | selectedSpecies=="human_female"  ) {
      "female"
    } else {
      "female"
    }
    
  })
  
  Reactive_key <- reactiveValues(data = NULL)
  Reactive_key$data <-reactive({ 
    if (is.null(anat_key())) {
      return(NULL)
    }
    anat_key()})


  
  output$mytable2 <- renderRHandsontable({
    if (is.null(anat_key())) {
      return(NULL)
    }
    #print(class())
    
    
    organTable <- Reactive_key$data()
    organTable <- organTable[organTable$organ %in% input$OrgansInput,]

    rhandsontable(organTable)
  
  })
  
  reactive({
    reactiveTemp <- Reactive_key$data()
    plotAnat <- hot_to_r(input$mytable2)
    reactiveTemp$value[match(plotAnat$organ, reactiveTemp$organ)] <- plotAnat$value
   # head( Reactive_key$data()[match(plotAnat$organ, Reactive_key$data()$organ),])
    print(head( reactiveTemp$organ))
    print(class(plotAnat))
    Reactive_key$data <- reactiveTemp
      })
  
  
  output$gganatogram <- renderPlot({
    if (is.null(anat_key()) | is.null(input$mytable2)) {
      return(NULL)
    }
    
    
    plotAnat <- hot_to_r(input$mytable2)
    if (length(input$OrgansInput)<1) {
      p <- gganatogram(fillOutline= input$col, outline=input$showOutline, organism=organism(), sex=sex(), fill=input$fillInput) +theme_void() + coord_fixed() + ggtitle(input$ggtitle) +   theme(plot.title = element_text(hjust = 0.5))
    } else {
      plotOrgans <- plotAnat
      plotOrgans <- plotOrgans[plotOrgans$organ %in% input$OrgansInput, ]
      p <- gganatogram(plotOrgans, outline=input$showOutline, fillOutline= input$col, organism=organism(), sex=sex(), fill=input$fillInput) +theme_void() + coord_fixed() +ggtitle(input$ggtitle) +  theme(plot.title = element_text(hjust = 0.5))
  
    }
    if (input$reverseId ) {
      Palettedirection = 1
    } else {
      Palettedirection = -1
    }
    
    if ( input$fillInput == "value" ) {
      if ( input$colourValue %in% c('viridis', 'magma', 'inferno', 'plasma', 'cividis') ) {
        p <- p + scale_fill_viridis(option = input$colourValue, direction= Palettedirection)
      } else {
        p <- p + scale_fill_distiller(palette = input$colourValue, direction = Palettedirection)
      }
    }
    
  p
  })
  
  output$plot.ui <- renderUI({
    if (is.null(input$height) ) {
      ggheight <-100
    } else {
      ggheight <- input$height
    }

      
    plotOutput("gganatogram", height = paste0(ggheight, "cm"))
  })
  #END
})

Cellular substructures based on: Thul, P. J., Åkesson, L., Wiking, M., Mahdessian, D., Geladaki, A., Ait Blal, H., Alm, T., Asplund, A., Björk, L., Breckels, L. M., Bäckström, A., Danielsson, F., Fagerberg, L., Fall, J., Gatto, L., Gnann, C., Hober, S., Hjelmare, M., Johansson, F., Lee, S., … Lundberg, E. (2017). A subcellular map of the human proteome. Science, 356(6340), eaal3321. https://doi.org/10.1126/science.aal3321

microtubules-merged
library(gganatogram)
library(dplyr)
library(viridis)
library(gridExtra)

length(cell_key)
#> [1] 1
cell_key
#> $cell
#> organ type colour value
#> 1 cytosol other steelblue 2.07159434
#> 4 intermediate_filaments other #984EA3 14.89497057
#> 6 actin_filaments other #FFFF33 5.87440944
#> 8 focal_adhesion_sites other #F781BF 8.12483660
#> 10 microtubule_organizing_center other #66C2A5 8.67564889
#> 12 centrosome other #8DA0CB 1.02852838
#> 13 microtubules other #E78AC3 9.48882657
#> 16 microtubule_ends other #E5C494 4.80457195
#> 18 secreted_proteins other #8DD3C7 9.20191105
#> 20 lipid_droplets other #BEBADA 3.48903574
#> 22 lysosomes other #80B1D3 3.73790434
#> 24 peroxisomes other #B3DE69 6.79465458
#> 26 endosomes other #D9D9D9 13.48636296
#> 28 endoplasmic_reticulum other #CCEBC5 11.36654344
#> 30 golgi_apparatus other #7FC97F 11.29225961
#> 32 nucleoplasm other #FDC086 2.07964782
#> 34 nuclear_membrane other #386CB0 7.98595837
#> 36 nuclear_bodies other #BF5B17 0.05868359
#> 38 nuclear_speckles other #1B9E77 0.61672243
#> 40 nucleoli other #7570B3 14.96900579
#> 42 nucleoli_fibrillar_center other #66A61E 8.72324527
#> 44 rods_and_rings other #A6761D 9.53194209
#> 46 mitochondria other #A6CEE3 1.29396698
#> 48 plasma_membrane other #B2DF8A 13.45657571

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()

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))

Create anatograms using ggplot2
https://github.com/jespermaag/gganatogram
51 forks.
384 stars.
16 open issues.

Recent commits:
Top Skip to content