搜索
查看: 3132|回复: 4

使用shiny展示ComplexHeatmap做热图的部分功能

[复制链接]

29

主题

131

帖子

1208

积分

金牌会员

Rank: 6Rank: 6

积分
1208
发表于 2017-6-21 15:32:00 | 显示全部楼层 |阅读模式
本帖最后由 anlan 于 2017-6-21 15:36 编辑

Shiny是RStudio公司开发的一个R包,通过它可以用R语言开发交互式web应用。
Shiny包的特点在于不需要太了解网页语言(比如我就只看了一些html和CSS基础语法,反正看过也没记住多少),可以用纯R来搭建,生成的网页应用是动态交互的,而且是即时更新的。
前段时间在http://shiny.rstudio.com/articles/看了点关于shiny的基础语法,并且在http://www.biotrainee.com/thread-1563-1-1.html论坛上看到一篇使用shiny将一个热图R包做成一个交互式界面的文章,于是乎自己也写一个练练手。
Shiny程序主要分ui和server两部分:
  • Ui界面一般指的是交互界面,上面可以展示图片、输入参数以及一系列的按钮等美化工具
  • server一般指后台操作,通过函数将UI界面的输入通过一系列的过程转化为输出,最终呈现的UI界面上
以我的shiny程序为例,这个shiny app是将ComplexHeatmap这个做热图的R包的部分功能呈现出来,主要展示其做热图的一些参数。
Shiny程序我是放在https://www.shinyapps.io/,其是由RStudio开发的一个cloud,不需要自己有服务器就可以将shiny程序挂在上面。
然后我的程序的网址是https://anlan.shinyapps.io/complexheatmap/
代码有点长,整体上是一件比较简单的事情,就是写起代码来有时会比较繁琐 ,主要的就几处而已

如果使用下这个shiny,记得使用Normalized数据!

[AppleScript] 纯文本查看 复制代码
library(shiny)
library(shinydashboard)
library(ComplexHeatmap)
library(circlize)

