select 基於復選框選擇並顯示熱圖的 Rshiny 中 data.frame 的多列

Question

大家好，

我是 Rshiny 的新手，一直在玩用戶反應元素。 我正在嘗試創建一個基本上以 data.frame 作為輸入的熱圖 - 用戶可以在其中 select 要顯示的行數和列數。 特別是如果用戶 select 有一個復選框選項，則會選擇一些列（如果未選中復選框，則取消選擇）。

我的示例代碼如下所示 - 它采用 99 個元素（用於行）的 TSV 輸入文件，並具有 20 列值。 我提供了增加減少行的選項，如 slider 和 5 個復選框 - 表示“col_group_xx”，這樣每個復選框選擇一組 4 列 - 從熱圖中添加或刪除這些列。 即“col_group_1”將 select 或取消選擇前 4 列，“col_group_2”用於第 5 到 8 列，依此類推。

我的行 slider 有效，熱圖適當地減少或增加行，但我似乎無法弄清楚如何將復選框連接到 select 每組列 -

它返回此錯誤 -

Warning: Error in [.data.frame: undefined columns selected
  [No stack trace available]

在此處下載示例 TSV 輸入文件 - https://github.com/sid5427/downloader/raw/master/example_matrix_for_heatmap.txt

github 代碼鏈接以便於下載 - https://github.com/sid5427/downloader/raw/master/cleaned_variable_heatmap_eg.ZE1E1D3D40573127E36EE0480CAF1

我的代碼如下 -

library(d3heatmap)
library(RColorBrewer)
library(shiny)
library(shinythemes)
library(reprex)
library(dplyr)


data<-read.csv("example_matrix_for_heatmap.txt", header=TRUE, row.names = 1, sep="\t")
rownames(data)
nrow(data)
dim(data)

new_data_matrix <- data.frame(rownames(data))

colnames <- c("col_group_1","col_group_2","col_group_3","col_group_4","col_group_5")

####ui####
ui<-fluidPage(
  titlePanel("example_heatmap"), 
  theme=shinytheme("cerulean"),

  sidebarPanel(
    sliderInput("obs",
                "Number of observations:",
                min = 1,
                max = nrow(data),
                value = nrow(data)),
    tableOutput("values"),

    #group of checkboxes
    checkboxGroupInput("checkGroup", 
                       label = h3("columns to select"),
                       choices = colnames,
                       selected = colnames)
  ),

  mainPanel(
    d3heatmapOutput("heatmap", 
                    height="1200px", width="80%")
  ),


  fluidRow(column(3, verbatimTextOutput("value")))
)

####server####
server <- function(input, output) 
{
  output$value <- renderPrint({ input$checkGroup })

  observeEvent(input$checkGroup,{
    if("col_group_1" %in% input$checkGroup){
      print("col_group_1") ##debuging
      new_data_matrix <- cbind(new_data_matrix,data[,1:4])
    }
    if("col_group_2" %in% input$checkGroup ){
      print("col_group_2") ##debuging
      new_data_matrix <- cbind(new_data_matrix,data[,5:8])
    }
    if("col_group_3" %in% input$checkGroup ){
      print("col_group_3") ##debuging
      new_data_matrix <- cbind(new_data_matrix,data[,9:12])
    }
    if("col_group_4" %in% input$checkGroup ){
      print("col_group_4") ##debuging
      new_data_matrix <- cbind(new_data_matrix,data[,13:16])
    }
    if("col_group_5" %in% input$checkGroup ){
      print("col_group_5") ##debuging
      new_data_matrix <- cbind(new_data_matrix,data[,17:20])
    }
    dim(new_data_matrix) ##debuging
  })

  output$heatmap <- renderD3heatmap({
    d3heatmap(new_data_matrix[1:input$obs,2:ncol(new_data_matrix)],
              col=brewer.pal(9,"Reds"),
              scale="none")}
  )
}

shinyApp(ui, server)

任何幫助，將不勝感激！ 另外，如果有更有效的方法通過 dplyr 執行此操作，我也將不勝感激！

Answer 1

同意@r2evans 的建議，您可以使用reactive塊。 您可以設置兩個塊（一個用於 select 列，一個用於根據這些選定的列對數據進行子集化）。

在下面的示例中，我只使用一個reactive塊來根據觀察和列進行子集化。 此外，擁有一個將組與特定范圍的列（在本例中col_group ）相關聯的簡單表可能更容易。 這可以根據您的需要進行修改，並且可能具有一定的靈活性。

reactive塊將確定要使用的列范圍。 使用Map function，您可以將所有字段放在一個向量中以用於子集數據。

還在renderD3heatmap中添加了validate ，這將確保您至少檢查了一組，並且根據您的輸入 slider，您至少有 2 個觀察值。

library(d3heatmap)
library(RColorBrewer)
library(shiny)
library(shinythemes)
library(reprex)
library(dplyr)

data<-read.csv("example_matrix_for_heatmap.txt", header=TRUE, row.names = 1, sep="\t")

col_group <- data.frame(
  group = c("col_group_1","col_group_2","col_group_3","col_group_4","col_group_5"),
  min_col = c(1, 5, 9, 13, 17),
  max_col = c(4, 8, 12, 16, 20)
)

####ui####
ui<-fluidPage(
  titlePanel("example_heatmap"), 
  theme=shinytheme("cerulean"),

  sidebarPanel(
    sliderInput("obs",
                "Number of observations:",
                min = 1,
                max = nrow(data),
                value = nrow(data)),
    tableOutput("values"),

    #group of checkboxes
    checkboxGroupInput("checkGroup", 
                       label = h3("columns to select"),
                       choices = col_group[, "group"],
                       selected = col_group[, "group"])
  ),

  mainPanel(
    d3heatmapOutput("heatmap", 
                    height="1200px", width="80%")
  ),


  fluidRow(column(3, verbatimTextOutput("value")))
)

####server####
server <- function(input, output) 
{
  new_data_matrix <- reactive({
    col_ranges <- col_group %>% 
      filter(group %in% input$checkGroup)

    all_cols <- unlist(Map(`:`, col_ranges$min_col, col_ranges$max_col))

    data[1:input$obs, all_cols]
  })

  output$heatmap <- renderD3heatmap({
    validate(
      need(input$checkGroup, 'Check at least one group!'),
      need(input$obs >= 2, 'Need at least 2 groups to cluster!')
    )
    d3heatmap(new_data_matrix(),
              col=brewer.pal(9,"Reds"),
              scale="none")
  })
}

shinyApp(ui, server)