Create heatmap in R on the entire matrix rather than by row - r

Desired OutputI want to create a heatmap in R which should consider formatting of colors by all the values in matrix and not just by rows. Ex: I've a following matix
row1 : 1,2,3,4
row2 : 50,50,50,50
When I use heatmap() to plot this matrix, I see row 1 with shades of color, however my row2 is marked as white. I would rather want 50 to be rated in extreme color (eg: Red) and 1,2, 3 & 4 in lighter shades
Hope my question makes sense. Please let me know if anything is unclear.
Thanks in advance!
Regards,
Akshat

If you read ?heatmap carefully, you will see that by default the rows are scaled and centered.
row1 = c(1,2,3,4)
row2 = c(50,50,50,50)
m = t(as.matrix(cbind(row1, row2)))
par(mfrow=c(2,1))
heatmap(m, col=rev(heat.colors(15)))
heatmap(m, scale = "none", col=rev(heat.colors(15)))
Should do the trick.
Centered and Scaled (the default)
Edit: I reversed the color scale so that red maps to larger values.
2nd: Your desired output is going to be difficult to obtain because 50 is so much larger than the rest of your data. To regain the color detail in row1 you would need to set the breaks in the heatmap function until you get the desired result
heatmap(m, scale = "none", col=rev(heat.colors(5)), breaks=c(0,1,2,3,4,50))

This function should work
library(plotly)
hmap <- function(mat, ... ) {
s <- 1:nrow(mat)
plot_ly(x = s, y = s, z = mat[rev(s), ], type = "heatmap", ...)
}
m <- matrix(1:8, 2, byrow = T)
hmap(m)
You can adjust colors with the colors argument, e.g.
hmap(m, colors = c('Red','Yellow','Green'))

Related

Chord Plot for a Correlation matrix. R

I want to create a Chord plot for a correlation matrix. Where the links represent the correlations in a color gradient from -1 to 1 (blue to red). I want just to represent those links that have an actual correlation.
This is an example dataset:
c1<-c(0,0,0.5,-0.2,0.1,-0.8)
c2<-c(0.2,0.8,-0.5,0,0,0)
c3<-c(0,0,-0.2,0,0,0.1)
mat<-rbind(c1,c2,c3)
rownames(mat) = paste0("S", 1:3)
colnames(mat) = paste0("E", 1:6)
df = data.frame(from = rep(rownames(mat), times = ncol(mat)),
to = rep(colnames(mat), each = nrow(mat)),
value = as.vector(mat),
stringsAsFactors = FALSE)
A simple way to represent this in a chord plot would be like:
windows()
chordDiagram(df, big.gap = 30)
circos.clear()
However, it represents all the links, even if the value is 0. How can I create a color gradient for the value, from -1 to 1 with the 0 being white?
Thanks
Assuming you are using the circlize package you can adjust the colours manually based on a range by writing a function and then inputting it in the col argument of the chordDiagram() function:
library(circlize)
cols = colorRamp2(c(-1,0,1),c("blue","white","red"),transparency = 0.3)
chordDiagram(mat,col=cols,big.gap=30)
I used the matrix to plot the chord diagram but the data frame should produce the same results. However, I don't understand what you mean when you say all links are represented even if the value is 0 since for example, S1 to E1 is 0 but there is no link between the two

Color bar legend for values on vertices of igraph in R

