vendredi 15 novembre 2019

select multiple columns from data.frame in Rshiny based upon checkbox selection and display heatmap

Good day all,

I am new to Rshiny and been playing around with user reactive elements. I am trying to create a heatmap that essentially takes a data.frame as input - where the user can select the number of rows and columns to be displayed. Particularly if a user select a checkbox option, a number of columns would be selected (or deselected if checkbox is not selected).

My example code looks like this - it takes a TSV input file of 99 elements (for rows), and has 20 columns of values. I give the option to increase decrease rows as a slider, and 5 checkboxes - denoting "col_group_xx", such that each checkbox selects a group of 4 columns - adding or removing those columns from the heatmap. i.e. "col_group_1" would select or deselect the first 4 columns, "col_group_2" for columns 5 to 8, and so on.

My row slider works and the heatmap appropriately reduces or increases rows, but I can't seem to figure out how to connect the checkboxes to select each group of columns -

It returns this error -

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

download sample TSV input file here - https://github.com/sid5427/downloader/raw/master/example_matrix_for_heatmap.txt

github link to code for easy download - https://github.com/sid5427/downloader/raw/master/cleaned_variable_heatmap_eg.R

my code is as follows -

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)

Any help would be appreciated! Plus if there is a more efficient way of doing this via dplyr I would appreciate that as well!




Aucun commentaire:

Enregistrer un commentaire