使用Shiny快速开发web程序

去年第一次接触Shiny时,由于其是基于R语言,用于开发交互式web应用,并且不需要HTML,CSS以及JS,所以当时非常有兴趣的学了一段时间,最终写了一个shiny app用于展示ComplexHeatmap包(其实就是用定义了几个插件用于调整做热图的参数),代码放在Github,然后就再也没用过了。。。

现在看来shiny一般的用途还是在于快速搭建,快速展示为主,比如我需要在较快的时间内做一个网页工具用于实现一个小功能,或者是用于展示我的一些数据的结果(可视化),或者用于测试一个模拟数据等等。如果是搭建一个完整的网页平台,那还是得用成熟的前端和后端联合,shiny还不能完全代替网页的全部功能,至少我是这么认为的

在这正好回顾下shiny的基本用法,顺便以一个例子来练练手,来展现如何用较短的代码来实现一个交互式网站

例子:用shiny以火山图的形式来展现差异表达数据,可调整不同的foldchange以及p.adj,同时用ggrepel包将差异gene ID标注在图上,最后提供图片下载。总之需要做以下几点:

  1. 导入数据(差异分析的文件,总共3列,第一列gene ID,第二列log2foldchange,第三列p.adj)
  2. 两个插件,用于控制log2foldchage和p.adj的值
  3. 展示两张图,一张常规的火山图,另一张标注有gene id的火山图
  4. 下载图片

shiny主要有两部分组成,ui.Rserver.R,前者用于开发前端UI界面,后者用于部署后端程序

ui.R

先加载包

library(shiny)
library(shinythemes)
library(dplyr)

如果使用常规的shiny界面的话,ui.R主要由fluidPage开始(这个类似于HTML里面的流动布局),里面又分成两部分sidebarPanelmainPanel,前者用于设定边框栏,后者用于设定展示框;但在设定这两个部分之前,可先选定主题和主标题

theme = shinytheme("readable")
titlePanel("A quick view of volcano plot")

接着设定导入文件插件,两个插件(log2foldchange和p.adj)以及一个用于更新参数值的插件

sidebarPanel(
    fileInput("filename", 
              "Choose File to Upload:", 
              accept = c(".csv")),
    hr(),
    numericInput("foldchange",
                 label = "Threshold of foldchage is:",
                 value = 1,
                 min = 0,
                 max = 5),
    numericInput("padj",
                 label = "Threshold of p.adj is:",
                 value = 2,
                 min = 0,
                 max = 100),
    hr(),
    submitButton("Update View")
)   

最后设定图片展示位置以及形式(以2个Tab展示2张图)

mainPanel(
    tabsetPanel(
      tabPanel("Tab 1",
               fluidRow(
                 column(width = 9,
                        plotOutput("sampleplot", height = 500)
                 ),
                 column(width = 2,
                        downloadButton("download_plot",label = "Download Volcano Plot")
                 )
               )),
      tabPanel("Tab 2",
               fluidRow(
                 column(width = 11,
                        plotOutput("signplot", height = 500)
                 )
               ))
    )
)

server.R

这部分主要是出图代码,用reactive函数用于跟UI中的input做交互,以及用renderPlot函数对应UI中的plotOutput函数,这部分可以看shiny的Cheat sheet,其他的注意点主要就是看代码了。这里还有点比较高级的用法,比如使用uiOutput()创建动态UI元素,用DT包来展示表格数据,增加进度条等等,这个都可以在后续需求中补充,这里只讲如何快速的展示数据,也就是说以最简单的方式

首先server.R中的所有代码都是写在下面的代码框里的

library(ggplot2)
library(ggrepel)
server <- function(input, output) {}

接着是读入数据的函数

filedata <- reactive({
    infile <- input$filename
    read.csv(infile$datapath,sep = ",", header = T, stringsAsFactors = F)
})

作图代码函数,这里不具体展示了,在最后一起放上所有代码

sample_plot <- function(){}

图片展示函数

output$sampleplot <- renderPlot({
  sample_plot()
})

提供图片下载函数

output$downloadplot <- downloadHandler(
    filename = function(){
      paste0("volcano", ".png")
    },
    contentType = "image/png",
    content = function(file){
      png(file)
      print(sample_plot())
      dev.off()
    }
)

如果是在Rstudio中先做测试的话,就将ui.R和server.R两个代码放在同一个R代码里面,然后用shinyApp函数运行,如:

shinyApp(ui = ui, server = server)

最后是完整的代码,大概140行代码就可以达到上述需求,非常的便捷。PS.代码的长度当然也跟网页以及后端数据处理的复杂性有关。可以多参考下别人的UI布局,尝试下shinyJS包来丰富插件,结合官网的一些实例,理解一些函数的用法,还可以用HTML/CSS来设计UI等等

