在R闪亮会话期间保存值

时间：2018-06-16 00:43:07

标签： r shiny

我有一个单细胞基因x细胞表达数据，我想用shiny app进行探索。细胞来自样本，并根据先前的聚类运行进行聚类。

这是一个玩具示例数据集：

suppressPackageStartupMessages(library(dplyr))
suppressPackageStartupMessages(library(plotly))
suppressPackageStartupMessages(library(shiny))
set.seed(1)
mat <- matrix(rnorm(1000*1000),nrow=1000,dimnames = list(paste0("gene",1:1000),paste0("cell",1:1000)))
meta.df <- data.frame(cell=colnames(mat),
                      sample=sample(paste0("sample",1:10),1000,replace=T),
                      cluster=sample(paste0("cluster",1:5),200,replace=T),
                      stringsAsFactors = F)

我想启用两个功能：

  1. 查看整个数据的tSNE 2D嵌入，允许选择tSNE 2D嵌入scatter plot中的点的基因将通过其表达值着色。

  2. 能够选择一组特定的基因和群集和/或将重新运行tSNE的样本，并再次查看此2D嵌入，根据所选基因的表达水平对点进行着色（在在这种情况下，显然选择选项被子集化为所选基因之一。）

    3. 这是tSNE嵌入所有数据：

    all.data.tsne.df <- data.frame(Rtsne::Rtsne(t(mat))$Y) %>%
  rename(tSNE1=X1,tSNE2=X2) %>% cbind(meta.df)

    对于第二个功能，因为人们可能希望使用相同的tSNE嵌入对许多基因进行颜色编码，并且由于Rtsne运行可能需要一段时间才能运行，我想我会保存任何基因和细胞子集tSNE嵌入在由所选基因和细胞命名的列表中，并且在运行Rtsne之前始终检查该子集是否已存在。

    因此，在shiny代码的顶部，我创建了用于对样本和群集进行子集化的选项以及一个空的tSNE list：

    samples <- c("all",unique(meta.df$sample))
