Skip to content

Instantly share code, notes, and snippets.

@arraytools arraytools/server.R
Last active Dec 10, 2015

Embed
What would you like to do?
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
You can’t perform that action at this time.