Faceting a plotly heatmap - r

I'd like to be able to facet an R plotly heatmap.
Here's what I mean:
I have a hierarchically-clustered gene expression dataset:
require(permute)
set.seed(1)
mat <- rbind(cbind(matrix(rnorm(2500,2,1),nrow=25,ncol=500),matrix(rnorm(2500,-2,1),nrow=25,ncol=500)),
cbind(matrix(rnorm(2500,-2,1),nrow=25,ncol=500),matrix(rnorm(2500,2,1),nrow=25,ncol=500)))
rownames(mat) <- paste("g",1:50,sep=".")
colnames(mat) <- paste("s",1:1000,sep=".")
hc.col <- hclust(dist(t(mat)))
dd.col <- as.dendrogram(hc.col)
col.order <- order.dendrogram(dd.col)
hc.row <- hclust(dist(mat))
dd.row <- as.dendrogram(hc.row)
row.order <- order.dendrogram(dd.row)
mat <- mat[row.order,col.order]
I then discretize it to specific expression ranges because that happens to help the resolution of colors for my case. I'm also creating other structures to help me plot the colorbar the way I want it to:
require(RColorBrewer)
mat.intervals <- cut(mat,breaks=6)
interval.mat <- matrix(mat.intervals,nrow=50,ncol=1000,dimnames=list(rownames(mat),colnames(mat)))
interval.cols <- brewer.pal(6,"Set2")
names(interval.cols) <- levels(mat.intervals)
require(reshape2)
interval.df <- reshape2::melt(interval.mat,varnames=c("gene","sample"),value.name="expr")
interval.cols2 <- rep(interval.cols, each=ncol(mat))
color.df <- data.frame(range=c(0:(2*length(interval.cols)-1)),colors=c(0:(2*length(interval.cols)-1)))
color.df <- setNames(data.frame(color.df$range,color.df$colors),NULL)
for (i in 1:(2*length(interval.cols))) {
color.df[[2]][[i]] <- interval.cols[[(i + 1) / 2]]
color.df[[1]][[i]] <- i/(2*length(interval.cols))-(i %% 2)/(2*length(interval.cols))
}
They way I generated the data I know that samples 1-500 are one cluster and samples 501:1000 are the other, so I label them:
interval.df$cluster <- NA
interval.df$cluster[which(interval.df$sample %in% paste("s",1:500,sep="."))] <- "A"
interval.df$cluster[which(interval.df$sample %in% paste("s",501:1000,sep="."))] <- "B"
I thought that adding a sample with not color and interval will create a white column in the heatmap plot that will look like a facet border:
divider.df <- data.frame(gene=unique(interval.df$gene),sample=NA,expr=NA,cluster=NA)
interval.df <- rbind(dplyr::filter(interval.df,cluster == "A"),divider.df,dplyr::filter(interval.df,cluster == "B"))
And now I try plotting:
#add ticks for each cluster
tick.vals <- c("s.158","s.617")
tick.text <- c("A","B")
require(plotly)
plot_ly(z=c(interval.df$expr),x=interval.df$sample,y=interval.df$gene,colors=interval.cols2,type="heatmap",colorscale=color.df,
colorbar=list(title="score",tickmode="array",tickvals=c(1:6),ticktext=names(interval.cols),len=0.2,outlinecolor="white",bordercolor="white",borderwidth=5,bgcolor="white")) %>%
layout(xaxis = list(title = 'Cluster',tickmode = 'array',tickvals = tick.vals,ticktext = tick.text))
But I don't see any separation between the clusters:
Any idea how to achieve such a facet border between the two clusters?

Your example is quite involved so I have reduced it down to a minimal example to focus on the gap you are looking for in the quadrants of your heatmap.
Modified from the examples on the plotly site, here.
library(plotly)
m <- matrix(rnorm(9), nrow = 3, ncol = 3)
p <- plot_ly(
x = c("a", "b", "c"), y = c("d", "e", "f"),
z = m, type = "heatmap"
)
subplot(p, p, p, p, shareX = TRUE, shareY = TRUE, nrows = 2)
If you create a plotly object for each of the quadrants and then use subplot, you will get a result looking similar to this:
N.B. I have cropped out the legend because it was duplicated for the facets, you could merge these into one.

Related

Dendrogram plot remove tree labels at end of the branches

