Skip to content

Instantly share code, notes, and snippets.

@arraytools
Last active December 10, 2015 04:38
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save arraytools/4382774 to your computer and use it in GitHub Desktop.
Interactive heatmap using sequential data. Note the Google Chrome browser works fine, and Firefox may or may not. The Microsoft IE does not work at all.
library(shiny)
library(gplots) # Just for redgreen() function. Will be replaced sol.
lr2 <- as.matrix(read.delim("toy.txt", header = TRUE)) # 3 genes, 20 arrays, sequential data.
sigma <- apply(lr2, 1, sd); sigma <- sigma/max(sigma)
# Define server logic required to generate and plot a random distribution
shinyServer(function(input, output) {
datainput <- reactive(function() {
indgene <- which(sigma >= input$ratio)
lr <- lr2[indgene, ]
if (input$normm == "standardize") {
t(scale(t(lr)))
} else if (input$normm == "demean") {
sweep(lr, 1, apply(lr, 1, mean))
} else if (input$normm == "standardize") {
lr
} else if (input$normm == "demedian") {
sweep(lr, 1, apply(lr, 1, median))
} else if (input$normm == "mdstandardize") {
lr <- sweep(lr, 1, apply(lr, 1, median))
t(scale(t(lr), FALSE, TRUE))
} else {
lr
}
})
hclust1 <- function(x) hclust(x, method="average")
hclust2 <- function(x) hclust(x, method="complete")
hclust3 <- function(x) hclust(x, method="single")
hcfun <- reactive(function() {
switch(input$linkm,
average = hclust1,
complete = hclust2,
single = hclust3)
})
colfun <- reactive(function() {
switch(input$coltm,
greenred = greenred(75),
bluered = bluered(75))
})
output$myPlot <- reactivePlot(function() {
heatmap.2(datainput(), col=colfun(), hclustfun = hcfun(),
# ColSideColors=rainbow(3)[as.factor(cl)],
# density.info="none",
key=TRUE, symkey=FALSE, trace="none", margins=c(10,10), scale = "none")
title(main = list(paste(nrow(datainput()), "genes"), cex=1.5, col="blue", font=4))
#plot(0,0, type="n"); text(0,0, as.character(input$normm))
})
#output$Boxplotg <- reactivePlot(function() {
# par(las=1, mar=c(5,10,0,2)+.1)
# boxplot(as.data.frame(t(datainput())), horizontal = TRUE, col = "bisque")
#})
output$Boxplots <- reactivePlot(function() {
par(las=1, mar=c(5,10,0,2)+.1)
boxplot(as.data.frame(datainput()), horizontal = TRUE, col = "bisque")
})
output$tableData <- reactiveTable(function() {
data.frame(datainput()[1:min(10, nrow(datainput())), 1:min(5, ncol(datainput()))])
})
})
g1 g2 g3 g4 g5 g6 g7 g8 g9 g10 g11 g12 g13 g14 g15 g16 g17 g18 g19 g20
-3to3 -3 -2.68421052631579 -2.36842105263158 -2.05263157894737 -1.73684210526316 -1.42105263157895 -1.10526315789474 -0.789473684210527 -0.473684210526316 -0.157894736842105 0.157894736842105 0.473684210526315 0.789473684210526 1.10526315789474 1.42105263157895 1.73684210526316 2.05263157894737 2.36842105263158 2.68421052631579 3
-2to2 -2 -1.78947368421053 -1.57894736842105 -1.36842105263158 -1.15789473684211 -0.947368421052632 -0.736842105263158 -0.526315789473684 -0.315789473684211 -0.105263157894737 0.105263157894737 0.315789473684211 0.526315789473684 0.736842105263158 0.947368421052631 1.15789473684211 1.36842105263158 1.57894736842105 1.78947368421053 2
-1to1 -1 -0.894736842105263 -0.789473684210526 -0.684210526315789 -0.578947368421053 -0.473684210526316 -0.368421052631579 -0.263157894736842 -0.157894736842105 -0.0526315789473685 0.0526315789473684 0.157894736842105 0.263157894736842 0.368421052631579 0.473684210526316 0.578947368421053 0.684210526315789 0.789473684210526 0.894736842105263 1
library(shiny)
# Define UI for application that plots random distributions
shinyUI(pageWithSidebar(
# Application title
headerPanel("Shiny heatmap of a sequential data"),
# Sidebar with a slider input for number of observations
sidebarPanel(
sliderInput("ratio",
"Filter by Variance (sigma/sigma_max):",
min = 0,
max = 1,
value = .1, step = 0.01),
br(),
radioButtons("normm", "Normalization method:",
c("None" = "none",
"Mean=0" = "demean",
"Mean=0,Var=1" = "standardize",
"Median=0" = "demedian",
"Median=0,Var=1" = "mdstandardize"),
selected = "None"),
br(),
radioButtons("linkm", "Linkage method:",
c("Average linkage" = "average",
"Complete/Maximum linkage" = "complete",
"Single/Minimum linkage" = "single")),
br(),
radioButtons("distm", "Distance method (Only implemented Euclidean):",
c("Euclidean" = "elcu",
"1-Correlation" = "corr")),
br(),
radioButtons("coltm", "Color preference:",
c("Green to Red" = "greenred",
"Blue to Red" = "bluered"),
selected = "Blue to Red")
#tags$hr(),
#fileInput('file1', 'Choose tab-delimited data file containing header',
# accept=c('text/csv', 'text/comma-separated-values,text/plain'))
),
# Show a plot of the generated distribution
mainPanel(
tabsetPanel(
tabPanel("Heatmap", plotOutput("myPlot", height="800px")),
# tabPanel("Boxplot for genes", plotOutput("Boxplotg", height="800px")),
tabPanel("Boxplot for samples", plotOutput("Boxplots", height="800px")),
tabPanel("Data preview", tableOutput("tableData"))
)
# plotOutput("myPlot", height="800px")
)
))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment