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
Related
Consider this data, where we have several groups with 10 observations each, and we conduct a pairwise.t.test():
set.seed(123)
data <- data.frame(group = rep(letters[1:18], each = 10),
var = rnorm(180, mean = 2, sd = 5))
ttres <- pairwise.t.test(x=data$var, g=data$group, p.adjust.method = "none")#just to make sure i get some sigs for the example
Now lets get the matrix of p values, convert them to a binary matrix showing significant and non-significant values, and plot them with corrplot(), so that we can visualize which groups are different:
library(corrplot)
pmat <- as.matrix(ttres$p.value)
pmat<-round(pmat,2)
pmat <- +(pmat <= 0.1)
pmat
corrplot(pmat, insig = "blank", type = "lower")
Does anyone know a way to color the background of each square according to a grouping label? For instance, say we want the squares for groups a:g to be yellow, the squares for groups h:n to be blue, and the squares for groups o:r to be red. Or is there an alternative way to do this with ggplot?
You can pass a vector of background colors via the bg= parameter. The trick is just making sure they are in the right order. Here's on way to do that
bgcolors <- matrix("white", nrow(pmat), ncol(pmat),dimnames = dimnames(pmat))
bgcolors[1:6, ] <- "yellow"
bgcolors[7:15, ] <- "blue"
bgcolors[14:17, ] <- "red"
bgcolors <- bgcolors[lower.tri(bgcolors, diag=TRUE)]
corrplot(pmat, insig = "blank", type = "lower", bg=bgcolors)
Basically we just make a matrix the same shape as our input, then we set the colors we want for the different rows, and then we just pass the lower triangle of that matrix to the function.
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.
I have used the script below to generate this betadisper plot between 2 communities.
In my "df", the first column is station names (x13)
I have 2 questions:
There is a point behind the "ABC" label, so how do I make the label transparent? Preferably adding different colours to each community?
How do I add the station names next to each point so I can visually compare which stations are most similar?
Script:
df <-read.csv("NMDS matrix_csv_NEW.csv", header=T, row.names=1, sep= ",")
df
Label<-rownames(df)
Label
dis <- vegdist(df)
groups <- factor(c(rep(1,8), rep(2,5)), labels = c("ABC","DEF"))
groups
mod <- betadisper(dis, groups)
mod
anova(mod)
permutest(mod, pairwise = TRUE)
plot(mod)
plot(mod, ellipse = TRUE, hull = FALSE, main= "MultiVariate Permutation")
To answer 2), here's how to plot the station names on top of the points.
text(mod$vectors[,1:2], label=Label)
Here is a possibile solution to your problem.
Download the myplotbetadisp.r file from this link and place the file in the working directory (warning, do not save the file as myplotbetadisp.r.txt!).
Some additional options are available in myplotbetadisper function:
fillrect, filling color of the box where centroid labels are printed;
coltextrect, vector of colors for centroid labels;
alphaPoints, alpha trasparency for centroid points;
labpoints, vectors of labels plotted close to points;
poslabPoints, position specifier for the text in labpoints.
library(vegan)
# A dummy data generation process
set.seed(1)
n <- 100
df <- matrix(runif(13*n),nrow=13)
# Compute dissimilarity indices
dis <- vegdist(df)
groups <- factor(c(rep(1,8), rep(2,5)), labels = c("ABC","DEF"))
# Analysis of multivariate homogeneity of group dispersions
mod <- betadisper(dis, groups)
source("myplotbetadisp.r")
labPts <- LETTERS[1:13]
col.fill.rect <- addAlpha(col2rgb("gray65"), alpha=0.5)
col.text.rect <- apply(col2rgb(c("blue","darkgreen")), 2, addAlpha, alpha=0.5)
transp.centroids <- 0.7
myplotbetadisper(mod, ellipse = TRUE, hull = FALSE,
fillrect=col.fill.rect, coltextrect=col.text.rect,
alphaPoints=transp.centroids, labPoints=labPts,
main= "MultiVariate Permutation")
Here is the plot
Hope it can help you.
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'))
Suppose I have this very simple 2x2 RGB datacube that I want to plot:
set.seed(2017)
dc <- array(runif(12), dim = c(2,2,3))
I can plot this just by rasterizing the datacube:
plot(as.raster(dc), interpolate = FALSE)
But I would like to plot this data cube with the lattice package (for uniformity sake since I am mainly using it for other plotting too).
Is this possible? I am looking at levelplot, but am not able to make it work.
The problem you have is that lattice needs a matrix, that is a numeric matrix, and rasters of RGB become a factor matrix:
r <-as.raster(dc)
r
gives this result:
[,1] [,2]
[1,] "#ECC478" "#780AAC"
[2,] "#89C546" "#4A6F01"
to use it as lattice you need to transform this into a numeric matrix, this looks long but it seems is the only way to ensure to keep the order:
m <- matrix(as.numeric(as.factor(as.vector(as.matrix(r)))), ncol= 2)
levelplot(m, panel = panel.levelplot.raster)
The problem you will get here is that you won't keep the same RGB colors, but it's a lattice solution.
Ok, this turned out to be quite an endeavor with levelplot.
I convert the RGB hex color values from raster to integers, and then use these values to map them to the color palette of the raster.
set.seed(2017)
dc <- array(runif(12), dim = c(2,2,3))
plot(as.raster(dc), interpolate = FALSE)
# convert color hexadecimals to integers
rgbInt <- apply(as.raster(dc), MARGIN = c(1,2),
FUN = function(str){strtoi(substring(str, 2), base = 16)})
rgbIntUnq <- unique(as.vector(rgbInt))
lattice::levelplot(x = t(rgbInt), # turn so rows become columns
at = c(0,rgbIntUnq),
col.regions = sprintf("#%06X", rgbIntUnq[order(rgbIntUnq)]), # to hex
ylim = c(nrow(rgbInt) + 0.5, 1 - 0.5), # plot from top to bottom
xlab = '', ylab = '')
The legend can also be removed with colorkey = FALSE property.
I wonder whether there are simpler ways to do the same.