Last active
December 10, 2015 04:48
-
-
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")
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# 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())) | |
}) | |
}) | |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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