R/Plot.module.R
In menggf/decd: A tool for differential expression analysis and DEGs based investigation to complex diseases by bi-clustering analysis
Defines functions
Plot.seed.module
Plot.cluster.module
Documented in
Plot.cluster.module
Plot.seed.module
#' Plot the DEGs modules shared by patients
#'
#' Plot the DEGs modules
#'
#' @import ComplexHeatmap
#'
#' @name Plot.seed.module
#' @param res.module a 'seed.module' object returned by \code{\link{seed.module}}
#' @param ann a data.frame for the patient annotation
#' @param deg a "deg" to display. It is returned by \code{\link{bi.deg}}
#' @param col.order the order of column in heatmap
#' @param show.mods a vector, the modules to display
#' @param overlap the similarity cutoff to display as carrying the module
#' @param dissimilarity the similarity cutoff to display as not carrying the module
#' @param max.n the maximum number of modules to display
#' @param type the module type to display
#' @param label.col the color to label
#'
#' @author Guofeng Meng
#'
#' @references
#' Gu Z, Eils R and Schlesner M (2016). “Complex heatmaps reveal patterns and correlations in multidimensional genomic data.” Bioinformatics.
#'
#' @details This function is to display the relationship of the predicted DEG modules and the patients.
#'
#' 'deg' can be set to display the modules from different datasets, e.g. the modules predicted from disease A and display them in the binary DEG matrix of disease B.
#'
#' The output is a heatmap Plot where the modules with maximum observations are showed.
#' @return A heatmap plot
#'
#' @examples
#' \dontrun{
#' Plot.seed.module(seed.mods1, er.ann, max.n=15)
#' Plot.seed.module(res.mods, er.ann, deg=deg, max.n=15)
#' # to display the ER-positive module in all the patients
#' }
#' @export
Plot.seed.module <-function(res.module, ann=NULL, deg=NULL, col.order=NULL, show.mods=NULL, overlap=NULL, dissimilarity=NULL, max.n=min(length(res.module), 30), type=c("model","max.patients", "max.genes")[1], label.col="#008000"){
mods=names(res.module);
mods=mods[mods!="decd.specific" & mods!="decd.input" & mods!="decd.clustering"];
if(!any(c("model","max.patients", "max.genes") == type))
stop("Error: type: should one of model, max.patients and max.genes!")
if(length(mods) == 0)
stop("Error: No module is available");
if(is.null(show.mods)){
show.mods=select.mod(res.module, max.n, type=type)
}
else{
show.mods=show.mods[show.mods%in%mods]
}
if(length(show.mods)<=1)
stop("Error: show.mods: no id is recognized");
if(is.null(deg)){
deg=res.module[["decd.input"]][["deg"]]
}
myges=res.module[["decd.input"]][["genes"]]
pas=colnames(deg);
ges=row.names(deg);
if(is.null(overlap))
overlap=res.module[["decd.input"]][["overlap"]];
if(is.null(dissimilarity)){
mycols=label.col
ck=overlap
mylabs=paste(">= ", ck,sep="")
}
else{
mycols=c(label.col,"yellow")
ck=c(overlap, dissimilarity)
mylabs=paste(c(">= ","< "), ck,sep="")
}
names(mycols) <- mylabs;
alter_fun = list();
alter_fun[["background"]] = function(x, y, w, h) {
grid.rect(x, y, w-unit(0.5, "mm"), h-unit(0.5, "mm"), gp = gpar(fill = "#CCCCCC", col = NA))
};
alter_fun[[mylabs[1]]]=function(x, y, w, h) {
grid.rect(x, y, w-unit(0.5, "mm"), h*0.33, gp = gpar(fill =label.col , col = NA))
};
if(!is.null(dissimilarity))
alter_fun[[mylabs[2]]]=function(x, y, w, h) {
grid.rect(x, y, w-unit(0.5, "mm"), h*0.33, gp = gpar(fill ="yellow" , col = NA))
};
mat.shared=t(sapply(show.mods, function(x) {
seed=res.module[[x]][["seed"]];
if(x=="M0"){
#used.ges=res.module[[x]][["max.patients"]][["genes"]] #module genes
used.ges=res.module[[x]][[type]][["genes"]]
}else{
used.ges=res.module[[x]][[type]][["genes"]]
}
if(length(used.ges[used.ges%in%ges])/length(used.ges) < 0.5){
stop("Error: 'deg': >50% of module genes are not observed")
}
if(length(used.ges[used.ges%in%ges])/length(used.ges) < 0.8){
print("'deg': >20% of module genes are not observed")
}
used.seed=seed[used.ges];
sub.deg=deg[used.ges,]
sims=apply(sub.deg, 2 , function(z) length(which( z == used.seed))/length(used.seed));
rr=rep("", length(pas));
rr[sims >= overlap]=mylabs[1];
if(!is.null(dissimilarity))
rr[sims < dissimilarity ]=mylabs[2];
return(rr);
}))
len=sapply(show.mods, function(x) {
if(is.null(res.module[[x]][[type]]))
return(0)
if(x=="M0"){
#return(length(res.module[[x]][["max.patients"]][["genes"]]));
return(length(res.module[[x]][[type]][["genes"]]));
}else{
return(length(res.module[[x]][[type]][["genes"]]));
}
})
ha=NULL;
if(!is.null(ann)){
has.pas=row.names(ann);
if(length(which(has.pas%in%pas)) < 0.6 *length(pas))
print("Warning: ann: Too few patients has annotation");
if(length(which(has.pas%in%pas)) < 0.3 *length(pas))
stop("Error: ann: Too few patients has annotation");
ann.all=as.vector(as.matrix(ann));
ann.all=ann.all[!is.na(ann.all)];
cl=rainbow(length(unique(ann.all)))
names(cl)<-unique(ann.all)
col.list=lapply(names(ann), function(x) {
has.ann=unique(as.vector(as.matrix(ann[,x])))
has.ann=has.ann[!is.na(has.ann)]
return(cl[has.ann])
});
names(col.list)<-names(ann)
if(dim(ann)[2]==1){
new.ann=as.data.frame(ann[pas,])
row.names(new.ann)<-pas;
names(new.ann)<-names(ann);
}else{
new.ann=ann[pas,]
}
ha=HeatmapAnnotation(df=new.ann, annotation_height=0.2, name=names(ann), col=col.list)
}
row.names(mat.shared)<-paste(show.mods, "(", len,")",sep="")
colnames(mat.shared)<-pas
if(!is.null(ha)){
if(is.null(col.order)){
if(is.null(dissimilarity)){
oncoPrint(mat.shared, get_type = function(x) strsplit(x, ";")[[1]], bottom_annotation=ha, alter_fun = alter_fun, col = mycols, column_title = "", show_heatmap_legend = FALSE)
}else{
oncoPrint(mat.shared, get_type = function(x) strsplit(x, ";")[[1]], bottom_annotation=ha, alter_fun = alter_fun, col = mycols, column_title = "", show_heatmap_legend = TRUE, heatmap_legend_param = list(title = "Overlap"), show_pct=FALSE)
}
}
else{
if(is.null(dissimilarity)){
oncoPrint(mat.shared, get_type = function(x) strsplit(x, ";")[[1]], column_order=col.order, bottom_annotation=ha, alter_fun = alter_fun, col = mycols, column_title = "", show_heatmap_legend = FALSE)
}else{
oncoPrint(mat.shared, get_type = function(x) strsplit(x, ";")[[1]], column_order=col.order, bottom_annotation=ha, alter_fun = alter_fun, col = mycols, column_title = "", show_heatmap_legend = TRUE, heatmap_legend_param = list(title = "Overlap"), show_pct=FALSE)
}
}
}
else{
if(is.null(col.order)){
if(is.null(dissimilarity)){
oncoPrint(mat.shared, get_type = function(x) strsplit(x, ";")[[1]], alter_fun = alter_fun, col = mycols, column_title = "", show_heatmap_legend = FALSE)
}
else{
oncoPrint(mat.shared, get_type = function(x) strsplit(x, ";")[[1]], alter_fun = alter_fun, col = mycols, column_title = "", show_heatmap_legend = TRUE, heatmap_legend_param = list(title = "Overlap"), show_pct=FALSE)
}
}
else{
if(is.null(dissimilarity)){
oncoPrint(mat.shared, get_type = function(x) strsplit(x, ";")[[1]], column_order=col.order, alter_fun = alter_fun, col = mycols, column_title = "", show_heatmap_legend = FALSE)
} else {
oncoPrint(mat.shared, get_type = function(x) strsplit(x, ";")[[1]], column_order=col.order, alter_fun = alter_fun, col = mycols, column_title = "", show_heatmap_legend = TRUE, heatmap_legend_param = list(title = "Overlap"), show_pct=FALSE)
}
}
}
}
#' Plot the DEGs modules
#'
#' Plot the DEGs modules
#'
#' @import ComplexHeatmap
#' @name Plot.cluster.module
#' @param res.module a 'cluster.module' object returned by \code{\link{cluster.module}}
#' @param ann a data.frame for the patient annotation
#' @param deg a "deg" to display. It is returned by \code{\link{bi.deg}}
#' @param col.order the order of column in heatmap
#' @param show.mods a vector, the modules to display
#' @param overlap the similarity cutoff to display as carrying the module
#' @param dissimilarity the similarity cutoff to display as not carrying the module
#' @param max.n the maximum number of modules to display
#' @param type the module type to display
#' @param label.col the color to label
#'
#' @author Guofeng Meng
#'
#' @references
#' Gu Z, Eils R and Schlesner M (2016). “Complex heatmaps reveal patterns and correlations in multidimensional genomic data.” Bioinformatics.
#'
#' @details This function is to dispaly the relationship of the predicted DEG modules and the patients.
#'
#' 'deg' can be set to display the modules from different datasets, e.g. the modules predicted from disease A and display them in the binary DEG matrix of disease B.
#'
#' The output is a heatmap Plot where the modules with maximum observations are showed.
#' @return A heatmap plot
#'
#' @examples
#' \dontrun{
#' Plot(cluster.mods1, er.ann, max.n=15)
#' Plot(cluster.mods2, er.ann, deg=deg, max.n=15)
#' # to display the ER-positive module in all the patients
#' }
#' @export
#'
Plot.cluster.module <-function(res.module, ann=NULL, deg=NULL, col.order=NULL, show.mods=NULL, overlap=NULL, dissimilarity=NULL, max.n=min(length(res.module), 30), type=c("model","max.patients", "max.genes")[1], label.col="#008000"){
mods=names(res.module);
mods=mods[mods!="decd.specific" & mods!="decd.input" & mods!="decd.clustering"];
if(!any(c("model","max.patients", "max.genes") == type))
stop("Error: type: should one of model, max.patients and max.genes!")
if(length(mods) == 0)
step("Error: No module is available");
if(is.null(show.mods)){
show.mods=select.mod(res.module, max.n, type=type)
}
else{
show.mods=show.mods[show.mods%in%mods]
}
if(length(show.mods)<=1)
stop("Error: show.mods: no id is recognized");
if(is.null(deg)){
deg=res.module[["decd.input"]][["deg"]][, res.module[["decd.input"]][["test.patients"]]]
}
myges=res.module[["decd.input"]][["genes"]]
pas=colnames(deg);
ges=row.names(deg);
if(is.null(overlap))
overlap=res.module[["decd.input"]][["overlap"]];
if(is.null(dissimilarity)){
mycols=label.col
ck=overlap
mylabs=paste(">= ", ck,sep="")
}
else{
mycols=c(label.col,"yellow")
ck=c(overlap, dissimilarity)
mylabs=paste(c(">= ","< "), ck,sep="")
}
names(mycols) <- mylabs;
alter_fun = list();
alter_fun[["background"]] = function(x, y, w, h) {
grid.rect(x, y, w-unit(0.5, "mm"), h-unit(0.5, "mm"), gp = gpar(fill = "#CCCCCC", col = NA))
};
alter_fun[[mylabs[1]]]=function(x, y, w, h) {
grid.rect(x, y, w-unit(0.5, "mm"), h*0.33, gp = gpar(fill =label.col , col = NA))
};
if(!is.null(dissimilarity))
alter_fun[[mylabs[2]]]=function(x, y, w, h) {
grid.rect(x, y, w-unit(0.5, "mm"), h*0.33, gp = gpar(fill ="yellow" , col = NA))
};
mat.shared=t(sapply(show.mods, function(x) {
seed=res.module[[x]][["seed"]];
if(x=="M0"){
#used.ges=res.module[[x]][["max.patients"]][["genes"]] #module genes
used.ges=res.module[[x]][[type]][["genes"]]
}else{
used.ges=res.module[[x]][[type]][["genes"]]
}
if(length(used.ges[used.ges%in%ges])/length(used.ges) < 0.5){
stop("Error: 'deg': >50% of module genes are not observed")
}
if(length(used.ges[used.ges%in%ges])/length(used.ges) < 0.8){
print("'deg': >20% of module genes are not observed")
}
used.seed=seed[used.ges];
sub.deg=deg[used.ges,]
sims=apply(sub.deg, 2 , function(z) length(which( z == used.seed))/length(used.seed));
rr=rep("", length(pas));
rr[sims >= overlap]=mylabs[1];
if(!is.null(dissimilarity))
rr[sims < dissimilarity ]=mylabs[2];
return(rr);
}))
len=sapply(show.mods, function(x) {
if(is.null(res.module[[x]][[type]]))
return(0)
if(x=="M0"){
#return(length(res.module[[x]][["max.patients"]][["genes"]]));
return(length(res.module[[x]][[type]][["genes"]]));
}else{
return(length(res.module[[x]][[type]][["genes"]]));
}
})
ha=NULL;
if(!is.null(ann)){
has.pas=row.names(ann);
if(length(which(has.pas%in%pas)) < 0.6 *length(pas))
print("Warning: ann: Too few patients has annotation");
if(length(which(has.pas%in%pas)) < 0.3 *length(pas))
stop("Error: ann: Too few patients has annotation");
ann.all=as.vector(as.matrix(ann));
ann.all=ann.all[!is.na(ann.all)];
cl=rainbow(length(unique(ann.all)))
names(cl)<-unique(ann.all)
col.list=lapply(names(ann), function(x) {
has.ann=unique(as.vector(as.matrix(ann[,x])))
has.ann=has.ann[!is.na(has.ann)]
return(cl[has.ann])
});
names(col.list)<-names(ann)
if(dim(ann)[2]==1){
new.ann=as.data.frame(ann[pas,])
row.names(new.ann)<-pas;
names(new.ann)<-names(ann);
}else{
new.ann=ann[pas,]
}
ha=HeatmapAnnotation(df=new.ann, annotation_height=0.2, name=names(ann), col=col.list)
}
row.names(mat.shared)<-paste(show.mods, "(", len,")",sep="")
colnames(mat.shared)<-pas
if(!is.null(ha)){
if(is.null(col.order)){
if(is.null(dissimilarity)){
oncoPrint(mat.shared, get_type = function(x) strsplit(x, ";")[[1]],
bottom_annotation=ha, alter_fun = alter_fun, col = mycols,
column_title = "", show_heatmap_legend = FALSE)
}else{
oncoPrint(mat.shared, get_type = function(x) strsplit(x, ";")[[1]],
bottom_annotation=ha, alter_fun = alter_fun, col = mycols,
column_title = "", show_heatmap_legend = TRUE,
heatmap_legend_param = list(title = "Overlap"), show_pct=FALSE)
}
}
else{
if(is.null(dissimilarity)){
oncoPrint(mat.shared, get_type = function(x) strsplit(x, ";")[[1]],
column_order=col.order, bottom_annotation=ha, alter_fun = alter_fun,
col = mycols, column_title = "", show_heatmap_legend = FALSE)
}else{
oncoPrint(mat.shared, get_type = function(x) strsplit(x, ";")[[1]],
column_order=col.order, bottom_annotation=ha, alter_fun = alter_fun,
col = mycols, column_title = "", show_heatmap_legend = TRUE,
heatmap_legend_param = list(title = "Overlap"), show_pct=FALSE)
}
}
}
else{
if(is.null(col.order)){
if(is.null(dissimilarity)){
oncoPrint(mat.shared, get_type = function(x) strsplit(x, ";")[[1]],
alter_fun = alter_fun, col = mycols, column_title = "",
show_heatmap_legend = FALSE)
}
else{
oncoPrint(mat.shared, get_type = function(x) strsplit(x, ";")[[1]],
alter_fun = alter_fun, col = mycols, column_title = "",
show_heatmap_legend = TRUE, heatmap_legend_param = list(title = "Overlap"),
show_pct=FALSE)
}
}
else{
if(is.null(dissimilarity)){
oncoPrint(mat.shared, get_type = function(x) strsplit(x, ";")[[1]],
column_order=col.order, alter_fun = alter_fun, col = mycols,
column_title = "", show_heatmap_legend = FALSE)
} else {
oncoPrint(mat.shared, get_type = function(x) strsplit(x, ";")[[1]], column_order=col.order, alter_fun = alter_fun, col = mycols, column_title = "", show_heatmap_legend = TRUE, heatmap_legend_param = list(title = "Overlap"), show_pct=FALSE)
}
}
}
}
menggf/decd documentation built on Jan. 2, 2020, 12:53 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions Plot.seed.module Plot.cluster.module
Documented in Plot.cluster.module Plot.seed.module
#' Plot the DEGs modules shared by patients
#'
#' Plot the DEGs modules
#'
#' @import ComplexHeatmap
#'
#' @name Plot.seed.module
#' @param res.module a 'seed.module' object returned by \code{\link{seed.module}}
#' @param ann a data.frame for the patient annotation
#' @param deg a "deg" to display. It is returned by \code{\link{bi.deg}}
#' @param col.order the order of column in heatmap
#' @param show.mods a vector, the modules to display
#' @param overlap the similarity cutoff to display as carrying the module
#' @param dissimilarity the similarity cutoff to display as not carrying the module
#' @param max.n the maximum number of modules to display
#' @param type the module type to display
#' @param label.col the color to label
#'
#' @author Guofeng Meng
#'
#' @references
#' Gu Z, Eils R and Schlesner M (2016). “Complex heatmaps reveal patterns and correlations in multidimensional genomic data.” Bioinformatics.
#'
#' @details This function is to display the relationship of the predicted DEG modules and the patients.
#'
#' 'deg' can be set to display the modules from different datasets, e.g. the modules predicted from disease A and display them in the binary DEG matrix of disease B.
#'
#' The output is a heatmap Plot where the modules with maximum observations are showed.
#' @return A heatmap plot
#'
#' @examples
#' \dontrun{
#' Plot.seed.module(seed.mods1, er.ann, max.n=15)
#' Plot.seed.module(res.mods, er.ann, deg=deg, max.n=15)
#' # to display the ER-positive module in all the patients
#' }
#' @export
Plot.seed.module <-function(res.module, ann=NULL, deg=NULL, col.order=NULL, show.mods=NULL, overlap=NULL, dissimilarity=NULL, max.n=min(length(res.module), 30), type=c("model","max.patients", "max.genes")[1], label.col="#008000"){
mods=names(res.module);
mods=mods[mods!="decd.specific" & mods!="decd.input" & mods!="decd.clustering"];
if(!any(c("model","max.patients", "max.genes") == type))
stop("Error: type: should one of model, max.patients and max.genes!")
if(length(mods) == 0)
stop("Error: No module is available");
if(is.null(show.mods)){
show.mods=select.mod(res.module, max.n, type=type)
}
else{
show.mods=show.mods[show.mods%in%mods]
}
if(length(show.mods)<=1)
stop("Error: show.mods: no id is recognized");
if(is.null(deg)){
deg=res.module[["decd.input"]][["deg"]]
}
myges=res.module[["decd.input"]][["genes"]]
pas=colnames(deg);
ges=row.names(deg);
if(is.null(overlap))
overlap=res.module[["decd.input"]][["overlap"]];
if(is.null(dissimilarity)){
mycols=label.col
ck=overlap
mylabs=paste(">= ", ck,sep="")
}
else{
mycols=c(label.col,"yellow")
ck=c(overlap, dissimilarity)
mylabs=paste(c(">= ","< "), ck,sep="")
}
names(mycols) <- mylabs;
alter_fun = list();
alter_fun[["background"]] = function(x, y, w, h) {
grid.rect(x, y, w-unit(0.5, "mm"), h-unit(0.5, "mm"), gp = gpar(fill = "#CCCCCC", col = NA))
};
alter_fun[[mylabs[1]]]=function(x, y, w, h) {
grid.rect(x, y, w-unit(0.5, "mm"), h*0.33, gp = gpar(fill =label.col , col = NA))
};
if(!is.null(dissimilarity))
alter_fun[[mylabs[2]]]=function(x, y, w, h) {
grid.rect(x, y, w-unit(0.5, "mm"), h*0.33, gp = gpar(fill ="yellow" , col = NA))
};
mat.shared=t(sapply(show.mods, function(x) {
seed=res.module[[x]][["seed"]];
if(x=="M0"){
#used.ges=res.module[[x]][["max.patients"]][["genes"]] #module genes
used.ges=res.module[[x]][[type]][["genes"]]
}else{
used.ges=res.module[[x]][[type]][["genes"]]
}
if(length(used.ges[used.ges%in%ges])/length(used.ges) < 0.5){
stop("Error: 'deg': >50% of module genes are not observed")
}
if(length(used.ges[used.ges%in%ges])/length(used.ges) < 0.8){
print("'deg': >20% of module genes are not observed")
}
used.seed=seed[used.ges];
sub.deg=deg[used.ges,]
sims=apply(sub.deg, 2 , function(z) length(which( z == used.seed))/length(used.seed));
rr=rep("", length(pas));
rr[sims >= overlap]=mylabs[1];
if(!is.null(dissimilarity))
rr[sims < dissimilarity ]=mylabs[2];
return(rr);
}))
len=sapply(show.mods, function(x) {
if(is.null(res.module[[x]][[type]]))
return(0)
if(x=="M0"){
#return(length(res.module[[x]][["max.patients"]][["genes"]]));
return(length(res.module[[x]][[type]][["genes"]]));
}else{
return(length(res.module[[x]][[type]][["genes"]]));
}
})
ha=NULL;
if(!is.null(ann)){
has.pas=row.names(ann);
if(length(which(has.pas%in%pas)) < 0.6 *length(pas))
print("Warning: ann: Too few patients has annotation");
if(length(which(has.pas%in%pas)) < 0.3 *length(pas))
stop("Error: ann: Too few patients has annotation");
ann.all=as.vector(as.matrix(ann));
ann.all=ann.all[!is.na(ann.all)];
cl=rainbow(length(unique(ann.all)))
names(cl)<-unique(ann.all)
col.list=lapply(names(ann), function(x) {
has.ann=unique(as.vector(as.matrix(ann[,x])))
has.ann=has.ann[!is.na(has.ann)]
return(cl[has.ann])
});
names(col.list)<-names(ann)
if(dim(ann)[2]==1){
new.ann=as.data.frame(ann[pas,])
row.names(new.ann)<-pas;
names(new.ann)<-names(ann);
}else{
new.ann=ann[pas,]
}
ha=HeatmapAnnotation(df=new.ann, annotation_height=0.2, name=names(ann), col=col.list)
}
row.names(mat.shared)<-paste(show.mods, "(", len,")",sep="")
colnames(mat.shared)<-pas
if(!is.null(ha)){
if(is.null(col.order)){
if(is.null(dissimilarity)){
oncoPrint(mat.shared, get_type = function(x) strsplit(x, ";")[[1]], bottom_annotation=ha, alter_fun = alter_fun, col = mycols, column_title = "", show_heatmap_legend = FALSE)
}else{
oncoPrint(mat.shared, get_type = function(x) strsplit(x, ";")[[1]], bottom_annotation=ha, alter_fun = alter_fun, col = mycols, column_title = "", show_heatmap_legend = TRUE, heatmap_legend_param = list(title = "Overlap"), show_pct=FALSE)
}
}
else{
if(is.null(dissimilarity)){
oncoPrint(mat.shared, get_type = function(x) strsplit(x, ";")[[1]], column_order=col.order, bottom_annotation=ha, alter_fun = alter_fun, col = mycols, column_title = "", show_heatmap_legend = FALSE)
}else{
oncoPrint(mat.shared, get_type = function(x) strsplit(x, ";")[[1]], column_order=col.order, bottom_annotation=ha, alter_fun = alter_fun, col = mycols, column_title = "", show_heatmap_legend = TRUE, heatmap_legend_param = list(title = "Overlap"), show_pct=FALSE)
}
}
}
else{
if(is.null(col.order)){
if(is.null(dissimilarity)){
oncoPrint(mat.shared, get_type = function(x) strsplit(x, ";")[[1]], alter_fun = alter_fun, col = mycols, column_title = "", show_heatmap_legend = FALSE)
}
else{
oncoPrint(mat.shared, get_type = function(x) strsplit(x, ";")[[1]], alter_fun = alter_fun, col = mycols, column_title = "", show_heatmap_legend = TRUE, heatmap_legend_param = list(title = "Overlap"), show_pct=FALSE)
}
}
else{
if(is.null(dissimilarity)){
oncoPrint(mat.shared, get_type = function(x) strsplit(x, ";")[[1]], column_order=col.order, alter_fun = alter_fun, col = mycols, column_title = "", show_heatmap_legend = FALSE)
} else {
oncoPrint(mat.shared, get_type = function(x) strsplit(x, ";")[[1]], column_order=col.order, alter_fun = alter_fun, col = mycols, column_title = "", show_heatmap_legend = TRUE, heatmap_legend_param = list(title = "Overlap"), show_pct=FALSE)
}
}
}
}
#' Plot the DEGs modules
#'
#' Plot the DEGs modules
#'
#' @import ComplexHeatmap
#' @name Plot.cluster.module
#' @param res.module a 'cluster.module' object returned by \code{\link{cluster.module}}
#' @param ann a data.frame for the patient annotation
#' @param deg a "deg" to display. It is returned by \code{\link{bi.deg}}
#' @param col.order the order of column in heatmap
#' @param show.mods a vector, the modules to display
#' @param overlap the similarity cutoff to display as carrying the module
#' @param dissimilarity the similarity cutoff to display as not carrying the module
#' @param max.n the maximum number of modules to display
#' @param type the module type to display
#' @param label.col the color to label
#'
#' @author Guofeng Meng
#'
#' @references
#' Gu Z, Eils R and Schlesner M (2016). “Complex heatmaps reveal patterns and correlations in multidimensional genomic data.” Bioinformatics.
#'
#' @details This function is to dispaly the relationship of the predicted DEG modules and the patients.
#'
#' 'deg' can be set to display the modules from different datasets, e.g. the modules predicted from disease A and display them in the binary DEG matrix of disease B.
#'
#' The output is a heatmap Plot where the modules with maximum observations are showed.
#' @return A heatmap plot
#'
#' @examples
#' \dontrun{
#' Plot(cluster.mods1, er.ann, max.n=15)
#' Plot(cluster.mods2, er.ann, deg=deg, max.n=15)
#' # to display the ER-positive module in all the patients
#' }
#' @export
#'
Plot.cluster.module <-function(res.module, ann=NULL, deg=NULL, col.order=NULL, show.mods=NULL, overlap=NULL, dissimilarity=NULL, max.n=min(length(res.module), 30), type=c("model","max.patients", "max.genes")[1], label.col="#008000"){
mods=names(res.module);
mods=mods[mods!="decd.specific" & mods!="decd.input" & mods!="decd.clustering"];
if(!any(c("model","max.patients", "max.genes") == type))
stop("Error: type: should one of model, max.patients and max.genes!")
if(length(mods) == 0)
step("Error: No module is available");
if(is.null(show.mods)){
show.mods=select.mod(res.module, max.n, type=type)
}
else{
show.mods=show.mods[show.mods%in%mods]
}
if(length(show.mods)<=1)
stop("Error: show.mods: no id is recognized");
if(is.null(deg)){
deg=res.module[["decd.input"]][["deg"]][, res.module[["decd.input"]][["test.patients"]]]
}
myges=res.module[["decd.input"]][["genes"]]
pas=colnames(deg);
ges=row.names(deg);
if(is.null(overlap))
overlap=res.module[["decd.input"]][["overlap"]];
if(is.null(dissimilarity)){
mycols=label.col
ck=overlap
mylabs=paste(">= ", ck,sep="")
}
else{
mycols=c(label.col,"yellow")
ck=c(overlap, dissimilarity)
mylabs=paste(c(">= ","< "), ck,sep="")
}
names(mycols) <- mylabs;
alter_fun = list();
alter_fun[["background"]] = function(x, y, w, h) {
grid.rect(x, y, w-unit(0.5, "mm"), h-unit(0.5, "mm"), gp = gpar(fill = "#CCCCCC", col = NA))
};
alter_fun[[mylabs[1]]]=function(x, y, w, h) {
grid.rect(x, y, w-unit(0.5, "mm"), h*0.33, gp = gpar(fill =label.col , col = NA))
};
if(!is.null(dissimilarity))
alter_fun[[mylabs[2]]]=function(x, y, w, h) {
grid.rect(x, y, w-unit(0.5, "mm"), h*0.33, gp = gpar(fill ="yellow" , col = NA))
};
mat.shared=t(sapply(show.mods, function(x) {
seed=res.module[[x]][["seed"]];
if(x=="M0"){
#used.ges=res.module[[x]][["max.patients"]][["genes"]] #module genes
used.ges=res.module[[x]][[type]][["genes"]]
}else{
used.ges=res.module[[x]][[type]][["genes"]]
}
if(length(used.ges[used.ges%in%ges])/length(used.ges) < 0.5){
stop("Error: 'deg': >50% of module genes are not observed")
}
if(length(used.ges[used.ges%in%ges])/length(used.ges) < 0.8){
print("'deg': >20% of module genes are not observed")
}
used.seed=seed[used.ges];
sub.deg=deg[used.ges,]
sims=apply(sub.deg, 2 , function(z) length(which( z == used.seed))/length(used.seed));
rr=rep("", length(pas));
rr[sims >= overlap]=mylabs[1];
if(!is.null(dissimilarity))
rr[sims < dissimilarity ]=mylabs[2];
return(rr);
}))
len=sapply(show.mods, function(x) {
if(is.null(res.module[[x]][[type]]))
return(0)
if(x=="M0"){
#return(length(res.module[[x]][["max.patients"]][["genes"]]));
return(length(res.module[[x]][[type]][["genes"]]));
}else{
return(length(res.module[[x]][[type]][["genes"]]));
}
})
ha=NULL;
if(!is.null(ann)){
has.pas=row.names(ann);
if(length(which(has.pas%in%pas)) < 0.6 *length(pas))
print("Warning: ann: Too few patients has annotation");
if(length(which(has.pas%in%pas)) < 0.3 *length(pas))
stop("Error: ann: Too few patients has annotation");
ann.all=as.vector(as.matrix(ann));
ann.all=ann.all[!is.na(ann.all)];
cl=rainbow(length(unique(ann.all)))
names(cl)<-unique(ann.all)
col.list=lapply(names(ann), function(x) {
has.ann=unique(as.vector(as.matrix(ann[,x])))
has.ann=has.ann[!is.na(has.ann)]
return(cl[has.ann])
});
names(col.list)<-names(ann)
if(dim(ann)[2]==1){
new.ann=as.data.frame(ann[pas,])
row.names(new.ann)<-pas;
names(new.ann)<-names(ann);
}else{
new.ann=ann[pas,]
}
ha=HeatmapAnnotation(df=new.ann, annotation_height=0.2, name=names(ann), col=col.list)
}
row.names(mat.shared)<-paste(show.mods, "(", len,")",sep="")
colnames(mat.shared)<-pas
if(!is.null(ha)){
if(is.null(col.order)){
if(is.null(dissimilarity)){
oncoPrint(mat.shared, get_type = function(x) strsplit(x, ";")[[1]],
bottom_annotation=ha, alter_fun = alter_fun, col = mycols,
column_title = "", show_heatmap_legend = FALSE)
}else{
oncoPrint(mat.shared, get_type = function(x) strsplit(x, ";")[[1]],
bottom_annotation=ha, alter_fun = alter_fun, col = mycols,
column_title = "", show_heatmap_legend = TRUE,
heatmap_legend_param = list(title = "Overlap"), show_pct=FALSE)
}
}
else{
if(is.null(dissimilarity)){
oncoPrint(mat.shared, get_type = function(x) strsplit(x, ";")[[1]],
column_order=col.order, bottom_annotation=ha, alter_fun = alter_fun,
col = mycols, column_title = "", show_heatmap_legend = FALSE)
}else{
oncoPrint(mat.shared, get_type = function(x) strsplit(x, ";")[[1]],
column_order=col.order, bottom_annotation=ha, alter_fun = alter_fun,
col = mycols, column_title = "", show_heatmap_legend = TRUE,
heatmap_legend_param = list(title = "Overlap"), show_pct=FALSE)
}
}
}
else{
if(is.null(col.order)){
if(is.null(dissimilarity)){
oncoPrint(mat.shared, get_type = function(x) strsplit(x, ";")[[1]],
alter_fun = alter_fun, col = mycols, column_title = "",
show_heatmap_legend = FALSE)
}
else{
oncoPrint(mat.shared, get_type = function(x) strsplit(x, ";")[[1]],
alter_fun = alter_fun, col = mycols, column_title = "",
show_heatmap_legend = TRUE, heatmap_legend_param = list(title = "Overlap"),
show_pct=FALSE)
}
}
else{
if(is.null(dissimilarity)){
oncoPrint(mat.shared, get_type = function(x) strsplit(x, ";")[[1]],
column_order=col.order, alter_fun = alter_fun, col = mycols,
column_title = "", show_heatmap_legend = FALSE)
} else {
oncoPrint(mat.shared, get_type = function(x) strsplit(x, ";")[[1]], column_order=col.order, alter_fun = alter_fun, col = mycols, column_title = "", show_heatmap_legend = TRUE, heatmap_legend_param = list(title = "Overlap"), show_pct=FALSE)
}
}
}
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.