samples.choices <- 1:length(samples)
names(samples.choices) <- samples
clusters <- c("all",unique(meta.df$cluster))
clusters.choices <- 1:length(clusters)
names(clusters.choices) <- clusters
color.vec <- c("lightgray","darkred")
subset.tsne.map <- NULL

    这是我的server代码：

    server <- function(input, output)
{
  chosen.samples <- reactive({
    validate(
      need(input$samples.choice != "",'Please choose at least one of the sample checkboxes')
    )
    samples.choice <- input$samples.choice
    if("all" %in% samples.choice) samples.choice <- samples[-which(samples == "all")]
    samples.choice
  })

  chosen.clusters <- reactive({
    validate(
      need(input$clusters.choice != "",'Please choose at least one of the cluster checkboxes')
    )
    clusters.choice <- input$clusters.choice
    if("all" %in% clusters.choice) clusters.choice <- clusters[-which(clusters == "all")]
    clusters.choice
  })

  output$gene <- renderUI({
    if(input$plotType == "Gene-Subset tSNE"){
      selectInput("gene", "Color by Gene", choices = unique(input$subset.genes))
    } else{
      selectInput("gene", "Color by Gene", choices = rownames(mat))
    }
  })

  scatter.plot <- reactive({
    if(!is.null(input$gene)){
      row.idx <- which(rownames(mat) == input$gene)
      col.idx <- which(colnames(mat) %in% filter(meta.df,cluster %in% chosen.clusters(),sample %in% chosen.samples())$cell)
      #col.idx <- which(colnames(mat) %in% filter(meta.df,cluster %in% "cluster4",sample %in% unique(meta.df$sample))$cell)
      if(input$plotType != "Gene-Subset tSNE"){
        # subset of data
        gene.tsne.df <- left_join(all.data.tsne.df %>% filter(cluster %in% chosen.clusters(),sample %in% chosen.samples()),data.frame(cell=colnames(mat)[col.idx],value=mat[row.idx,col.idx]),by=c("cell"="cell"))
        scatter.plot <- plot_ly(marker=list(size=6),type='scatter',mode="markers",color=~gene.tsne.df$value,x=~gene.tsne.df$tSNE1,y=~gene.tsne.df$tSNE2,showlegend=F,colors=colorRamp(color.vec)) %>%
          layout(xaxis=list(title="tSNE1",zeroline=F,showticklabels=F),yaxis=list(title="tSNE2",zeroline=F,showticklabels=F)) %>%
          colorbar(limits=c(min(gene.tsne.df$value,na.rm=T),max(gene.tsne.df$value,na.rm=T)),len=0.4,title="Expression")
        break
      } else{
        subset.genes <- sort(unique(input$subset.genes))
        subset.row.idx <- which(rownames(mat) %in% subset.genes)
        if(!is.null(subset.tsne.map)){
          idx <- which(names(subset.tsne.map) == paste0(paste(subset.row.idx,collapse="_"),":",paste(col.idx,collapse="_")))
          if(length(idx) > 0){
            subset.tsne.df <- subset.tsne.map[[idx]] %>% mutate(value=mat[row.idx,col.idx])
            scatter.plot <- plot_ly(marker=list(size=6),type='scatter',mode="markers",color=~subset.tsne.df$value,x=~subset.tsne.df$tSNE1,y=~subset.tsne.df$tSNE2,showlegend=F,colors=colorRamp(color.vec)) %>%
              layout(xaxis=list(title="tSNE1",zeroline=F,showticklabels=F),yaxis=list(title="tSNE2",zeroline=F,showticklabels=F)) %>%
              colorbar(limits=c(min(subset.tsne.df$value,na.rm=T),max(subset.tsne.df$value,na.rm=T)),len=0.4,title="Expression")
          }
        } else{
          subset.tsne.df <- data.frame(t(mat[subset.row.idx,col.idx]),cell=colnames(mat)[col.idx]) %>% left_join(meta.df %>% filter(cell %in% colnames(mat)[col.idx]) %>% select(cell,cluster),by=c("cell"="cell"))
          tsne.perplexity <- 10*length(subset.row.idx)
          while(tsne.perplexity >= 1){
            set.seed(1)
            tsne.obj <- try(Rtsne::Rtsne(subset.tsne.df %>% select(-cell,-cluster),perplexity=tsne.perplexity),silent=T)
            if(class(tsne.obj)[1] != "try-error"){
              subset.tsne.df <- cbind(subset.tsne.df,data.frame(tsne.obj$Y) %>% rename(tSNE1=X1,tSNE2=X2))
              subset.tsne.map[[length(subset.tsne.map)+1]] <- subset.tsne.df
              names(subset.tsne.map)[length(subset.tsne.map)] <- paste0(paste(subset.row.idx,collapse="_"),":",paste(col.idx,collapse="_"))
              subset.tsne.df <- subset.tsne.df %>% mutate(value=mat[row.idx,col.idx])
              scatter.plot <- plot_ly(marker=list(size=6),type='scatter',mode="markers",color=~subset.tsne.df$value,x=~subset.tsne.df$tSNE1,y=~subset.tsne.df$tSNE2,showlegend=F,colors=colorRamp(color.vec)) %>%
                layout(xaxis=list(title="tSNE1",zeroline=F,showticklabels=F),yaxis=list(title="tSNE2",zeroline=F,showticklabels=F)) %>%
                colorbar(limits=c(min(subset.tsne.df$value,na.rm=T),max(subset.tsne.df$value,na.rm=T)),len=0.4,title="Expression")
            } else{
              tsne.perplexity <- tsne.perplexity-2
            }
          }
        }
      }
      scatter.plot
    }
  })

  output$Embedding <- renderPlotly({
    scatter.plot()
  })

  output$save <- downloadHandler(
    filename = function() {
      paste0("../shiny/",input$gene,".",input$plotType,".pdf")
    },
    content = function(file) {
      plotly::export(scatter.plot(),file=file)
    }
  )
}

    这是我的UI代码：

    ui <- fluidPage(

  # App title ----
  titlePanel("Results Explorer"),

  # Sidebar layout with a input and output definitions ----
  sidebarLayout(
    # Sidebar panel for inputs ----
    sidebarPanel(

      ## custom CSS for 3 column layout (used below for mechanics filter options)
      tags$head(
        tags$style(HTML(".multicol {-webkit-column-count: 3; /* Chrome, Safari, Opera */-moz-column-count: 3; /* Firefox */column-count: 3;}"))),
      ## use the css, assuming your long list of vars comes from global.R
      wellPanel(tags$div(class="multicol",checkboxGroupInput("samples.choice", "Samples",choices = names(samples.choices),selected="all"))),
      wellPanel(tags$div(class="multicol",checkboxGroupInput("clusters.choice", "Clusters",choices = names(clusters.choices),selected="all"))),

      # select plot type
      selectInput("plotType", "Plot Type", choices = c("tSNE","Gene-Subset tSNE")),

      #in case Gene Subset tSNE was chose select the genes
      conditionalPanel(condition="input.plotType=='Gene-Subset tSNE'",
                       selectizeInput(inputId="subset.genes",label="Subset Genes for tSNE",choices=rownames(mat),selected=rownames(mat)[1],multiple=T)),

      # select gene
      uiOutput("gene"),

      # save plot as html
      downloadButton('save', 'Save as PDF')
    ),

    # Main panel for displaying outputs ----
    mainPanel(
      # The plot is called Embedding and will be created in ShinyServer part
      plotlyOutput("Embedding")
    )
  )
)


shinyApp(ui = ui, server = server)

    它似乎没有更新subset.tsne.map和所选择的每个基因，即使对于相同的细胞和基因组，它也会再次运行Rtsne。

    是否可以使用之前选择的子集更新subset.tsne.map？如果是这样，我是否正确地做到了？

0 个答案:

没有答案
相关问题
最新问题