Using the example located here https://www.datacamp.com/community/tutorials/hierarchical-clustering-R and the data located https://archive.ics.uci.edu/ml/datasets/seeds# i am trying to remove the labels at the bottom of the dendrogram when using the color_branches
when plot(hclust_avg, labels=FALSE) it works but not later when using color_branches. is there a way to remove them?
`set.seed(786)
seeds_df <- read.csv("seeds_dataset.txt",sep = '\t',header = FALSE)
feature_name <- c('area','perimeter','compactness','length.of.kernel','width.of.kernal','asymmetry.coefficient','length.of.kernel.groove','type.of.seed')
colnames(seeds_df) <- feature_name
seeds_df<- seeds_df[complete.cases(seeds_df), ]
seeds_label <- seeds_df$type.of.seed
seeds_df$type.of.seed <- NULL
seeds_df_sc <- as.data.frame(scale(seeds_df))
dist_mat <- dist(seeds_df_sc, method = 'euclidean')
hclust_avg <- hclust(dist_mat, method = 'average')
cut_avg <- cutree(hclust_avg, k = 3)
suppressPackageStartupMessages(library(dendextend))
avg_dend_obj <- as.dendrogram(hclust_avg)
avg_col_dend <- color_branches(avg_dend_obj, h = 3)
plot(avg_col_dend)`
Figured this out by colouring the the labels white to the background
avg_dend_obj <- as.dendrogram(hclust_avg)
labels_colors(avg_dend_obj) <- "white"
plot(avg_dend_obj)

R: Making common legend and colour scheme for multiple shapefiles

