Shiny_oncoprint

App.R

library(ComplexHeatmap)
library(cgdsr)
library(shiny)

mycgds = CGDS("http://www.cbioportal.org/")

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectizeInput(inputId = "mutGene", label = h4("Gene(s)"), choices = c("EGFR", "PTEN", "TP53", "ATRX"), multiple = TRUE,
                     options = list(placeholder = "Enter gene(s), eg: EGFR PTEN TP53 ATRX", plugins = list('remove_button'))),
      checkboxInput(inputId = "add_cna", label = "Add copy number alterations", value = FALSE)
    ),
    mainPanel(
      tableOutput(outputId = "oncomatrix"),
      plotOutput(outputId = "oncoprint")
    )
  )
)

server <- function(input, output) {
  #' Get the data
  mutData <- reactive({
    # Download mutation data from the cbio portal
    mut_df <- getProfileData(mycgds, caseList ="gbm_tcga_sequenced", geneticProfile = "gbm_tcga_mutations", genes = input$mutGene)
    mut_df <- apply(mut_df,2,as.factor)
    mut_df[mut_df == "NaN"] = ""
    mut_df[is.na(mut_df)] = ""
    mut_df[mut_df != ''] = "MUT"
    mat <- as.matrix(t(mut_df))
    if(input$add_cna){
      # Download copy number data from the cbio portal
      cna <- getProfileData(mycgds, caseList ="gbm_tcga_sequenced", geneticProfile = "gbm_tcga_gistic", genes = input$mutGene)
      cna <- apply(cna,2,function(x)as.character(factor(x, levels = c(-2:2), 
                                                        labels = c("HOMDEL", "HETLOSS", "DIPLOID", "GAIN", "AMP"))))
      cna[is.na(cna)] = ""
      cna[cna == 'DIPLOID'] = ""
      # Paste together mutation and copy number data. I could not find another way to do it
      comb <- data.frame(matrix(paste(as.matrix(cna),as.matrix(mut_df),sep=";"),nrow=nrow(cna), ncol=ncol(cna),
                                dimnames =list(row.names(mut_df), colnames(cna))))
      mat <- as.matrix(t(comb))
    }
    mat
  })
  
  output$oncomatrix <- renderTable({
    if(is.null(input$mutGene) || length(input$mutGene)<2) return()
    mat <- mutData()
    mat[,1:10]
  })
  
  #' Oncoprint
  output$oncoprint <- renderPlot({
    if(is.null(input$mutGene)) return()
    mat <- mutData()
    # Get the alteration type from the matrix
    alt <- apply(mat,1,function(x)strsplit(x, ";"))
    alt <- unique(unlist(alt))
    alt <- alt[which(alt !="")]
    alt <- c("background",alt)
    alter_fun_list = list(
      background = function(x, y, w, h) {
        grid.rect(x, y, w-unit(0.5, "mm"), h-unit(0.5, "mm"), gp = gpar(fill = "#CCCCCC", col = NA))
      },
      HOMDEL = function(x, y, w, h) {
        grid.rect(x, y, w-unit(0.5, "mm"), h-unit(0.5, "mm"), gp = gpar(fill = "blue3", col = NA))
      },
      HETLOSS = function(x, y, w, h) {
        grid.rect(x, y, w-unit(0.5, "mm"), h-unit(0.5, "mm"), gp = gpar(fill = "cadetblue1", col = NA))
      },
      GAIN = function(x, y, w, h) {
        grid.rect(x, y, w-unit(0.5, "mm"), h-unit(0.5, "mm"), gp = gpar(fill = "pink", col = NA))
      },
      AMP = function(x, y, w, h) {
        grid.rect(x, y, w-unit(0.5, "mm"), h-unit(0.5, "mm"), gp = gpar(fill = "red", col = NA))
      },
      MUT = function(x, y, w, h) {
        grid.rect(x, y, w-unit(0.5, "mm"), h*0.33, gp = gpar(fill = "#008000", col = NA))
      }
    )
    col <- c("MUT" = "#008000", "AMP" = "red", "HOMDEL" = "blue3","HETLOSS" = "cadetblue1", "GAIN"= "pink")
    # select the alteration from the alter_fun_list
    alt = intersect(names(alter_fun_list), alt)
    alt_fun_list <- alter_fun_list[alt]
    # select the colors
    col <- col[alt]
    oncoPrint(mat = mat, alter_fun_list = alt_fun_list, 
              get_type = function(x) strsplit(x, ";")[[1]],
              col = col)
  })
}

shinyApp(ui = ui, server = server)