r - 将 R shiny checkboxGroupInput 与其他输入选择相结合

Question

我有这些数据 我想使用 R shiny scatter plot > 服务器:

library(dplyr)
library(permute)
set.seed(1)

meta.df <- data.frame(gene_id=paste0("id",1:10),symbol=paste0("n",rep(permute::shuffle(5),2)),stringsAsFactors=F)
clusters.df <- data.frame(cell=paste0("c",1:100),cluster=rep(permute::shuffle(10),10),sample=paste0("s",rep(permute::shuffle(5),20)),stringsAsFactors=F)
mat <- matrix(rnorm(10*100),10,100,dimnames=list(meta.df$gene_id,clusters.df$cell))
tsne.obj <- Rtsne::Rtsne(t(mat))
tsne.df <- as.data.frame(tsne.obj$Y) %>% dplyr::rename(tSNE1=V1,tSNE2=V2) %>% cbind(clusters.df)
samples <- c("all",unique(clusters.df$sample))
samples.choices <- 1:length(samples)
names(samples.choices) <- samples

因为我希望能够选择一个特定的 meta.df$symbol，它在 meta.df$gene_id 中是多余的，所以每个都有一个选择列表，其中第二个以第一个为条件。

由于数据由多个 sample 组成，我希望能够以 react 方式通过 sample 对数据进行子集化，因此我有一个示例选择 checkbox，使用 "all" 选项选择所有 sample(只是因为它比选中所有框更容易)。

这是我的 Shiny 代码:

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

  output$gene_id <- renderUI({
    selectInput("gene_id", "Gene ID", choices = unique(dplyr::filter(meta.df,symbol == input$symbol)$gene_id))
  })

  scatter.plot <- reactive({
    if(!is.null(input$symbol) & !is.null(input$gene_id)){
      # subset of data
      gene.symbol <- input$symbol
      gene.id <- input$gene_id
      row.idx <- which(rownames(mat) == gene.id)
      col.idx <- which(colnames(mat) %in% dplyr::filter(clusters.df,sample %in% chosen.samples())$cell)
      gene.df <- suppressWarnings(dplyr::left_join(tsne.df %>% dplyr::filter(sample %in% chosen.samples()),data.frame(cell=colnames(mat)[col.idx],value=mat[row.idx,col.idx],stringsAsFactors=F),by=c("cell"="cell")))
      scatter.plot <- plotly::plot_ly(marker=list(size=12),type='scatter',mode="markers",color=~gene.df$value,x=~gene.df$tSNE1,y=~gene.df$tSNE2,showlegend=F) %>%
        plotly::layout(xaxis=list(title="tSNE1",zeroline=F,showticklabels=F),yaxis=list(title="tSNE2",zeroline=F,showticklabels=F))
      scatter.plot
    }
  })

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

  output$save <- downloadHandler(
    filename = function() {
      paste0(dplyr::filter(meta.df,symbol == input$symbol,gene_id == input$gene_id)$symbol,"_",dplyr::filter(meta.df,symbol == input$symbol,gene_id == input$gene_id)$gene_id,".pdf")
    },
    content = function(file) {
      plotly::export(scatter.plot(),file=file)
    }
  )
}

ui <- fluidPage(

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

  # Sidebar layout with a input and output definitions ----
  sidebarLayout(

    # Sidebar panel for inputs ----
    sidebarPanel(

      # select samples
      checkboxGroupInput("samples.choice", "Samples",choices = samples.choices,selected=1),

      # select gene symbol
      selectInput("symbol", "Gene Symbol", choices = unique(meta.df$symbol)),

      # select gene id
      uiOutput("gene_id"),

      # select plot type
      selectInput("plot.type", "Plot Type", choices = c("tSNE","PCA")),

      # 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
      plotOutput("Embedding")
    )
  )
)

shinyApp(ui = ui, server = server)

问题是它似乎并没有真正选择 sample，因此显示的图没有任何点。

如果我简单地通过替换来消除 sample 的选择 code，它会起作用:

