Skip to content

Instantly share code, notes, and snippets.

@arraytools
Last active December 10, 2015 04:48
  • 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/4383351 to your computer and use it in GitHub Desktop.
heatmap using leukemia data (22282 genes, 58 arrays). Assume 'shiny' package is available. We can run shiny:::runGist("https://gist.github.com/4383351")
# shiny:::runApp("hello")
#
# To-Do-List:
# missing value case
#
library(shiny)
# library(gplots) # Just for redgreen() function. Will be replaced sol.
source(url("http://dl.dropbox.com/u/1014272/heatmapr.r"))
source(url("http://dl.dropbox.com/u/1014272/colorpanel.r"))
load(url("http://dl.dropbox.com/u/1014272/lr2_Leukemia.rda")) # 22282 genes, not standardized
# cl <- scan("lr2_3groupcl.txt", "") # For color side bar only
sigma <- apply(lr2, 1, sd); sigma <- sigma/max(sigma)
# Define server logic required to generate and plot a random distribution
shinyServer(function(input, output) {
output$summary <- reactiveTable(function() {
genedist <- seq(0, 1, .1)
out <- cbind(genedist,
sapply(genedist, function(x) sum(sigma >= x)))
out <- data.frame(out)
colnames(out) <- c("sigma/max(sigma)", "# of genes")
rownames(out) <- 1:length(genedist)
out
})
datainput <- reactive(function() {
indgene <- which(sigma >= input$ratio)
lr <- lr2[indgene, ]
if (input$beforeafter == "before") {
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
}
} 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)
})
dstfun <- reactive(function() {
switch(input$distm,
euclidean = dist,
correlation = function(x) as.dist(1-cor(t(x))))
})
colfun <- reactive(function() {
switch(input$coltm,
greenred = greenred(75),
bluered = bluered(75))
})
output$myPlot <- reactivePlot(function() {
scale2 <- ifelse(input$beforeafter == "before", "none", input$normm)
heatmap.mod(datainput(), col=colfun(), hclustfun = hcfun(), distfun = dstfun(),
# ColSideColors=rainbow(3)[as.factor(cl)],
density.info="density", scale = scale2,
key=TRUE, symkey=FALSE, trace="none", margins=c(10,10),
lhei = c(4*input$lhei, 4), lwid = c(4*input$lwid, 4),
main = list(paste(nrow(datainput()), "genes"), cex=1.5, col="blue", font=4))
#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$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() {
head(data.frame(datainput()))
})
})
library(shiny)
# Define UI for application that plots random distributions
shinyUI(pageWithSidebar(
# Application title
headerPanel("Shiny heatmap (Leukemia dataset)"),
# Sidebar with a slider input for number of observations
sidebarPanel(
p(strong("Old versions of Internet Explorer will not work! Copy and paste the address to Chrome or Firefox")),
br(),
sliderInput("ratio",
"Filter by Variance (sigma/max(sigma)): NOTE: move the slider to LHS will increase calculation time.",
min = 0,
max = 1,
value = .9, step = 0.01),
br(),
selectInput("linkm", "Linkage method:",
c("Average linkage" = "average",
"Complete/Maximum linkage" = "complete",
"Single/Minimum linkage" = "single")),
br(),
selectInput("distm", "Distance method:",
choices = c("Euclidean" = "euclidean",
"Pearson Correlation" = "correlation")),
br(),
radioButtons("beforeafter", "Center and scale data by each row before/after clustering:",
c("Before" = "before",
"After" = "after"), selected = "After"),
br(),
radioButtons("normm", "Center and scale option:",
c("None" = "none",
"Mean=0" = "demean",
"Mean=0,Var=1" = "standardize",
"Median=0" = "demedian",
"Median=0,Var=1" = "mdstandardize"),
selected = "Mean=0,Var=1"),
br(),
selectInput("coltm", "Color preference:",
c("Green to Red" = "greenred",
"Blue to Red" = "bluered"),
selected = "Blue to Red"),
br(),
sliderInput("lhei",
"Height of dendrogram of arrays",
min = 0.1,
max = 1,
value = 1.5/4, step = 0.025),
br(),
sliderInput("lwid",
"Height of dendrogram of genes",
min = 0.1,
max = 1,
value = 1/4, step = 0.025)
#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("sigma vs # of genes", tableOutput("summary")),
tabPanel("Heatmap", plotOutput("myPlot", 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