ui <- dashboardPage(
  dashboardHeader(title = "ComplexHeatmap"),
  dashboardSidebar(
    fileInput("filename","Choose File to Upload:", accept = c(".csv")),
    sidebarMenu(
      menuItem("Quickly visualize", tabName = "quicklyplot"),
      menuItem("Complex visualize", tabName = "complexplot")
    )
  ),
  dashboardBody(
    tabItems(
      tabItem("quicklyplot",
              fluidRow(
                column(width = 9,
                       box(width = NULL,solidHeader = TRUE,
                           plotOutput("simpleplot", height = 500)
                       ),
                       fluidRow(
                         column(width = 6,
                                box(width = NULL, status = "info",
                                    title = "The gene list on the row",
                                    tableOutput("genelist") 
                                )
                         ),
                         column(width = 5, offset = 1,
                                box(width = NULL, status = "warning",
                                    downloadButton("downloadlist",label = "Download Gene List")    
                                )
                         )
                       )
                ),
                column(width = 3,
                       box(width = NULL,status = "warning",
                           numericInput("simpleheigh",label = "Graph heigh value",value = 3000),
                           numericInput("simplewidth",label = "Graph width value",value = 4000),
                           radioButtons("downlist",label = "Select the graph type",,choices = c("png","pdf")),
                           downloadButton("downloadsimple",label = "Download Heatmap")
                       )
                )
              )
      ),
      tabItem("complexplot",
              fluidRow(
                column(width = 8,
                       box(width = NULL,solidHeader = TRUE,
                           plotOutput("complexmap",height = 500)
                       ),
                       fluidRow(
                         column(width = 6,
                                box(width = NULL, status = "info",
                                    title = "The gene list on the row",
                                    tableOutput("complexgenelist")
                                )
                         ),
                         column(width = 5, offset = 1,
                                box(title = "Download",
                                    solidHeader = T, status = "info",
                                    width = NULL,
                                    h5("Choose height and width for heatmap"),
                                    fluidRow(
                                      column(width = 6,
                                             numericInput("complexheigh",label = "Graph heigh value",value = 3000)
                                      ),
                                      column(width = 6,
                                             numericInput("complexwidth",label = "Graph width value",value = 4000)
                                      ),
                                      column(width = 12,
                                             radioButtons("complextype",label = "Select the graph type",choices = c("png","pdf"))
                                      )
                                    )
                                ),
                                
                                box(width = NULL,status = "warning",
                                    downloadButton("downloadcomplexlist",label = "Download Gene List"),
                                    downloadButton("downloadcomplex",label = "Download Heatmap")
                                )
                         )
                       )
                ),
                
                # box(title = "Submit parameter",
                #     solidHeader = T,status = "info",
                #     width = 4,
                #     actionButton("datasubmit", label = "Submit"),
                #     tags$style("button#datasubmit {margin-left:auto;margin-right:auto;display:block; 
                #                        background-color:#00CCFF; padding: 5px 25px; font-family:Andika, Arial, sans-serif; 
                #                        font-size:1.5em; letter-spacing:0.05em; text-transform:uppercase;
                #                        color:white; text-shadow: 0px 1px 10px #000;border-radius: 15px;
                #                        box-shadow: rgba(0, 0, 0, .55) 0 1px 6px;}")
                #     ),
                
                box(title = "The parameter for complex heatmap",
                    solidHeader = T, status = "info",
                    collapsible = T, collapsed = F,
                    width = 4,
                    
                    fluidRow(
                      box(title = "Expression To Color Option",
                          solidHeader = T, status = "info",
                          width = 12,
                          h5("The left is expression value, the right is color"),
                          fluidRow(
                            column(width = 6,
                                   numericInput("lowvalue", label = "Low Value", value = NULL,-5,0)
                            ),
                            column(width = 6,
                                   selectInput("lowcol", label = "Low color", choices = c("green","blue", "purple", "red", 
                                                                                          "orange", "yellow", "white"),
                                               selected = "green")
                            ),
                            column(width = 6,
                                   numericInput("highvalue", label = "High Value", value = NULL,0,5)
                            ),
                            column(width = 6,
                                   selectInput("highcol", label = "High color", choices = c("red", "orange", "yellow", 
                                                                                            "green", "blue", "purple", "white"),
                                               selected = "red")
                            )
                          )
                      ),
                      
                      box(title = "Heatmap Name",
                          solidHeader = T, status = "info",
                          width = 12,
                          h5("Please choose the name option for heatmap"),
                          fluidRow(
                            column(width = 6,
                                   selectInput("requirename", label = "Legend or not", c("TRUE", "FALSE"))
                                   ),
                            column(width = 6,
                                   textInput("nametxt", label = "Legend Name", value = "expression")
                                   )
                          )
                      ),
                      
                      box(title = "Row Relative Option",
                          solidHeader = T, status = "info",
                          width = 12,
                          h5("Choose orientation for row name and the height for dend"),
                          fluidRow(
                            column(width = 6,
                                   selectInput("ori_rowname", label = "Select orientation for row name",
                                               c("right","left","none"))
                            ),
                            column(width = 6,
                                   numericInput("width_rowdend",label = "Select height for row dend",
                                                value = 4,1,10)
                            )
                          )
                      ),
                      
                      box(title = "column Relative Option",
                          solidHeader = T, status = "info",
                          width = 12,
                          h5("Choose orientation for column name and the height for dend"),
                          fluidRow(
                            column(width = 6,
                                   selectInput("ori_columnname", label = "Select orientation for column name",
                                               c("bottom","top","none"))
                            ),
                            column(width = 6,
                                   numericInput("height_columndend",label = "Select height for column dend",
                                                value = 2,1,10)
                            )
                          )                          
                      ),
                      
                      box(title = "Cluster Relative Option",
                          solidHeader = T, status = "info",
                          width = 12,
                          h5("Choose distance and algorithm to cluster"),
                          fluidRow(
                            column(width = 6,
                                   selectInput("distance", label = "Select distance to cluster",
                                               c("euclidean", "maximum", "manhattan", "canberra", "binary", "minkowski"))
                            ),
                            column(width = 6,
                                   selectInput("algorithm", label = "Select algorithm to cluster",
                                               c("complete", "single", "average", "centroid", "median"))
                            )
                          )
                      )
                    )
                )
              )
      )
    )
  )
)

