I've built a great heatmap.2 in R but I am trying to remove the column names at the bottom of the heatmap because they are illegible. I am not able to delete the column names.
I've tried doing labCol = NULL and nothing seems to happen. Additionally, colCol = "white" also doesn't work. Any suggestions?
data<-read.csv("Symptoms Only.csv",row.names=1)
data$Subject_type<-gsub("0","Contact",data$Subject_type)
data$Subject_type<-gsub("1","Survivor",data$Subject_type)
data$Gender<-gsub("0","Male",data$Gender)
data$Gender<-gsub("1","Female",data$Gender)
condition_colors <- unlist(lapply(data$Subject_type,function(x){
if(grepl('Contact',x)) '#FFC0CB'
else if(grepl('Survivor',x)) '#808080'
}))
condition_colors
colnames(data)
data<-data[-c(1:3)]
colnames(data)
data<-t(data)
data<-as.matrix(data)
x<-data
z <- heat.clust(x,
scaledim="column",
zlim=c(-3,3),
zlim_select = c("dend","outdata"),
reorder=c("column","row"),
distfun = function(x) as.dist(1-cor(t(x))),
hclustfun= function(x) hclust(x, method="ward.D"),
scalefun = scale)
heatmap.2(z$data,
Rowv=z$Rowv,
Colv=z$Colv,
trace="none",
scale="none",
symbreaks = TRUE,
srtCol=90,
adjCol=c(0.8,1),
key=FALSE,
dendrogram = "both",
lhei=c(1,5),
cexRow = 1.1,
margins=c(4,7),
labCol = NULL,
xlab="complete",
ColSideColors = condition_colors,
col=rev(colorRampPalette(brewer.pal(10, "RdBu"))(256)),
)```
The image is base R plot, so setting xaxt="n" will remove column names. You would set the column names to empty strings, but maybe not so advisable.
library(gplots)
data(mtcars)
# correct solution
heatmap.2(x,xaxt="n")
# not so good
colnames(x) = rep("",ncol(x))
heatmap.2(x)
Related
I am working with corrplot and following example here Plotting multiple corrplots (R) in the same graph I can display multiple corrplots(R) in the same graph. However I would like to save to a tiff file and because I working with loop I don't know how to achieve this. See code below.
I loop through several block of my experiments (Block1, block2) and plot the corrplot one next to another. This works. I don't understand how to direct to tiff file. In particular where to put
tiff(file = 'Figure4Plots.tiff', width = 12, height = 12, units = "in", res = 300) and dev.off() I tried after dflist and several others but does not work Thanks!
dflist<-c('Block1', 'Block2')
par(mfrow=c(2,2))
for (i in seq_along(dflist)) {
#Subset different Blocks
dataCorr<- subset(total , (block == dflist[i] ))
p.mat <- cor.mtest(dataCorr)
M<-cor(dataCorr)
col <- colorRampPalette(c("#BB4444", "#EE9988", "#FFFFFF", "#77AADD", "#4477AA"))
corrplot(M, method="color", col=col(200),
type="upper", title = title,
addCoef.col = "black", # Add coefficient of correlation
tl.col="red", tl.srt=45, #Text label color and rotation
# Combine with significance
p.mat = p.mat, sig.level = 0.05, insig = "blank",
diag=TRUE,
mar=c(0,0,1,0) )}
I don't have your original data, and I'm not familiar with the corrplot package, so I've made some dummy data and used just a simple plot() function. Unless there's something particular about the corrplot() function, you should be able to enclose most of your code in a tiff() block, like this:
dflist <- c('Block1', 'Block2', 'Block3', 'Block4')
total <- data.frame(block=sample(dflist, size=100, replace=TRUE), x=runif(100), y=runif(100)*2)
tiff(file = 'Figure4Plots.tiff', width = 12, height = 12, units = "cm", res = 72)
par(mfrow=c(2,2))
for (thisBlock in dflist) {
#Subset different Blocks
dataCorr <- subset(total , (block == thisBlock ))
dataCorr <- dataCorr[, c('x', 'y')]
plot(dataCorr)
}
dev.off()
This code produces Figure4Plots.tiff:
I have the following scripts:
library("gplots")
mydata <- mtcars
mydata.nr <- nrow(mydata)
mydata.newval <- data.frame(row.names=rownames(mydata),new.val=-log(runif(mydata.nr)))
# Functions
hclustfunc <- function(x) hclust(x, method="complete")
distfunc <- function(x) dist(x,method="euclidean")
# Set colors
hmcols <- rev(redgreen(256));
# Plot the scaled data
heatmap.2(as.matrix(mydata),dendrogram="row",scale="row",col=hmcols,trace="none", margin=c(8,9), hclust=hclustfunc,distfun=distfunc);
Which generate the following heatmap:
Now given a new data.frame which contain new values for each cars:
mydata.nr <- nrow(mydata)
mydata.newval <- data.frame(row.names=rownames(mydata),new.val=-log(runif(mydata.nr)))
I want to create a single column heatmap with gradient gray positioned next to row names.
How can I achieve that in R heatmap.2?
Does this do what you want? You can use the RowSideColors option to add a column to the side of the heatmap.
new.vals = mydata.newval[,1]
mydata.newval$scaled = ( new.vals - min(new.vals) ) /
( max(new.vals) - min(new.vals) )
mydata.newval$gray = gray( mydata.newval$scaled )
heatmap.2( as.matrix(mydata),
dendrogram = "row", scale = "row",
col = hmcols, trace = "none",
margin = c(8,9),
hclust = hclustfunc, distfun = distfunc,
RowSideColors=mydata.newval$gray )
If you want the gray column in between the heatmap and the labels, there isn't a simple
way to do that with heatmap.2; I don't think it was designed for
such purposes. One way to hack it together would be to make the gray values
go from 10 to 11 (or something out of the range of the rest of the data). Then
you would change the colors mapped to the breaks (see here). However, this
would make your key look pretty funky.
# heatmap.2 does the clustering BEFORE the scaling.
# Clustering after scaling might give different results
# heatmap.2 also reorders the dendrogram according to rowMeans.
# (Code copied directly from the heatmap.2 function)
x = as.matrix(mydata)
Rowv = rowMeans(x, na.rm = TRUE)
hcr = hclustfunc(distfunc(x))
ddr = as.dendrogram(hcr)
ddr = reorder(ddr, Rowv) # the row dendrogram
# Scale the data as heatmap.2 does
rm = rowMeans(x, na.rm = TRUE)
x = sweep(x, 1, rm)
sx = apply(x, 1, sd, na.rm = TRUE)
x = sweep(x, 1, sx, "/")
# add the new data as a column
new.vals = mydata.newval[,1]
new.vals.scaled = ( new.vals - min(new.vals) ) /
( max(new.vals) - min(new.vals) ) # scaled from 0 to 1
x = cbind( x, gray = max(x) + new.vals.scaled + 0.1 )
# make the custom breaks and colors
edge = max(abs(x-1.1))
breaks = seq(-edge,edge+1.1,length.out=1000)
gradient1 = greenred( sum( breaks[-length(breaks)] <= edge ) )
gradient2 = colorpanel( sum( breaks[-length(breaks)] > edge ), "white", "black" )
hm.colors = c(gradient1,gradient2)
hm = heatmap.2( x, col=hm.colors, breaks=breaks,
scale="none",
dendrogram="row", Rowv=ddr,
trace="none", margins=c(8,9) )
Although this hack works, I would look for a more robust solution using more flexible packages that play with different viewports using the grid package.
I'm using heatmap to plot the leader for each of the respective pitching performance categories for some baseball data. My problem is that I need to reverse the "heat" of just one of the columns, because the best ERA is the lowest, not the highest. Here's the code. mlb2010 is data that was imported from a SQL database via RSQLite.
mlb10 <- sapply(2:length(mlb2010), function(i) {
mlb2010[, i] <- as.numeric(mlb2010[, i])
})
rc <- rainbow(nrow(mlb10), start = 0, end = .3)
cc <- rainbow(ncol(mlb10), start = 0, end = .3)
heatmap(mlb10, col = rev(heat.colors(256)), scale = "column",
Rowv = NULL, Colv = NA, RowSideColors = rc, ColSideColors = cc,
margins = c(5,10), labRow = c(mlb2010$team), labCol = names(al2010)[-1],
xlab = "Performance factors", ylab = "Team",
main = c("Relating Performance to Payroll", "2010 MLB Season"))
I have tried the revC argument in heatmap with no success. Is that what I should be using? Or does that reorder all of the columns, and not what is inside the column? I've also tried an sapply over the colors to no avail.
Any help would be greatly appreciated.
Per request from OP, posting the basics of the solution.
Just do ml10$ERA <- -ml10$ERA to reverse the order, then plot as in the post.
I really like how the pheatmap package creates very nice looking heatmaps in R. However, I am trying to add x and y axis labels to the output (if one were just in plot(), one would use: xlab = 'stuff'). A simple example is as follows.
require(pheatmap)
## Generate some data
d <- matrix(rnorm(25), 5, 5)
colnames(d) = paste("bip", 1:5, sep = "")
rownames(d) = paste("blob", 1:5, sep = "")
## Create the heatmap:
pheatmap(d)
The above yields the following heatmap:
I cannot for the life of me figure out how to add an 'xlab' or 'ylab' to this plot. Thoughts?
The main issue here is that pheatmap, which uses grid package, creates a new grid page each time it is called. The solution I've found is:
library(pheatmap)
library(grid)
## Generate some data
d <- matrix(rnorm(25), 5, 5)
colnames(d) = paste("bip", 1:5, sep = "")
rownames(d) = paste("blob", 1:5, sep = "")
## Create the heatmap:
setHook("grid.newpage", function() pushViewport(viewport(x=1,y=1,width=0.9, height=0.9, name="vp", just=c("right","top"))), action="prepend")
pheatmap(d)
setHook("grid.newpage", NULL, "replace")
grid.text("xlabel example", y=-0.07, gp=gpar(fontsize=16))
grid.text("ylabel example", x=-0.07, rot=90, gp=gpar(fontsize=16))
As the above screenshot showed, I used the function heatmap.2() here.
how can I change 'Value' in the color coded bar to any other name?
One can just use the data from gplots package:
library(gplots)
data(mtcars)
x <- as.matrix(mtcars)
rc <- rainbow(nrow(x), start=0, end=.3)
cc <- rainbow(ncol(x), start=0, end=.3)
heatmap.2(x, key=TRUE)
Many thanks :-)
The function heatmap.2 may have changed since #BondedDust answered, but its now possible to easily change the heatmap.2 key labels via:
key.xlab="New value"
First, your code from above (using the standard colors):
library(gplots)
data(mtcars)
x <- as.matrix(mtcars)
heatmap.2(x,key=TRUE)
Now replace the x and y labels:
library(gplots)
data(mtcars)
x <- as.matrix(mtcars)
heatmap.2(x, key=TRUE , key.xlab="New value", key.ylab="New count")
It's hard-coded. You will need to change it in the code. It appears about midway down the section that draws the key and the line is:
else mtext(side = 1, "Value", line = 2)
This is the section of the heatmap.2 code that creates the key (at least up to the point where the word "Value" appears) :
if (key) {
par(mar = c(5, 4, 2, 1), cex = 0.75)
tmpbreaks <- breaks
if (symkey) {
max.raw <- max(abs(c(x, breaks)), na.rm = TRUE)
min.raw <- -max.raw
tmpbreaks[1] <- -max(abs(x), na.rm = TRUE)
tmpbreaks[length(tmpbreaks)] <- max(abs(x), na.rm = TRUE)
}
else {
min.raw <- min(x, na.rm = TRUE)
max.raw <- max(x, na.rm = TRUE)
}
z <- seq(min.raw, max.raw, length = length(col))
image(z = matrix(z, ncol = 1), col = col, breaks = tmpbreaks,
xaxt = "n", yaxt = "n")
par(usr = c(0, 1, 0, 1))
lv <- pretty(breaks)
xv <- scale01(as.numeric(lv), min.raw, max.raw)
axis(1, at = xv, labels = lv)
if (scale == "row")
mtext(side = 1, "Row Z-Score", line = 2)
else if (scale == "column")
mtext(side = 1, "Column Z-Score", line = 2)
else mtext(side = 1, "Value", line = 2)
.... lots more code below
You should type heatmap.2 , then copy the source code to an editor and then use the search function to find "Value". Change "Value" to something else (in quotes) and then type heatmap.2 <- and paste in the code and hit return. (Unless you save this it will only persist as long as the session continues.)
Just come across same task recently. Now there is an option "key.title" to set the title for scale inlet:
library(gplots)
data(mtcars)
x <- as.matrix(mtcars)
heatmap.2(x, key.title = "New Title", key.xlab="New value", key.ylab="New count")
Unfortunately, it do not propagate properly if there is no histogram in inlet:
library(gplots)
data(mtcars)
x <- as.matrix(mtcars)
heatmap.2(x, key.title = "New Title", key.xlab="New value", key.ylab="New count")
Well, key.xlab working as expected and can be used instead.
I've checked the source code on github and it is already fixed there.