col.idx <- which(colnames(mat) %in% dplyr::filter(clusters.df,sample %in% chosen.samples())$cell)
gene.df <- suppressWarnings(dplyr::left_join(tsne.df %>% dplyr::filter(sample %in% chosen.samples()),data.frame(cell=colnames(mat)[col.idx],value=mat[row.idx,col.idx],stringsAsFactors=F),by=c("cell"="cell")))

与:

col.idx <- which(colnames(mat) %in% dplyr::filter(clusters.df,sample %in% samples[2:3])$cell)
gene.df <- dplyr::left_join(tsne.df %>% dplyr::filter(sample %in% samples[2:3]),data.frame(cell=colnames(mat)[col.idx],value=mat[row.idx,col.idx],stringsAsFactors=F),by=c("cell"="cell"))

我在 this example 中看到了整个数据在 dat_reac reactive block 中被子集化。我希望简单地将 sample 设置为子集 by 就足够了。知道为什么它不起作用以及如何让它正确吗？

Answer 1

您的代码中有两个错误。第一个在checkboxGroupInput

代替

checkboxGroupInput("samples.choice", "Samples",choices = samples.choices,selected=1)

应该是

checkboxGroupInput("samples.choice", "Samples",choices = names(samples.choices),selected="all")

第二个是scatter.plot()是plotly object因此你应该使用 plotly::plotlyOutput("Embedding")和 output$Embedding <- plotly::renderPlotly({
scatter.plot()
})

这里是经过上述修改的代码应该可以工作:

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

  output$gene_id <- renderUI({
    selectInput("gene_id", "Gene ID", choices = unique(dplyr::filter(meta.df,symbol == input$symbol)$gene_id))
  })

  scatter.plot <- reactive({

    if(!is.null(input$symbol) & !is.null(input$gene_id)){
      # subset of data
      gene.symbol <- input$symbol
      gene.id <- input$gene_id
      row.idx <- which(rownames(mat) == gene.id)
      col.idx <- which(colnames(mat) %in% dplyr::filter(clusters.df,sample %in% chosen.samples())$cell)
      gene.df <- suppressWarnings(dplyr::left_join(tsne.df %>% dplyr::filter(sample %in% chosen.samples()),data.frame(cell=colnames(mat)[col.idx],value=mat[row.idx,col.idx],stringsAsFactors=F),by=c("cell"="cell")))

      scatter.plot <- plotly::plot_ly(marker=list(size=12),type='scatter',mode="markers",color=~gene.df$value,x=~gene.df$tSNE1,y=~gene.df$tSNE2,showlegend=F) %>%
        plotly::layout(xaxis=list(title="tSNE1",zeroline=F,showticklabels=F),yaxis=list(title="tSNE2",zeroline=F,showticklabels=F))
      scatter.plot
    }
  })

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

  output$save <- downloadHandler(
    filename = function() {
      paste0(dplyr::filter(meta.df,symbol == input$symbol,gene_id == input$gene_id)$symbol,"_",dplyr::filter(meta.df,symbol == input$symbol,gene_id == input$gene_id)$gene_id,".pdf")
    },
    content = function(file) {
      plotly::export(scatter.plot(),file=file)
    }
  )
}

ui <- fluidPage(

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

  # Sidebar layout with a input and output definitions ----
  sidebarLayout(

    # Sidebar panel for inputs ----
    sidebarPanel(

      # select samples
      checkboxGroupInput("samples.choice", "Samples",choices = names(samples.choices),selected="all"),

      # select gene symbol
      selectInput("symbol", "Gene Symbol", choices = unique(meta.df$symbol)),

      # select gene id
      uiOutput("gene_id"),

      # select plot type
      selectInput("plot.type", "Plot Type", choices = c("tSNE","PCA")),

      # 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
      # plotOutput("Embedding")
      plotly::plotlyOutput("Embedding")
    )
  )
)

shinyApp(ui = ui, server = server)

希望对您有所帮助!