Adding barplots around heatmap using R - r

My problem is different from this Side-by-side plots with ggplot2.
Two reasons: 1) With aheatmap() function, the heatmap by aheatmap() and barplots by other functions cann't save in one picture when i use gridExtra.
2) I want "barplots correspond to the rows/columns of the heatmap". I have tried with gridExtra, but the picture changed with the different data sets.
I want to merge some barplots with a heatmap, such that a left/right barplot correspond to the rows of the heatmap, and further that a top/bottom barplot correspond to the columns of the heatmap.
Like this picture (and a barplot in the bottom)
MATLAB Bar graph + HeatMap/Imagesc
Now the aheatmap() in NMF package is used and the code as followings (but I
cann't add barplots):
n <- 50; p <- 20
x <- abs(rmatrix(n, p, rnorm, mean=4, sd=1))
x[1:10, seq(1, 10, 2)] <- x[1:10, seq(1, 10, 2)] + 3
x[11:20, seq(2, 10, 2)] <- x[11:20, seq(2, 10, 2)] + 2
rownames(x) <- paste("ROW", 1:n)
colnames(x) <- paste("COL", 1:p)
annotation = data.frame(Var1 = factor(1:p %% 2 == 0, labels = c("Class1", "Class2")), Var2 = 1:10)
aheatmap(x, annCol = annotation, Rowv=FALSE)
Any suggestions to add barplots using aheatmap() or even using other packages?

What about something along these lines to begin with?
m <- matrix(abs(rnorm(25 * 10)), ncol = 25)
plotMyHeat <- function(x) {
x <- t(x)
l <- matrix(c(1,2), ncol = 2)
layout(l)
op <- par(mar = c(2,2,1,0))
image(x)
par(mar = c(2,1,1,1))
barplot(rowMeans(x),horiz = TRUE, yaxs = "i")
par(op)
}
plotMyHeat(m)

Related

How to draw a shape (ellipse or oval) following some points and calculate its area?

I am trying to plot rings of trees and calculate their areas. However, I have noticed that in reality not all rings have symmetric radii like a circle. I have data measurements of 4 radii, and I would like to plot rings (or any similar shape) following each point of every radio like this example (this figure was done manually with vectors in PowerPoint):
the problem is that in R I found only the possibility to plot these rings with the circles option from the symbols() function, and I got this graph:
using this R script:
data <- data.frame(
a = c(1,4,5,8, 10),
b = c(1, 3,7,9, 10),
c = c(2, 6, 8, 9 ,10),
d = c(1, 3, 4, 7, 9) )
data$y <- (data$a - data$b)/2 # y position
data$x <- (data$d - data$c)/2 # x position
data$z <- rowMeans(data[,1:4]) # radio length
symbols(x = data$x, y = data$y, circles=data$z,
xlim = c(-10, 10)*1.5, ylim = c(-10, 10)*1.5, inches = F, fg = "orange", lwd = 2)
I have checked some packages with functions to draw ellipses (elliplot, ellipse, ellipseplot, car, etc), but I don't like their functions. I am not interested in use these packages, on the contrary I would like to write an own code.
My idea is to plot a shape which best meets the real figure of a ring with my data values of the four radii, it can be an ellipse, oval, etc.
With a circle I am using only data of one radio (in my example, the mean of all radii).
With a ellipse would be better, because I can use at least two values, the major-axis (A+B), and the minor-axis (C+D). But would be great to draw a shape that use the values of four radii (A, B, C, D) or even more radii.
Here a guy drew a very nice superellipse using a R script, and another one drew some ellipses likes rings also in R.
However, I don't know how to use their methods to my specific problem.
If somebody have idea how to start drawing at least an ellipse in R would be nice. But would be great to know how to draw a shape (oval, ellipse, etc.) using the values of four radii and finally calculate their area.
I would appreciate very much your help or any direction to do that.
UPDATE:
Thanks #cuttlefish44 for your excellent answer, that was very useful to explain tree growth to my students. However, most tropical trees have very irregular shapes and now I am wondering to know if can I draw this other shape with an additional radio "E" and the radii axes at different positions like this scheme:
any direction would be very useful for me.
If A & B are on y-axis and C & D are on x-axis, it isn't difficult to calculate the parameters of ellipses. I used optim() to get params (Note: this approach has tiny error, such as 2.439826e-12).
data manipulation
# change all data into xy coordinates and make ring-factor
library(reshape2); library(dplyr)
data <- data.frame(
a = c(1, 4, 5, 8, 10),
b = c(1, 3, 7, 9, 10) * -1,
c = c(2, 6, 8, 9, 10) * -1,
d = c(1, 3, 4, 7, 9) )
data <- t(data)
colnames(data) <- LETTERS[1:ncol(data)] # ring-factor
df <- melt(data, value.name = "x") # change into long-form
df$y <- df$x # make xy coordinates
df[df$Var1=="a"|df$Var1=="b", "x"] <- 0
df[df$Var1=="c"|df$Var1=="d", "y"] <- 0
calculation of center coordinates, ox & oy
center <- df %>% group_by(Var2) %>% summarize(sum(x)/2, sum(y)/2) %>% as.data.frame()
calculation of parameters of ellipse; semi-major and -minor axis, ra & rb
opt.f <- function(par, subset, center) { # target function
ox <- center[[1]] # par[1] and par[2] are ra and rb
oy <- center[[2]]
x <- subset$x
y <- subset$y
sum(abs((x - ox)^2/par[1]^2 + (y - oy)^2/par[2]^2 - 1)) # from ellipse equation
}
lev <- levels(df$Var2)
## search parameters
res <- sapply(1:length(lev), function(a)
optim(c(1,1), opt.f, subset = subset(df, Var2 == lev[a]),
center = center[a, 2:3], control = list(reltol = 1.0e-12)))
res # result. you can get detail by res[,1etc]. values are not 0 but much nearly 0
function to plot (Probably some packages have similar one)
radian <- function(degree) degree/180*pi
plot.ellipse <- function(ox, oy, ra, rb, phi=0, start=0, end=360, length=100, func=lines, ...) {
theta <- c(seq(radian(start), radian(end), length=length), radian(end))
if (phi == 0) {
func(ra*cos(theta)+ox, rb*sin(theta)+oy, ...)
} else {
x <- ra*cos(theta)
y <- rb*sin(theta)
phi <- radian(phi)
cosine <- cos(phi)
sine <- sin(phi)
func(cosine*x-sine*y+ox, sine*x+cosine*y+oy, ...)
}
}
draw
plot(0, type="n", xlim=c(-10, 10), ylim =c(-10, 10), asp=1, xlab="x", ylab="y", axes = F)
axis(1, pos=0);axis(2, pos=0, las=2)
points(df$x, df$y)
for(a in 1:length(lev)) plot.ellipse(ox = center[a, 2], oy = center[a, 3],
ra = res[,a]$par[1], rb = res[,a]$par[2], length=300)
area <- sapply(res[1,], function(a) pi * a[1] * a[2])

R legend for color density scatterplot produced using smoothScatter

I am producing a color density scatterplot in R using the smoothScatter() function.
Example:
## A largish data set
n <- 10000
x1 <- matrix(rnorm(n), ncol = 2)
x2 <- matrix(rnorm(n, mean = 3, sd = 1.5), ncol = 2)
x <- rbind(x1, x2)
oldpar <- par(mfrow = c(2, 2))
smoothScatter(x, nrpoints = 0)
Output:
The issue I am having is that I am unsure how to add a legend/color scale that describes the relative difference in numeric terms between different shades. For example, there is no way to tell whether the darkest blue in the figure above is 2 times, 10 times or 100 times as dense as the lightest blue without some sort of legend or color scale. Is there any way in R to retrieve the requisite information to make such a scale, or anything built in that can produce a color scale of this nature automatically?
Here is an answer that relies on fields::imageplot and some fiddling with par(mar) to get the margins correct
fudgeit <- function(){
xm <- get('xm', envir = parent.frame(1))
ym <- get('ym', envir = parent.frame(1))
z <- get('dens', envir = parent.frame(1))
colramp <- get('colramp', parent.frame(1))
fields::image.plot(xm,ym,z, col = colramp(256), legend.only = T, add =F)
}
par(mar = c(5,4,4,5) + .1)
smoothScatter(x, nrpoints = 0, postPlotHook = fudgeit)
You can fiddle around with image.plot to get what you want and look at ?bkde2D and the transformation argument to smoothScatter to get an idea of what the colours represent.

Color bar for smoothScatter in R [duplicate]

I am producing a color density scatterplot in R using the smoothScatter() function.
Example:
## A largish data set
n <- 10000
x1 <- matrix(rnorm(n), ncol = 2)
x2 <- matrix(rnorm(n, mean = 3, sd = 1.5), ncol = 2)
x <- rbind(x1, x2)
oldpar <- par(mfrow = c(2, 2))
smoothScatter(x, nrpoints = 0)
Output:
The issue I am having is that I am unsure how to add a legend/color scale that describes the relative difference in numeric terms between different shades. For example, there is no way to tell whether the darkest blue in the figure above is 2 times, 10 times or 100 times as dense as the lightest blue without some sort of legend or color scale. Is there any way in R to retrieve the requisite information to make such a scale, or anything built in that can produce a color scale of this nature automatically?
Here is an answer that relies on fields::imageplot and some fiddling with par(mar) to get the margins correct
fudgeit <- function(){
xm <- get('xm', envir = parent.frame(1))
ym <- get('ym', envir = parent.frame(1))
z <- get('dens', envir = parent.frame(1))
colramp <- get('colramp', parent.frame(1))
fields::image.plot(xm,ym,z, col = colramp(256), legend.only = T, add =F)
}
par(mar = c(5,4,4,5) + .1)
smoothScatter(x, nrpoints = 0, postPlotHook = fudgeit)
You can fiddle around with image.plot to get what you want and look at ?bkde2D and the transformation argument to smoothScatter to get an idea of what the colours represent.

R - image of a pixel matrix?

How would you you make an image from a matrix in R?
Matrix values would correspond to pixel intensity on image (although I am just interested in 0,1 values white or black at the moment.), while column and row numbers correspond to vertical and horizontal location on the image.
By make an image I mean display it on the screen and save it as a jpg.
You can display it on the screen easiest using 'image':
m = matrix(runif(100),10,10)
par(mar=c(0, 0, 0, 0))
image(m, useRaster=TRUE, axes=FALSE)
You can also have a look at the raster package...
Set up a plot with no margin:
par(mar = rep(0, 4))
Image the matrix with greyscale, like spacedman's answer but completely filling the device:
m = matrix(runif(100),10,10)
image(m, axes = FALSE, col = grey(seq(0, 1, length = 256)))
Wrap that in a call to png() to create the file:
png("simpleIm.png")
par(mar = rep(0, 4))
image(m, axes = FALSE, col = grey(seq(0, 1, length = 256)))
dev.off()
If you need to do this with spatial axes (defaults to [0,1] for X and Y) then use the image.default(x, y, z, ...) form where x and y give the central positions of the pixels in z. x and y can be of length dim(z) + 1 to give corner coordinates for that convention.
Centres of pixels (this is the default for image):
x <- seq(0, 1, length = nrow(m))
y <- seq(0, 1, length = ncol(m))
image(x, y, m, col = grey(seq(0, 1, length = 256)))
Corners of pixels (need 1 extra x and y, and 0 is now the very bottom left corner):
x <- seq(0, 1, length = nrow(m) + 1)
y <- seq(0, 1, length = ncol(m) + 1)
image(x, y, m, col = grey(seq(0, 1, length = 256)))
Note that from R 2.13 image.default gains an argument useRaster which uses the very efficient newish graphics function rasterImage rather than the old image which is effectively multiple calls to rect under the hood to draw every pixel as a polygon.
I do a matrix (where the vertical axis increases going down) one of two ways. Below is the first way using heatmap.2(). It has more control over how the numeric values are formatted in the plot (see the formatC statement below), but is a little harder to deal with when changing the layout.
library(gplots)
#Build the matrix data to look like a correlation matrix
x <- matrix(rnorm(64), nrow=8)
x <- (x - min(x))/(max(x) - min(x)) #Scale the data to be between 0 and 1
for (i in 1:8) x[i, i] <- 1.0 #Make the diagonal all 1's
#Format the data for the plot
xval <- formatC(x, format="f", digits=2)
pal <- colorRampPalette(c(rgb(0.96,0.96,1), rgb(0.1,0.1,0.9)), space = "rgb")
#Plot the matrix
x_hm <- heatmap.2(x, Rowv=FALSE, Colv=FALSE, dendrogram="none", main="8 X 8 Matrix Using Heatmap.2", xlab="Columns", ylab="Rows", col=pal, tracecol="#303030", trace="none", cellnote=xval, notecol="black", notecex=0.8, keysize = 1.5, margins=c(5, 5))
You can create a heatmap of the matrix.
library(pheatmap)
# Create a 10x10 matrix of random numbers
m = matrix(runif(100), 10, 10)
# Save output to jpeg
jpeg("heatmap.jpg")
pheatmap(m, cluster_row = FALSE, cluster_col = FALSE, color=gray.colors(2,start=1,end=0))
dev.off()
See ?pheatmap for more options.
Try levelplot:
library(lattice)
levelplot(matrix)
Here's the second way (again, where the vertical axis increases going down). This method is easier to layout, but has less control over the format of the numeric values displayed in the plot.
library(plotrix)
#Build the matrix data to look like a correlation matrix
n <- 8
x <- matrix(runif(n*n), nrow=n)
xmin <- 0
xmax <- 1
for (i in 1:n) x[i, i] <- 1.0 #Make the diagonal all 1's
#Generate the palette for the matrix and the legend. Generate labels for the legend
palmat <- color.scale(x, c(1, 0.4), c(1, 0.4), c(0.96, 1))
palleg <- color.gradient(c(1, 0.4), c(1, 0.4), c(0.96, 1), nslices=100)
lableg <- c(formatC(xmin, format="f", digits=2), formatC(1*(xmax-xmin)/4, format="f", digits=2), formatC(2*(xmax-xmin)/4, format="f", digits=2), formatC(3*(xmax-xmin)/4, format="f", digits=2), formatC(xmax, format="f", digits=2))
#Set up the plot area and plot the matrix
par(mar=c(5, 5, 5, 8))
color2D.matplot(x, cellcolors=palmat, main=paste(n, " X ", n, " Matrix Using Color2D.matplot", sep=""), show.values=2, vcol=rgb(0,0,0), axes=FALSE, vcex=0.7)
axis(1, at=seq(1, n, 1)-0.5, labels=seq(1, n, 1), tck=-0.01, padj=-1)
#In the axis() statement below, note that the labels are decreasing. This is because
#the above color2D.matplot() statement has "axes=FALSE" and a normal axis()
#statement was used.
axis(2, at=seq(1, n, 1)-0.5, labels=seq(n, 1, -1), tck=-0.01, padj=0.7)
#Plot the legend
pardat <- par()
color.legend(pardat$usr[2]+0.5, 0, pardat$usr[2]+1, pardat$usr[2], paste(" ", lableg, sep=""), palleg, align="rb", gradient="y", cex=0.7)
With ggplot2:
library(tidyverse)
n <- 12
m <- matrix(rnorm(n*n),n,n)
rownames(m) <- colnames(m) <- 1:n
df <- as.data.frame(m) %>% gather(key='y', value='val')
df$y <- as.integer(df$y)
df$x <- rep(1:n, n)
ggplot(df, aes(x, y, fill= val)) +
geom_tile() +
geom_text(aes(x, y, label=round(val,2))) +
scale_fill_gradient(low = "white", high = "red") +
theme_bw()

R: How do I display clustered matrix heatmap (similar color patterns are grouped)

I searched a lot of questions about heatmap throughout the site and packages, but I still have a problem.
I have clustered data (kmeans/EM/DBscan..), and I want to create a heatmap by grouping the same cluster. I want the similar color patterns to be grouped in the heatmap, so generally, it looks like a block-diagonal.
I tried to order the data by the cluster number and display it,
k = kmeans(data, 3)
d = data.frame(data)
d = data.frame(d, k$cluster)
d = d[order(d$k.cluster),]
heatmap(as.matrix(d))
but it is still not sorted and looks like this link: But, I want it to be sorted by its cluster number and looked like this:
Can I do this in R?
I searched lots of packages and tried many ways, but I still have a problem.
Thanks a lot.
You can do this using reshape2 and ggplot2 as follows:
library(reshape2)
library(ggplot2)
# Create dummy data
set.seed(123)
df <- data.frame(
a = sample(1:5, 1000, replace=TRUE),
b = sample(1:5, 1000, replace=TRUE),
c = sample(1:5, 1000, replace=TRUE)
)
# Perform clustering
k <- kmeans(df, 3)
# Append id and cluster
dfc <- cbind(df, id=seq(nrow(df)), cluster=k$cluster)
# Add idsort, the id number ordered by cluster
dfc$idsort <- dfc$id[order(dfc$cluster)]
dfc$idsort <- order(dfc$idsort)
# use reshape2::melt to create data.frame in long format
dfm <- melt(dfc, id.vars=c("id", "idsort"))
ggplot(dfm, aes(x=variable, y=idsort)) + geom_tile(aes(fill=value))
You should set Rowv and Colv to NA if you don't want the dendrograms and the subseuent ordering. BTW, You should also put of the scaling. Using the df of Andrie :
heatmap(as.matrix(df)[order(k$cluster),],Rowv=NA,Colv=NA,scale="none",labRow=NA)
In fact, this whole heatmap is based on image(). You can hack away using image to construct a plot exactly like you want. Heatmap is using layout() internally, so it will be diffucult to set the margins. With image you could do eg :
myHeatmap <- function(x,ord,xlab="",ylab="",main="My Heatmap",
col=heat.colors(5), ...){
op <- par(mar=c(3,0,2,0)+0.1)
on.exit(par(op))
nc <- NCOL(x)
nr <- NROW(x)
labCol <- names(x)
x <- t(x[ord,])
image(1L:nc, 1L:nr, x, xlim = 0.5 + c(0, nc), ylim = 0.5 +
c(0, nr), axes = FALSE, xlab=xlab, ylab=ylab, main=main,
col=col,...)
axis(1, 1L:nc, labels = labCol, las = 2, line = -0.5, tick = 0)
axis(2, 1L:nr, labels = NA, las = 2, line = -0.5, tick = 0)
}
library(RColorBrewer)
myHeatmap(df,order(k$cluster),col=brewer.pal(5,"BuGn"))
To produce a plot that has less margins on the side. You can also manipulate axes, colors, ... You should definitely take a look at the RColorBrewerpackage
(This custom function is based on the internal plotting used by heatmap btw, simplified for the illustration and to get rid of all the dendrogram stuff)

Resources