library(shinythemes)
library(shiny)
library(dplyr)
library(ggplot2)
library(ggrepel)

ui <- fluidPage(
  # Choose a theme
  theme = shinytheme("readable"),

  # Application title
  titlePanel("A quick view of volcano plot"),

  # Sidebar for number of class outputs : 
  # Input file; Threshold of foldchange and p.adj
  sidebarPanel(
    #    textInput("txt", "Text input:", "text here"),
    fileInput("filename", 
              "Choose File to Upload:", 
              accept = c(".csv")),
    hr(),
    numericInput("foldchange",
                 label = "Threshold of foldchage is:",
                 value = 1,
                 min = 0,
                 max = 5),
    numericInput("padj",
                 label = "Threshold of p.adj is:",
                 value = 2,
                 min = 0,
                 max = 100),
    hr(),
    submitButton("Update View")
  ),

  #Tab1 for sample plot, Tab2 for lable plot
  mainPanel(
    tabsetPanel(
      tabPanel("Tab 1",
               fluidRow(
                 column(width = 9,
                        plotOutput("sampleplot", height = 500)
                 ),
                 column(width = 2,
                        downloadButton("download_plot",label = "Download Volcano Plot")
                 )
               )),
      tabPanel("Tab 2",
               fluidRow(
                 column(width = 11,
                        plotOutput("signplot", height = 500)
                 )
               ))
    )
  )
)

server <- function(input, output) {
  # file upload
  filedata <- reactive({
    infile <- input$filename
    if (is.null(infile)){
      return(NULL)
    }
    read.csv(infile$datapath,sep = ",", header = T, stringsAsFactors = F)
  })

  #function
  sample_plot <- function(){
    df <- filedata() %>% as.data.frame()
    names(df) <- c("geneid", "log2foldchage", "padj")
    df$padj <- -log10(df$padj)
    df$change <- as.factor(ifelse(df$padj > input$padj & abs(df$log2foldchage) > input$foldchange,
                                  ifelse(df$log2foldchage > input$foldchange,'UP','DOWN'),'NOT'))

    p <- ggplot(data = df, aes(x = log2foldchage, y = padj, color = change)) +
      geom_point(alpha=0.8, size = 1) +
      theme_bw(base_size = 15) +
      theme(
        panel.grid.minor = element_blank(),
        panel.grid.major = element_blank()) +
      scale_color_manual(name = "", values = c("red", "green", "black"), limits = c("UP", "DOWN", "NOT")) +
      geom_hline(yintercept = input$padj, linetype = "dashed", color = "grey", size = 1) +
      geom_vline(xintercept = -input$foldchange, linetype = "dashed", color = "grey", size = 1) +
      geom_vline(xintercept = input$foldchange, linetype = "dashed", color = "grey", size = 1)
    p
  }

  signed_plot <- function(){
    df <- filedata() %>% as.data.frame()
    names(df) <- c("geneid", "log2foldchage", "padj")
    df$padj <- -log10(df$padj)
    df$change <- as.factor(ifelse(df$padj > input$padj & abs(df$log2foldchage) > input$foldchange,
                                  ifelse(df$log2foldchage > input$foldchange,'UP','DOWN'),'NOT'))
    df$sign <- ifelse(df$padj > input$padj & abs(df$log2foldchage) > input$foldchange, df$geneid,NA)

    p <- ggplot(data = df, aes(x = log2foldchage, y = padj, color = change)) +
      geom_point(alpha=0.8, size = 1) +
      theme_bw(base_size = 15) +
      theme(
        panel.grid.minor = element_blank(),
        panel.grid.major = element_blank()) +
      scale_color_manual(name = "", values = c("red", "green", "black"), limits = c("UP", "DOWN", "NOT")) +
      geom_text_repel(aes(label = sign), box.padding = unit(0.2, "lines"), point.padding = unit(0.2, "lines"), show.legend = F, size = 3) +
      geom_hline(yintercept = input$padj, linetype = "dashed", color = "grey", size = 1) +
      geom_vline(xintercept = -input$foldchange, linetype = "dashed", color = "grey", size = 1) +
      geom_vline(xintercept = input$foldchange, linetype = "dashed", color = "grey", size = 1)
    p
  }

  #simple volcano plot
  output$sampleplot <- renderPlot({
    if (!is.null(filedata())){
      sample_plot()
    }
  })

  #signed volcano plot
  output$signplot <- renderPlot({
    if (!is.null(filedata())){
      signed_plot()
    }
  })

  #Download
  output$downloadplot <- downloadHandler(
    filename = function(){
      paste0("volcano", ".png")
    },
    contentType = "image/png",
    content = function(file){
      png(file)
      print(sample_plot())
      dev.off()
    }
  )
}

shinyApp(ui = ui, server = server)

本文出自于http://www.bioinfo-scrounger.com转载请注明出处