A sample data first:
library(raster)
# download a sample shape file
shape.file <- getData('GADM', country='FRA', level=2)
ID_2 <- rep(shape.file#data$ID_2,times=2)
group.id <- rep(c(100,200),each=96)
set.seed(1)
cat1<- runif(192,min=0,max=100)
set.seed(2)
cat2<- runif(192,min=0,max=100)
set.seed(3)
cat3<- runif(192,min=0,max=100)
dat <- as.data.frame(cbind(ID_2,group.id,cat1,cat2,cat3))
# extract the data for group.id = 100 and group.id = 200 in two seprate df
group.id.100 <- dat[dat$group.id==100,]
group.id.200 <- dat[dat$group.id==200,]
# merge with shape file
merge.shp.100 <- merge(shape.file,group.id.100, by="ID_2")
merge.shp.200 <- merge(shape.file,group.id.200, by="ID_2")
# plot them together
par(mfrow=c(3,2))
plot(merge.shp.100,col=merge.shp$cat1,main="Group.id.100,cat1")
plot(merge.shp.100,col=merge.shp$cat2,main="Group.id.100,cat2")
plot(merge.shp.100,col=merge.shp$cat3,main="Group.id.100,cat3")
plot(merge.shp.200,col=merge.shp$cat1,main="Group.id.200,cat1")
plot(merge.shp.200,col=merge.shp$cat2,main="Group.id.200,cat2")
plot(merge.shp.200,col=merge.shp$cat3,main="Group.id.200,cat3")
I want to insert a common legend and colour scheme for all the 6 figures.
For example, the legend should go from minimum = min(c(cat1,cat2,cat3)) to max(c(cat1,cat2,cat3))
for all the six figures. Similarly, a value of 50 should have the same colour in all the 6 figures.
Thank you
You can use spplot
Example data:
library(raster)
s <- getData('GADM', country='FRA', level=2)[, c('GID_1', 'NAME_1', 'GID_2', 'NAME_2')]
set.seed(1)
m <- matrix(runif(96*6, 0, 100), nrow=96, ncol=6)
vars <- paste0("cat", 1:6)
colnames(m) <- vars
d <- data.frame(GID_2 = s$GID_2, m)
sd <- merge(s, d)
Use spplot:
spplot(sd, vars)
With base plot, you could do something like
brks <- seq(0,100,20)
par(mfrow=c(2,3), mai=c(0,0,0.5,0))
cols = rainbow(length(brks))
for (v in vars) {
cuts <- cut(data.frame(sd)[, v], brks)
plot(s, col=cols[cuts], main=v)
}

How to color branches in R dendogram as a function of the classes in it?

I wish to visualize how well a clustering algorithm is doing (with certain distance metric). I have samples and their corresponding classes.
To visualize, I cluster and I wish to color the branches of a dendrogram by the items in the cluster. The color will be the color most items in the hierarchical cluster correspond to (given by the data\classes).
Example: If my clustering algorithm chose indexes 1,21,24 to be a certain cluster (at a certain level) and I have a csv file containing a class number in each row corresponding to lets say 1,2,1. I want this edge to be coloured 1.
Example Code:
require(cluster)
suppressPackageStartupMessages(library(dendextend))
dir <- 'distance_metrics/'
filename <- 'aligned.csv'
my.data <- read.csv(paste(dir, filename, sep=""), header = T, row.names = 1)
my.dist <- as.dist(my.data)
real.clusters <-read.csv("clusters", header = T, row.names = 1)
clustered <- diana(my.dist)
# dend <- colour_branches(???dend, max(real.clusters)???)
plot(dend)
EDIT:
another example partial code
dir <- 'distance_metrics/' # csv in here contains a symmetric matrix
clust.dir <- "clusters/" #csv in here contains a column vector with classes
my.data <- read.csv(paste(dir, filename, sep=""), header = T, row.names = 1)
filename <- 'table.csv'
my.dist <- as.dist(my.data)
real.clusters <-read.csv(paste(clust.dir, filename, sep=""), header = T, row.names = 1)
clustered <- diana(my.dist)
dnd <- as.dendrogram(clustered)
Both node and edge color attributes can be set recursively on "dendrogram" objects (which are just deeply nested lists) using dendrapply. The cluster package also features an as.dendrogram method for "diana" class objects, so conversion between the object types is seamless. Using your diana clustering and borrowing some code from #Edvardoss iris example, you can create the colored dendrogram as follows:
library(cluster)
set.seed(999)
iris2 <- iris[sample(x = 1:150,size = 50,replace = F),]
clust <- diana(iris2)
dnd <- as.dendrogram(clust)
## Duplicate rownames aren't allowed, so we need to set the "labels"
## attributes recursively. We also label inner nodes here.
rectify_labels <- function(node, df){
newlab <- df$Species[unlist(node, use.names = FALSE)]
attr(node, "label") <- (newlab)
return(node)
}
dnd <- dendrapply(dnd, rectify_labels, df = iris2)
## Create a color palette as a data.frame with one row for each spp
uniqspp <- as.character(unique(iris$Species))
colormap <- data.frame(Species = uniqspp, color = rainbow(n = length(uniqspp)))
colormap[, 2] <- c("red", "blue", "green")
colormap
## Now color the inner dendrogram edges
color_dendro <- function(node, colormap){
if(is.leaf(node)){
nodecol <- colormap$color[match(attr(node, "label"), colormap$Species)]
attr(node, "nodePar") <- list(pch = NA, lab.col = nodecol)
attr(node, "edgePar") <- list(col = nodecol)
}else{
spp <- attr(node, "label")
dominantspp <- levels(spp)[which.max(tabulate(spp))]
edgecol <- colormap$color[match(dominantspp, colormap$Species)]
attr(node, "edgePar") <- list(col = edgecol)
}
return(node)
}
dnd <- dendrapply(dnd, color_dendro, colormap = colormap)
## Plot the dendrogram
plot(dnd)
The function you are looking for is color_brances from the dendextend R package, using the arguments clusters and col. Here is an example (based on Shaun Wilkinson's example):
library(cluster)
set.seed(999)
iris2 <- iris[sample(x = 1:150,size = 50,replace = F),]
clust <- diana(iris2)
dend <- as.dendrogram(clust)
temp_col <- c("red", "blue", "green")[as.numeric(iris2$Species)]
temp_col <- temp_col[order.dendrogram(dend)]
temp_col <- factor(temp_col, unique(temp_col))
library(dendextend)
dend %>% color_branches(clusters = as.numeric(temp_col), col = levels(temp_col)) %>%
set("labels_colors", as.character(temp_col)) %>%
plot
there are suspicions that misunderstood the question however I'll try to answer:
from my previous objectives were rewritten by the example of iris
clrs <- rainbow(n = 3) # create palette
clrs <- clrs[iris$Species] # assign colors
plot(x = iris$Sepal.Length,y = iris$Sepal.Width,col=clrs) # simple test colors
# cluster
dt <- cbind(iris,clrs)
dt <- dt[sample(x = 1:150,size = 50,replace = F),] # create short dataset for visualization convenience
empty.labl <- gsub("."," ",dt$Species) # create a space vector with length of names intended for reserve place to future text labels
dst <- dist(x = scale(dt[,1:4]),method = "manhattan")
hcl <- hclust(d = dst,method = "complete")
plot(hcl,hang=-1,cex=1,labels = empty.labl, xlab = NA,sub=NA)
dt <- dt[hcl$order,] # sort rows for order objects in dendrogramm
text(x = seq(nrow(dt)), y=-.5,labels = dt$Species,srt=90,cex=.8,xpd=NA,adj=c(1,0.7),col=as.character(dt$clrs))

R plotly heatmap tick labels being cutoff

Trying to produce a gene-expression heatmap using R's plotly. The gene names are quite long and the dimensions are quite big:
require(permute)
require(plotly)
set.seed(1)
mat <- matrix(shuffle(c(rnorm(5000,2,1),rnorm(5000,-2,1))),nrow=2500,ncol=4)
rownames(mat) <- paste("very_long_gene_name",1:2500,sep=".")
colnames(mat) <- paste("s",1:4,sep=".")
Clustering:
hc.col <- hclust(dist(t(mat)))
dd.col <- as.dendrogram(hc.col)
col.order <- order.dendrogram(dd.col)
hc.row <- hclust(dist(mat))
dd.row <- as.dendrogram(hc.row)
row.order <- order.dendrogram(dd.row)
mat <- mat[row.order,col.order]
Producing the plot and saving the html file:
heatmap.plotly <- plot_ly(x=colnames(mat),y=rownames(mat),z=mat,type="heatmap",colors=colorRamp(c("darkblue","white","darkred")))
htmlwidgets::saveWidget(heatmap.plotly,"heatmap.plotly.html")
The figure I get has the gene names cut off, and I'm not sure it's presenting all the data:
Any idea how to fix these two issues?
Increase your margins
m <- list(
l = 200,
r = 10,
b = 50,
t = 10,
pad = 2
)
heatmap.plotly <- plot_ly(x=colnames(mat),y=rownames(mat),z=mat,type="heatmap",
colors=colorRamp(c("darkblue","white","darkred"))) %>%
layout(margin = m)
heatmap.plotly

boxplot for only the outliers

Greeting
I would only like to plot the outliers for boxplot
this is my solution but it does not seem to be very efficient or elegant.
Any packages or better code for doing that.
As you can see I am calling boxplot twice to do this
So if my dataset is very big than it will be bad
Thanks
set.seed(1501)
y <- c(4, 0, 7, -5, rnorm(16))
x1 <- c("a", "a", "b", "b", sample(letters[1:5], 16, T))
lab_y <- sample(letters, 20)
datxx <- as.matrix(cbind(y,x1,lab_y))
boxplot_outlier<- function(dat){
bx <- boxplot(as.numeric(dat[,"y"]) ~ dat[,"x1"])
out_label <- c()
for ( i in seq(bx$out)){
out_label[i] <- dat[which(dat[,"y"]==bx$out[i]),"lab_y"]
}
out_label
out_g <- c()
for ( i in seq(bx$out)){
out_g[i] <- dat[which(dat[,"y"]==bx$out[i]),"x1"]
}
out_g
out_y <- c()
for ( i in seq(bx$out)){
out_y[i] <- dat[which(dat[,"y"]==bx$out[i]),"y"]
}
out_y
out_all<-cbind(out_y,out_g,out_label)
out_all <- as.matrix(out_all)
out_g <- as.matrix(out_g)
colnames(out_g)[1]<-"x1"
out_g_x <- out_g[which(!duplicated(out_g[,"x1"]))]
out_g_x <- as.matrix(out_g_x)
colnames(out_g_x)[1]<-"x1"
datsub <- merge(dat,out_g_x,by=c("x1"))
datsub <- as.matrix(datsub)
bx2 <- boxplot(as.numeric(datsub[,"y"]) ~ datsub[,"x1"],data=datsub)
mynum <- cbind(as.numeric(c(1:nrow(out_g_x))),out_g_x)
mynumxx <- merge(x=out_g,y=mynum,by=c("x1"))
colnames(mynumxx)[2]<-"v1"
text(as.numeric(mynumxx[,"v1"])+0.2,as.numeric(out_all[,"out_y"]),out_all[,"out_label"])
}
boxplot_outlier(datxx)
You could use ggplot2 to plot and set the box and lines to a fully transparent colour. Note that you have to put your data into a data.frame for this, which is better anyway, since y is converted to character in a matrix with the other variables.
dat <- data.frame(y,x1,lab_y)
ggplot(as.data.frame(dat), aes(x=x1,y=y)) + geom_boxplot(fill="#00000000",colour="#00000000")

Resources