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
Related
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)
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)
}
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.
I'm using RasterVis and levelplot to make a trellis plot of some rasters. I am currently ok for most things but I would like to change the header for each panel from the filename to a chosen string (the filename is convoluted and long, i want to use just a year, for example '2004').
Looking at the levelplot page, it would indicate that levelplot goes looking for some settings as per the argument 'useRaster', either it goes to panel.levelplot or panel.levelplot.raster, but im struggling to use these latter functions.
Any help much appreciated, here's some sample code;
require(rasterVis)
layers <- c(1:4)
s2 <- stack()
for (i in layers) {
r <- raster(nrows=100, ncols=100,ext)
r[] <- sample(seq(from = 1, to = 6, by = 1), size = 10000, replace = TRUE)
rasc <- ratify(r)
rat <- levels(rasc)[[1]]
rat$legend <- c("A","B","C","D","E","F")
levels(rasc) <- rat
s2 <- stack(s2, rasc)
}
levelplot(s2, col.regions=rev(terrain.colors(6)),main = "example")
In the above e.g., I would like "layer.1.1" to be "2004", and so on through to 2007
require(rasterVis)
layers <- c(1:4)
s2 <- stack()
for (i in layers) {
r <- raster(nrows=100, ncols=100)
r[] <- sample(seq(from = 1, to = 6, by = 1), size = 10000, replace = TRUE)
rasc <- ratify(r)
rat <- levels(rasc)[[1]]
rat$legend <- c("A","B","C","D","E","F")
levels(rasc) <- rat
s2 <- stack(s2, rasc)
}
levelplot(s2, col.regions=rev(terrain.colors(6)),main = "example", names.attr=2004:2007)
p.strip <- list(cex=1.5, lines=1, col="blue", fontfamily='Serif')
levelplot(s2, col.regions=rev(terrain.colors(6)), main = "example",
names.attr=2004:2007, par.strip.text=p.strip)
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")