server <- function(input, output, session){
  
  # file upload
  filedata <- reactive({
    infile <- input$filename
    if (is.null(infile)){
      return(NULL)
    }
    read.csv(infile$datapath,sep = ",", header = T, row.names = 1)
  })
  
  # choose the max and min number in filedata
  observe({
    if (is.null(filedata())){
      return(NULL)
    }else{
      df <- filedata()
      min_value <- round(min(df))
      max_value <- round(max(df))
      updateNumericInput(session, "lowvalue", value = min_value)
      updateNumericInput(session, "highvalue", value = max_value)
    }
  })
  
  # choose the fit width and height for heatmap
  observe({
    if (input$downlist == "pdf"){
      updateNumericInput(session, "simpleheigh", value = 30)
      updateNumericInput(session, "simplewidth", value = 6)
    }else{
      updateNumericInput(session, "simpleheigh", value = 3000)
      updateNumericInput(session, "simplewidth", value = 4000)
    }
  })

  observe({
    if (input$complextype == "pdf"){
      updateNumericInput(session, "complexheigh", value = 30)
      updateNumericInput(session, "complexwidth", value = 6)
    }else{
      updateNumericInput(session, "complexheigh", value = 3000)
      updateNumericInput(session, "complexwidth", value = 4000)
    }
  })  
  
  
  ##########################################simple heatmap#######################################
  # simple heatmap
  simpleHeatmap <- function(){
    df <- filedata()
    df <- as.data.frame(df)
    plotDataFrame(df,group_names = "Sample")
  }
  
  output$simpleplot <- renderPlot({
    if (!is.null(filedata()))
      simpleHeatmap()
  })
  
  output$genelist <- renderTable({
    if (!is.null(filedata())){
      p <- simpleHeatmap()
      df <- as.data.frame(filedata())
      list <- row.names(df)[row_order(p)[[1]]]
      head(list, 10)
    }
  })
  
  # simple heatmap download
  output$downloadsimple <- downloadHandler(
    filename <- function(){
      paste("cluster", input$downlist, sep = ".")
    },
    
    content <- function(file){
      if (input$downlist == "png")
        png(file)
      else
        pdf(file)
      simpleHeatmap()
      dev.off()
    }
  )
  
  
  
  # gene list download
  output$downloadlist <- downloadHandler(
    filename <- "gene_list.csv",
    content <- function(file){
      if (!is.null(filedata())){
        p <- simpleHeatmap()
        df <- as.data.frame(filedata())
        list <- row.names(df)[row_order(p)[[1]]]
        list <- as.data.frame(list)
        names(list) <- "gene_list"
        write.csv(list, file,row.names = FALSE,quote = FALSE)
      }
    }
  )
  
  ##########################################complex heatmap#######################################
  
  # prepare pre-data
  show_rowname <- reactive({
    rowname <- input$ori_rowname
    if (rowname == "none")
      return("FALSE")
    else
      return("TRUE")
  })
  
  show_columnname <- reactive({
    columnname <- input$ori_columnname
    if (columnname == "none")
      return("FALSE")
    else
      return("TRUE")
  })
  
  row_side <- reactive({
#    rowside <- input$ori_rowname
    if (input$ori_rowname == "none")
      return(NULL)
    else
      input$ori_rowname
  })
  
  column_side <- reactive({
    columnside <- input$ori_columnname
    if (columnside == "none")
      return(NULL)
    else
      input$ori_columnname
  })
  
  # complex heatmap
  complexheatmap <- function(){
    if (!is.na(input$lowvalue) & !is.na(input$highvalue)){
      df <- filedata()
      df <- as.data.frame(df)
      Heatmap(df,
              name = input$nametxt,
              show_heatmap_legend = input$requirename,
              show_row_names = show_rowname(),
              show_column_names = show_columnname(),
              row_names_side = row_side(),
              column_names_side = column_side(),
              col = colorRamp2(c(input$lowvalue, 0, input$highvalue), c(input$lowcol, "white", input$highcol)),
              row_dend_width = unit(input$width_rowdend, "cm"),
              column_dend_height = unit(input$height_columndend, "cm"),
              clustering_distance_rows = input$distance,
              clustering_distance_columns = input$distance,
              clustering_method_rows = input$algorithm
      ) 
    }
  }
  
  output$complexmap <- renderPlot({
    if (!is.null(filedata()))
      complexheatmap()
  })
  
  output$complexgenelist <- renderTable({
    if (!is.null(filedata())){
      if (!is.na(input$lowvalue) & !is.na(input$highvalue)){
        px <- complexheatmap()
        dfx <- as.data.frame(filedata())
        listx <- row.names(dfx)[row_order(px)[[1]]]
        head(listx, 10)
      }
    }
  })
  
  # complex heatmap download
  output$downloadcomplex <- downloadHandler(
    filename <- function(){
      paste("cluster", input$complextype, sep = ".")
    },
    
    content <- function(file){
      if (input$complextype == "png")
        png(file, width = input$complexwidth, height = input$complexheigh, units ="px", res = 300)
      else
        pdf(file, width = input$complexwidth, height = input$complexheigh)
      print(complexheatmap())
      dev.off()
    }

  )  
  
  
  # complex gene list download
  output$downloadcomplexlist <- downloadHandler(
    filename <- "gene_list.csv",
    content <- function(file){
      if (!is.null(filedata())){
        px <- complexheatmap()
        dfx <- as.data.frame(filedata())
        listx <- row.names(dfx)[row_order(px)[[1]]]
        listx <- as.data.frame(listx)
        names(listx) <- "gene_list"
        write.csv(listx, file,row.names = FALSE,quote = FALSE)
      }
    }
  )  
  
}

