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