I want to make a legend for the color annotation blocks at right-side of the complexheatmap graph
library(ComplexHeatmap)
x11()
#list = c("R","H","K","D",'E','S','T','N','Q','C','G','P','A','V','I','L','M','F','Y','W','O','U','B','Z','X','J')
A = rep("group1", 26)
A[4:5] = "group2"
A[6:9] = "group3"
A[10:12] = "group4"
A[13:20] = "group5"
A[21:26] = "group6"
rnames <- c("+","+","+", "-", "-","δ","δ","δ","δ", "*","*","*","h","h","h","h","h","h","h","h","u","u","u","u","u","u")
ha = rowAnnotation(foo = anno_block(gp = gpar(fill = 2:7)), annotation_legend_param = list(foo = list(labels = c("+ve", "-ve", "polar", "special","hydrophobic","unique"))))
names(rnames) = unique(A)
ht = Heatmap(data2,
name = "Occurance",
cluster_rows = FALSE,
cluster_columns = FALSE,
column_title = "Amino Acid Occurance in Overlapped Region in LCD in Known RBP genes",
row_title = "AA",
column_names_gp = gpar(fontsize = 10),
row_title_gp = gpar(fontsize = 20),
column_names_rot = 90,
row_split = A,
right_annotation = ha,
row_names_side = "left",
row_names_gp = gpar(fontsize = 10),
heatmap_width = unit(12, "cm"),
heatmap_height = unit(12, "cm")
)
ht
and the result of graph is shown at below
As you can see there are 6 different color annotation block shown at right side, I want to make the legend for these 6 block named in order as "+ve", "-ve", "polar", "special","hydrophobic" and "unique". However, the above codes only result in an error of 'Error: Amount of legend params is larger than the number of simple annotations.'
Can anyone tell me and teach me how to do it?
I have 31 samples,and get 31 type of samples, such "a","b","c","d",but when i draw heatmap,it say the subscript out.I have check the columns of the matrix is 31 ,which is the same as the number of types.
ha1 = HeatmapAnnotation( bar = c("b","d","d","b","b","c","b","a","b"
,"b","a","d","b","b","c","c","a","b"
,"d","c","c","d","b","b","b","d","a"
,"c","c","b","c"),
col = list(bar = c("a" = "red", "b" = "green", "c" = "blue","d"="black"))
)
ha = rowAnnotation(foo = anno_mark(at = seq(0,7000,1000), labels = seq(0,7000,1000)))
hist_major <- Heatmap(major,
column_title = "Statistics for a list of SNP.Frequency.major",
column_title_gp = gpar(fontsize = 15, fontface = "bold"),
column_names_gp = gpar(fontsize = 10),
row_title = "Genome Postion(bp)",
row_title_gp = gpar(fontsize = 10),
name = "Variant.Frequency",
cluster_rows = FALSE,
column_order=order(as.numeric(gsub("SAMN041259", "", colnames(major)))),
show_column_dend = FALSE,
right_annotation = ha,
bottom_annotation = ha1,
show_row_names = FALSE,
use_raster= TRUE,
raster_resize_mat = max,
col = cols,
border_gp = gpar(col = "black", lty = 2)
)
This is a simple example that works with your code. Maybe it can help you.
library(ComplexHeatmap)
# Data matrix
major <- matrix(rnorm(3100),ncol=31)
colnames(major) <- paste0("Sample",1:31)
# Your code
ha1 = HeatmapAnnotation( bar = c("b","d","d","b","b","c","b","a","b"
,"b","a","d","b","b","c","c","a","b"
,"d","c","c","d","b","b","b","d","a"
,"c","c","b","c"),
col = list(bar = c("a"="red", "b"="green", "c"="blue", "d"="black"))
)
ticks <- seq(0,100,10)
ticks[1] <- 1
ha = rowAnnotation(foo = anno_mark(at = ticks, labels = ticks))
cols <- heat.colors(20)
hist_major <- Heatmap(major,
column_title = "Statistics for a list of SNP.Frequency.major",
column_title_gp = gpar(fontsize = 15, fontface = "bold"),
column_names_gp = gpar(fontsize = 10),
row_title = "Genome Postion(bp)",
row_title_gp = gpar(fontsize = 10),
name = "Variant\nFrequency",
cluster_rows = FALSE,
column_order=order(as.numeric(gsub("SAMN041259", "", colnames(major)))),
show_column_dend = FALSE,
right_annotation = ha,
bottom_annotation = ha1,
show_row_names = FALSE,
use_raster= TRUE,
raster_resize_mat = max,
col = cols,
border_gp = gpar(col = "black", lty = 2)
)
print(hist_major)
I want to order a Complexheatmap of 4 x heatmaps joined together by a row order which is contained in the 'Order' column of the underlying dataset, however I do not want the order column/data visible in the final graphic.
In effect I want the rows to be the same top to bottom as in this data example, G,Y,K,Z,P,L,V,B,W,O,S,R,X,T (top to bottom),
however when I run my code the row order changes to (top to bottom)
T,K,Z,G,L,V,B,P,Y,S,R,X,O
This is the data -
Name,# V,# O,# I,# S,# R,# E,% W,Order
G,348,0,287,371,392,304,75.522727,1
Y,140,0,85,144,180,103,75.886364,2
K,256,0,197,273,300,214,79.068182,5
Z,225,80,166,238,269,183,80.454545,6
P,174,0,113,183,218,132,82.136364,7
L,170,0,108,176,213,129,75.522727,8
V,170,20,108,176,213,129,80.272727,9
B,167,0,106,171,210,127,3.818182,10
W,167,90,106,171,210,127,100,12
O,12,0,79,12,54,39,80.5,13
S,6,30,77,6,48,35,59.5,14
R,6,0,79,6,49,36,80.454545,15
X,2,50,73,2,45,32,59.772727,19
T,268,0,207,281,311,227,80.522727,20
This is the code -
library("ComplexHeatmap", lib.loc="C:/Users/q805269/Documents/R/R-3.5.1/library")
library("RColorBrewer", lib.loc="C:/Users/q805269/Documents/R/R-3.5.1/library")
library("circlize", lib.loc="C:/Users/q805269/Documents/R/R-3.5.1/library")
library("crayon", lib.loc="C:/Users/q805269/Documents/R/R-3.5.1/library")
library("pillar", lib.loc="C:/Users/q805269/Documents/R/R-3.5.1/library")
library("dplyr", lib.loc="C:/Users/q805269/Documents/R/R-3.5.1/library")
colnames(dataset)[1] <- c("Name")
row.names(dataset) <- dataset$"Name"
merged<-dataset
merged1<-select(merged, "# I","# S","# R","# E")
max_merged1<-as.numeric(max(merged1$"# I"))
max_merged2<-as.numeric(max(merged1$"# S"))
max_merged3<-as.numeric(max(merged1$"# R"))
max_merged4<-as.numeric(max(merged1$"# E"))
max_merged<-as.numeric(max(max_merged2, max_merged1, max_merged3, max_merged4))
rc3<-max_merged==0
if(rc3 == "TRUE") max_merged<-10 else max_merged
mergedvc<-select(merged, "# V")
max_mergedvc<-as.numeric(max(mergedvc$"# V"))
rc2<-max_mergedvc==0
if(rc2 == "TRUE") max_mergedvc<-10 else max_mergedvc
mergedwst <- select(merged, "% W")
max_mergedwst <- as.numeric(max(mergedwst$"% W"))
rc1 <- max_mergedwst==0
if(rc1 == "TRUE") max_mergedwst<-10 else max_mergedwst
mergedord<-select(merged, "# O")
max_mergedord<-as.numeric(max(mergedord$"# O"))
rc<-max_mergedord==0
if(rc == "TRUE") max_mergedord<-10 else max_mergedord
merged2<-as.matrix(merged1)
mergedvc2<-as.matrix(mergedvc)
mergedwst2<-as.matrix(mergedwst)
mergedord2<-as.matrix(mergedord)
ht_global_opt(heatmap_legend_title_gp = gpar(fontsize = 6, fontface = "bold"),
heatmap_legend_labels_gp = gpar(fontsize = 6), heatmap_column_names_gp = gpar(fontsize = 6))
ht1<-Heatmap(merged2,
show_row_dend = FALSE,
show_column_dend = FALSE,
show_row_names = FALSE,
column_names_side = "top",
column_names_gp = gpar(fontsize = 8),
name = "# I,# E,# S,# R",
cell_fun = function(j, i, x, y, width, height, fill)
{
grid.text(sprintf("%.0f", merged2[i, j]), x, y, gp = gpar(fontsize = 8))
},
col = colorRamp2(c(0, max_merged), c(rgb(200/255, 202/255, 201/255),rgb(116/255, 122/255, 119/255))))
ht2<-Heatmap(mergedvc2,
show_row_dend = FALSE,
show_column_dend = FALSE,
row_names_side = "left",
column_names_side = "top",
column_names_gp = gpar(fontsize = 8),
row_names_gp = gpar(fontsize = 8),
name = "# V",
cell_fun = function(j, i, x, y, width, height, fill)
{
grid.text(sprintf("%.0f", mergedvc2[i, j]), x, y,
gp = gpar(fontsize = 8))
},
col = colorRamp2(c(0, max_mergedvc),
c(rgb(185/255, 221/255, 141/255),
rgb(119/255, 188/255, 31/255))))
ht3<-Heatmap(mergedwst2,
show_row_dend = FALSE,
show_column_dend = FALSE,
show_row_names = FALSE,
column_names_side = "top",
column_names_gp = gpar(fontsize = 8),
name = "% W", cell_fun = function(j, i, x, y, width, height, fill)
{
grid.text(sprintf("%.0f", mergedwst2[i, j]), x, y, gp = gpar(fontsize = 8))
},
col = colorRamp2(c(0,max_mergedwst), c( rgb(236/255, 154/255, 169/255),rgb(217/255, 59/255, 86/255))))
ht4<-Heatmap(mergedord2,
show_row_dend = FALSE,
show_column_dend = FALSE,
show_row_names = FALSE,
column_names_side = "top",
column_names_gp = gpar(fontsize = 8),
name = "# O", cell_fun = function(j, i, x, y, width, height, fill) {
grid.text(sprintf("%.0f", mergedord2[i, j]), x, y,
gp = gpar(fontsize = 8))
},
col = colorRamp2(c(0,max_mergedord),
c(rgb(255/255, 207/255, 176/255),
rgb(255/255, 108/255, 12/255))))
ht_list<-ht2+ht4+ht1+ht3
draw(ht_list, gap = unit(0, "cm"))
Got it!
Basically add
cluster_rows = FALSE,
cluster_columns = FALSE,
colnames(dataset)[1] <- c("Name")
row.names(dataset) <- dataset$"Name"
merged<-dataset
merged1<-select(merged, "# I","# S","# R","# E")
max_merged1<-as.numeric(max(merged1$"# I"))
max_merged2<-as.numeric(max(merged1$"# S"))
max_merged3<-as.numeric(max(merged1$"# R"))
max_merged4<-as.numeric(max(merged1$"# E"))
max_merged<-as.numeric(max(max_merged2,max_merged1,max_merged3,max_merged4))
rc3<-max_merged==0
if(rc3 == "TRUE") max_merged<-10 else max_merged
mergedvc<-select(merged, "# V")
max_mergedvc<-as.numeric(max(mergedvc$"# V"))
rc2<-max_mergedvc==0
if(rc2 == "TRUE") max_mergedvc<-10 else max_mergedvc
mergedwst<-select(merged, "% W")
max_mergedwst<-as.numeric(max(mergedwst$"% W"))
rc1<-max_mergedwst==0
if(rc1 == "TRUE") max_mergedwst<-10 else max_mergedwst
mergedord<-select(merged, "# O")
max_mergedord<-as.numeric(max(mergedord$"# O"))
rc<-max_mergedord==0
if(rc == "TRUE") max_mergedord<-10 else max_mergedord
merged2<-as.matrix(merged1)
mergedvc2<-as.matrix(mergedvc)
mergedwst2<-as.matrix(mergedwst)
mergedord2<-as.matrix(mergedord)
ht_global_opt(heatmap_legend_title_gp = gpar(fontsize = 6, fontface = "bold"),
heatmap_legend_labels_gp = gpar(fontsize = 6), heatmap_column_names_gp = gpar(fontsize = 6))
ht1<-Heatmap(merged2,
show_row_dend = FALSE,
show_column_dend = FALSE,
show_row_names = FALSE,
column_names_side = "top",
column_names_gp = gpar(fontsize = 8),
cluster_rows = FALSE,
cluster_columns = FALSE,
name = "# I,# E,# S,# R", cell_fun = function(j, i, x, y, width, height, fill)
{
grid.text(sprintf("%.0f", merged2[i, j]), x, y, gp = gpar(fontsize = 8))
},
col = colorRamp2(c(0, max_merged), c(rgb(200/255, 202/255, 201/255),rgb(116/255, 122/255, 119/255))))
ht2<-Heatmap(mergedvc2,
show_row_dend = FALSE,
show_column_dend = FALSE,
row_names_side = "left",
column_names_side = "top",
column_names_gp = gpar(fontsize = 8),
row_names_gp = gpar(fontsize = 8),
cluster_rows = FALSE,
cluster_columns = FALSE,
name = "# V", cell_fun = function(j, i, x, y, width, height, fill)
{
grid.text(sprintf("%.0f", mergedvc2[i, j]), x, y, gp = gpar(fontsize = 8))
},
col = colorRamp2(c(0, max_mergedvc), c(rgb(185/255, 221/255, 141/255),rgb(119/255, 188/255, 31/255))))
ht3<-Heatmap(mergedwst2,
show_row_dend = FALSE,
show_column_dend = FALSE,
show_row_names = FALSE,
column_names_side = "top",
column_names_gp = gpar(fontsize = 8),
uster_rows = FALSE,
uster_columns = FALSE,
name = "% W", cell_fun = function(j, i, x, y, width, height, fill)
{
grid.text(sprintf("%.0f", mergedwst2[i, j]), x, y, gp = gpar(fontsize = 8))
},
col = colorRamp2(c(0,max_mergedwst), c( rgb(236/255, 154/255, 169/255),rgb(217/255, 59/255, 86/255))))
ht4<-Heatmap(mergedord2,
show_row_dend = FALSE,
show_column_dend = FALSE,
show_row_names = FALSE,
column_names_side = "top",
column_names_gp = gpar(fontsize = 8),
uster_rows = FALSE,
uster_columns = FALSE,
name = "# O", cell_fun = function(j, i, x, y, width, height, fill)
{
grid.text(sprintf("%.0f", mergedord2[i, j]), x, y, gp = gpar(fontsize = 8))
},
col = colorRamp2(c(0,max_mergedord), c( rgb(255/255, 207/255, 176/255),rgb(255/255, 108/255, 12/255))))
ht_list<-ht2+ht4+ht1+ht3
draw(ht_list, gap = unit(0, "cm"))
When creating a table using tableGrob or grid.table.
Is there way to align the text inside the table? First column to the left, and the other columns to the right? Rather than the default "center".
Thank you!
something like this: where I want column "a" alligned to the left.
a <- c("one","two","thirty five")
b <- c(1, 2, 3)
c <- c(4, 5, 6)
data <- data.frame(a,b,c)
windows()
grid.table(
data,
gpar.coretext=gpar(fontsize = 12),
gpar.coltext = gpar(fontsize = 12),
gpar.rowtext = gpar(fontsize = 12),
gpar.corefill =
gpar(fill = "green", alpha = 0.5, col = NA),
h.even.alpha = 0.5,
equal.width = FALSE,
show.rownames = FALSE,
show.vlines = TRUE,
padding.h = unit(15, "mm"),
padding.v = unit(8, "mm")
)
With gridExtra v>=2.0.0, the parameters are now controlled via nested lists (themes),
library(gridExtra)
library(grid)
n=5
d <- data.frame(x=rnorm(n),y=rnorm(n),z=sample(letters[1:2],n,replace=T))
m <- format(d, digits = 1, scientific=F,big.mark = ",")
mytheme <- ttheme_default(core = list(fg_params = list(hjust=0, x=0.1,
fontsize=8)),
colhead = list(fg_params = list(fontsize=9,
fontface="bold"))
)
g1 <- tableGrob(m, theme = mytheme, rows=NULL)
grid.newpage()
grid.draw(g1)
Is this what you are looking for? There is a core.just parameter of the format() call.
require("gridExtra")
n=5
df<- data.frame(x=rnorm(n),y=rnorm(n),z=sample(letters[1:2],n,replace=T))
g1<-tableGrob(
format(df, digits = 1,
scientific=F,big.mark = ","),
core.just="left",
#core.just="right",
#col.just="right",
gpar.coretext=gpar(fontsize=8),
gpar.coltext=gpar(fontsize=9, fontface='bold'),
show.rownames = F,
h.even.alpha = 0,
gpar.rowtext = gpar(col="black", cex=0.7,
equal.width = TRUE,
show.vlines = TRUE,
show.hlines = TRUE,
separator="grey")
)
grid.draw(g1)
To set a "transparent" background, use the ttheme_minimal with hjust to set text alignment.
theme_1 <- ttheme_minimal(core = list(fg_params = list(hjust = 0,
x = 0.1,
fontsize = 9)),
colhead = list(fg_params = list(fontsize = 12,
fontface = "bold")))
You can then apply the theme to the tableGrob like this:
gridExtra::tableGrob(df_tbl, theme = theme_1, rows=NULL)