shinyApp(ui = ui, server = server)

代码如果觉得查看不方便,可以在github上看,https://github.com/kaigu1990/Shiny/tree/master/ComplexHeatmap
只要参考下别人的shiny代码,模仿下,一般就能形成一个简单的shiny的程序
DE(差异)分析可参考 https://github.com/yan-cri/DEApp

回复

使用道具 举报

64

主题

138

帖子

681

积分

管理员

Rank: 9Rank: 9Rank: 9

积分
681
发表于 2017-6-21 17:44:19 | 显示全部楼层
棒棒的
回复

使用道具 举报

634

主题

1182

帖子

4030

积分

管理员

Rank: 9Rank: 9Rank: 9

积分
4030
发表于 2017-6-21 23:13:15 | 显示全部楼层
你这个代码不是有一点点的长,而是非常非常长
你这个问题很复杂,需要打赏,请点击 http://www.bio-info-trainee.com/donate 进行打赏,谢谢
回复 支持 反对

使用道具 举报

29

主题

131

帖子

1208

积分

金牌会员

Rank: 6Rank: 6

积分
1208
 楼主| 发表于 2017-6-21 23:39:01 | 显示全部楼层
回复 支持 反对

使用道具 举报

29

主题

131

帖子

1208

积分

金牌会员

Rank: 6Rank: 6

积分
1208
 楼主| 发表于 2017-6-21 23:39:59 | 显示全部楼层
Jimmy 发表于 2017-6-21 23:13
你这个代码不是有一点点的长,而是非常非常长

参数设的比较多,但是都是写重复的代码
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|手机版|小黑屋|生信技能树 ( 粤ICP备15016384号  

GMT+8, 2019-8-19 08:22 , Processed in 0.035852 second(s), 29 queries .

Powered by Discuz! X3.2

© 2001-2013 Comsenz Inc.