I am new in R and I am starting to work on graph visualization over there using igraph. The example below create a simple network of 10 vertices and color them according to color values (which in this case for simplicity I set up to be the same as ids of vertices).
library(igraph)
vertices <- 1:10
first <- 1:10
second <- c(2:10,1)
edges = cbind(first,second)
color = 1:10
net = graph_from_data_frame(edges,vertices=vertices ,directed=F )
V(net)$color = color
plot(net)
However from this plot it is not clear which colors correspond to
which numbers:
To deal with this I have tried to create various
legends I was able to find in the documentation and online. Take for
instance the code below:
legend("bottom", legend=levels(as.factor(color)), bty = "n", cex =
1.5, pt.cex = 3, pch=20, col = color , horiz = FALSE , inset = c(0.1,
-0.3)
But in this case, the result is messy, obscure the picture, and do not provide a continuous color bar that would map the range of values on the nodes to color spectrum. Other options I was able to find are not better.
Do you know how to make a legend in a form of a continuous color bar placed below or to the right from the picture (so that it do not cover any part of it)? Ideally the color bar should show the whole continuous spectrum of colors and a few values corresponding to the colors (at least the extreme ones)?
Do you happen to know how to achieve this?
Thank you for your help!
You should check out this answer by kokkenbaker,although it is a bit cumbersome, it might be just what you need.
How to add colorbar with perspective plot in R
Thanks to ealbsho93 I was able to produce the following solution. It create a pallete, then map the values on the vertices on the graph to the pallete and displays it. It is not straightforward, but the result looks much better (see below)
rm(list=ls())
library(igraph)
library(fields)
vertices <- 1:10
first <- 1:10
second <- c(2:10,1)
edges = cbind(first,second)
net = graph_from_data_frame(edges,vertices=vertices ,directed=F )
#Here we create a sample function on the vertices of the graph
color_num = 10:1
#create a color palette of the same size as the number of vertices.
jet.colors <- colorRampPalette( rainbow( length( unique(color_num) ) ) )
color_spectrum <- jet.colors( length( unique(color_num ) ) )
#and over here we map the pallete to the order of values on vertices
ordered <- order(color_num)
color <- vector(length = length(ordered),mode="double")
for ( i in 1:length(ordered) )
{
color[ ordered[i] ] <- color_spectrum [ i ]
}
V(net)$color = color
#Display the graph and the legend.
plot(net)
image.plot(legend.only=T, zlim=range(color_num), col=color_spectrum )
If there is a better solution, please let me know. Othervise, this one seems to be OK to use.

R - Assign special color for lowest value in colorRampPalette

I have a dataframe like this:
library(lubridate)
date_list = seq(ymd('2017-01-01'),ymd('2018-12-31'),by='day')
values = sample(0:35, 730, replace=TRUE)
testframe = data.frame(Date = date_list, Value = values)
The values are between 0 and 35. I want to create a heatmap with this data with colors from lightblue1 to royalblue. My problem is, that I want to highlight the values that are 0. They should stand out with a red color. So I dont want to have a gradient from 0 to the next numbers, I completely want to seperate 0 from 1. So all 0 should be red and all other values should be colored in a gradient from lightblue1 to royalblue.
I am using a heatmap, that contains the colorRampPalette, the full code is here: Heatmap Code
When I add btb<- c("lightblue1", "royalblue") in line 83 of the code and change the color in line 46 aswell I get the gradient without the red. How can I add now the red color for all 0?
Any suggestions on how I can solve that problem?
Updated Answer
In addition to adding the line
b2b <- c("lightblue1", "royalblue")
you also need to change
calendar.pal <- colorRampPalette((col.sty), space = "Lab")
to something like
calendar.pal1 <- colorRampPalette((col.sty), space = "Lab")
calendar.pal <- function(n) c("red", calendar.pal1(n-1))
Then, we can get the red highlighting you want
calendarHeat(date_list, values, color = "b2b", ncolors = 15)
Note that I've decreased the number of colors there. If the ncolors value is too high, the red disappears, so you have to watch for that.
Old Answer
The code you linked was pretty lengthy, so I didn't spend time studying it. Instead, I generate the following solution to your general problem:
First, create a function giving the basic color ramp:
foo <- colorRampPalette(c("lightblue1", "royalblue"))
Then, create a function that calls foo() for the color ramp, but modifies it according to your highlight rule here:
bar <- function(x) {
pal <- foo(length(x))
pal[which(x == 0)] <- "red"
return(pal)
}
I generate data as in your post (setting the seed for reproducibility):
library(lubridate)
date_list = seq(ymd('2017-01-01'),ymd('2018-12-31'),by='day')
set.seed(123)
values = sample(0:35, 730, replace=TRUE)
And try out the function:
plot(date_list, values, col = bar(values), pch = 19)

How to create heatmap illustraing mesh differences controlling the position of center color for divergence color palette?

I have two 3D meshes of human faces and I wish to use heatmap to illustrate differences. I want to use red-blue divergent color scale.
My data can be found here. In my data, "vb1.xlsx" and "vb2.xlsx" contain 3D coordinates of the two meshes. "it.xlsx" is the face information. The "dat_col.xlsx" contains pointwise distances between the two meshes based on which heatmap could be produced. I used the following code to generate the two meshes based on vertex and face information. I then used the meshDist function in Morpho package to calculate distances between each pair of vertex on the two meshes.
library(Morpho)
library(xlsx)
library(rgl)
library(RColorBrewer)
library(tidyverse)
mshape1 <- read.xlsx("...\\vb1.xlsx", sheetIndex = 1, header = F)
mshape2 <- read.xlsx("...\\vb2.xlsx", sheetIndex = 1, header = F)
it <- read.xlsx("...\\it.xlsx", sheetIndex = 1, header = F)
# Preparation for use in tmesh3d
vb_mat_mshape1 <- t(mshape1)
vb_mat_mshape1 <- rbind(vb_mat_mshape1, 1)
rownames(vb_mat_mshape1) <- c("xpts", "ypts", "zpts", "")
vb_mat_mshape2 <- t(mshape2)
vb_mat_mshape2 <- rbind(vb_mat_mshape2, 1)
rownames(vb_mat_mshape2) <- c("xpts", "ypts", "zpts", "")
it_mat <- t(as.matrix(it))
rownames(it_mat) <- NULL
vertices1 <- c(vb_mat_mshape1)
vertices2 <- c(vb_mat_mshape2)
indices <- c(it_mat)
mesh1 <- tmesh3d(vertices = vertices1, indices = indices, homogeneous = TRUE,
material = NULL, normals = NULL, texcoords = NULL)
mesh2 <- tmesh3d(vertices = vertices2, indices = indices, homogeneous = TRUE,
material = NULL, normals = NULL, texcoords = NULL)
mesh1smooth <- addNormals(mesh1)
mesh2smooth <- addNormals(mesh2)
# Calculate mesh distance using meshDist function in Morpho package
mD <- meshDist(mesh1smooth, mesh2smooth)
pd <- mD$dists
The pd, containing information on pointwise distances between the two meshes, can be found in the first column of the "dat_col.xlsx" file.
A heatmap is generated from the meshDist function as follows:
I wish to have better control of the heatmap by using red-blue divergent color scale. More specifically, I want positive/negative values to be colored blue/red using 100 colors from the RdBu color pallete in the RColorBrewer package. To do so, I first cut the range of pd values into 99 intervals of equal lengths. I then determined which of the 99 intervals does each pd value lie in. The code is as below:
nlevel <- 99
breaks <- NULL
for (i in 1:(nlevel - 1)) {
breaks[i] <- min(pd) + ((max(pd) - min(pd))/99) * i
}
breaks <- c(min(pd), breaks, max(pd))
pd_cut <- cut(pd, breaks = breaks, include.lowest = TRUE)
dat_col <- data.frame(pd = pd, pd_cut = pd_cut, group = as.numeric(pd_cut))
The pd_cut is the inteval corresponding to each pd and group is the interval membership of each pd. Color is then assgined to each pd according to the value in group with the following code:
dat_col <- dat_col %>%
mutate(color = colorRampPalette(
brewer.pal(n = 9, name = "RdBu"))(99)[dat_col$group])
The final heatmap is as follows:
open3d()
shade3d(mesh1smooth, col=dat_col$color, specular = "#202020", polygon_offset = 1)
Since I have 99 intervals, the middle interval is the 50th, (-3.53e-05,-1.34e-05]. However, it is the 51th interval, (-1.34e-05,8.47e-06], that contains the 0 point.
Following my way of color assignment (colorRampPalette(brewer.pal(n = 9, name = "RdBu"))(99)[dat_col$group]), the center color (the 50th color imputed from colorRampPalette) is given to pds belonging to the 50th interval. However, I want pds that belong to the 51th interval, the interval that harbors 0, to be assgned the center color.
I understand that in my case, my issue won't affect the appearance of heatmap too much. But I believe this is not a trivial issue and can significantly affect the heatmap when the interval that contains 0 is far from the middle interval. This could happen when the two meshes under comparison is very different. It makes more sense to me to assign center color to the interval that contains 0 rather than the one(s) that lie in the middle of all intervals.
Of course I can manually replace hex code of the 50th imputed color to the desired center color as follows:
color <- colorRampPalette(brewer.pal(n = 9, name = "RdBu"))(99)
color2 <- color
color2[50] <- "#ffffff" #assume white is the intended center color
But the above approach affected the smoothness of color gradient since the color that was originally imputed by some smooth function is replaced by some arbitrary color. But how could I assign center color to pds that lie in the interval that transgresses 0 while at the same time not affecting the smoothness of the imputed color?
There are a couple of things to fix to get what you want.
First, the colours. You base the colours on this code:
color <- colorRampPalette(brewer.pal(n = 9, name = "RdBu"))(99)
You can look at the result of that calculation, and you'll see that there is no white in it. The middle color is color[50] which evaluates to "#F7F6F6", i.e.
a slightly reddish light gray colour. If you look at the original RdBu palette, the middle colour was "#F7F7F7", so this change was done by colorRampPalette(). To me it looks like a minor bug in that function: it truncates the colour values instead of rounding them, so the values
[50,] 247.00000 247.00000 247.00000
convert to "#F7F6F6", i.e. red 247, green 246, blue 246. You can avoid this by choosing some other number of colours in your palette. I see "F7F7F7" as the middle colour with both 97 and 101 colours. But being off by one probably doesn't matter much, so I wouldn't worry about this.
The second problem is your discretization of the range of the pd values. You want zero in the middle bin. If you want the bins all to be of equal size, then it needs to be symmetric: so instead of running from min(pd) to max(pd), you could use this calculation:
limit <- max(abs(pd))
breaks <- -limit + (0:nlevel)*2*limit/nlevel
This will put zero exactly in the middle of the middle bin, but some of the bins at one end or the other might not be used. If you don't care if the bins are of equal size, you could get just as many negatives as positives by dividing them up separately. I like the above solution better.
Edited to add: For the first problem, a better solution is to use
color <- hcl.colors(99, "RdBu")
with the new function in R 3.6.0. This does give a light gray as the middle color.

colorRamp returns 0

I'm trying to plot lines and color the lines based on the probability of that connection. Given a vector of probabilities, I use:
colfunc <- colorRamp(c("white", "red"))
colors <- colfunc(probs)
colors is then an nx3 matrix of rgb values. However, colfunc quite often returns a 0 value, so when i attempt to plot using these colors, R complains
Error in col2rgb(colors) : numerical color values must be positive
Is there an error in the way I am defining my color function?
Your function works fine, I think, but it doesn't return colors you can use with plot, because plot wants a color, not RGB values in a matrix.
There's probably a better way, but you can simply covert the matrix:
probs <- runif(10)
colors <- colfunc(probs)
my_col = apply(colors, MARGIN = 1, function(x) rgb(x[1]/255, x[2]/255, x[3]/255))
plot(1:10, 1:10, col = my_col) # should work fine
or you could just wrap your function
better_colfunc <- function(x, ramp = colorRamp(c("white", "red"))) {
colors <- ramp(x)
colors = apply(colors, MARGIN = 1, function(x) rgb(x[1]/255, x[2]/255, x[3]/255))
return(colors)
}
plot(1:10, 1:10, col = better_colfunc(probs, ramp = colfunc))
As for "colfunc quite often returns a 0 value", and other issues, you'll need to share both some data (what do your probs look like?) as well as perhaps the actual plotting code. See here for tips on making reproducible questions.
I am a bit confused what you are trying to do...the col2rgb function returns rgb values, so if you already have those then what do you want?
Or if you want rgb, why not use:
col2rgb(c("white", "red"))

Resources