|
a |
|
b/common_scripts/visualisation/plotting_functions.R |
|
|
1 |
|
|
|
2 |
plot.boxplot=function(gene, logicalVectors, names.lv=NULL, clean.name=c("Cancer_", ":::::", "DUFVA_", ".*.:"), data=NULL, matrix=NULL, color.v=NULL, order.bl=F, y.range=NULL, spread=F, sample.annotation=NULL, sample.annotation.color="yellow", N=F,sample.color.continuous=NULL,sample.color.continuous.colors=c("#a52a2a", "#d4d3d1", "#fea719"), sample.color.continuous.breaks=c(0, 0.5, 1), sample.color.continuous.limits=c(0,1), sample.color.continuous.title="CIITA methylation\nbeta value", intercept.y=NULL, intercept.y.2=NULL, ylab="Expression (log2)", outlier.size=0.5) { |
|
|
3 |
library(ggplot2) |
|
|
4 |
|
|
|
5 |
if(is.null(matrix)&is.null(data))stop("No data to plot, check data/matrix") |
|
|
6 |
|
|
|
7 |
if(is.null(names.lv))names.lv=names(logicalVectors) |
|
|
8 |
|
|
|
9 |
if(!all(clean.name=="")|!is.null(clean.name)){ |
|
|
10 |
|
|
|
11 |
clean.name=paste(clean.name, collapse="|") |
|
|
12 |
|
|
|
13 |
title=gsub("N:....:|:::::|DUFVA_|.*.:", "", gene) |
|
|
14 |
names.lv=gsub("Cancer_", " ", names.lv) |
|
|
15 |
|
|
|
16 |
names.lv=gsub(eval(clean.name), "", names.lv) |
|
|
17 |
title=gsub(eval(clean.name), "", title) |
|
|
18 |
|
|
|
19 |
names.lv=gsub("_", " ", names.lv) |
|
|
20 |
title=gsub("_", " ", title) |
|
|
21 |
} |
|
|
22 |
|
|
|
23 |
if(is.null(color.v)){ |
|
|
24 |
# http://tools.medialab.sciences-po.fr/iwanthue/ |
|
|
25 |
color.v=c("#d7a85b", |
|
|
26 |
"#4d56b9", |
|
|
27 |
"#acb839", |
|
|
28 |
"#5e2883", |
|
|
29 |
"#42c87f", |
|
|
30 |
"#bf4da5", |
|
|
31 |
"#75b550", |
|
|
32 |
"#8479e6", |
|
|
33 |
"#cea632", |
|
|
34 |
"#5488e3", |
|
|
35 |
"#d38725", |
|
|
36 |
"#3e397f", |
|
|
37 |
"#a4a94e", |
|
|
38 |
"#be7cde", |
|
|
39 |
"#4d7122", |
|
|
40 |
"#8460b5", |
|
|
41 |
"#62ac6a", |
|
|
42 |
"#86275d", |
|
|
43 |
"#43c8ac", |
|
|
44 |
"#cf483f", |
|
|
45 |
"#748ed7", |
|
|
46 |
"#ca6e37", |
|
|
47 |
"#de91dc", |
|
|
48 |
"#926a26", |
|
|
49 |
"#94589d", |
|
|
50 |
"#822c17", |
|
|
51 |
"#d76092", |
|
|
52 |
"#d2745b", |
|
|
53 |
"#b24258", |
|
|
54 |
"#d35760")[seq(logicalVectors)] |
|
|
55 |
} |
|
|
56 |
|
|
|
57 |
|
|
|
58 |
if(!is.null(matrix)){ |
|
|
59 |
gene2=ifelse(grepl("GEXP", gene), gene, paste0("'N:GEXP:", gene, ":::::'")) |
|
|
60 |
D=as.numeric(read.delim(pipe(paste0("grep -Fw ", gene2, " ", matrix)), row.names = 1, header=F)) |
|
|
61 |
names=scan(pipe(paste0("head -n1 ", matrix)), "n") |
|
|
62 |
} |
|
|
63 |
|
|
|
64 |
if(!is.null(data)){ |
|
|
65 |
if("TP53"%in%colnames(data)){ |
|
|
66 |
D = as.numeric(data[,colnames(data)%in%gene]) |
|
|
67 |
names=colnames(data) |
|
|
68 |
}else{ |
|
|
69 |
D = as.numeric(data[rownames(data)%in%gene,]) |
|
|
70 |
names=colnames(data) |
|
|
71 |
} |
|
|
72 |
|
|
|
73 |
} |
|
|
74 |
|
|
|
75 |
bplot_list=lapply(logicalVectors, function(v){ |
|
|
76 |
D[v] |
|
|
77 |
}) |
|
|
78 |
|
|
|
79 |
if(order.bl){ |
|
|
80 |
ord=sapply(bplot_list, median) |
|
|
81 |
color.v=color.v[order(ord, decreasing = T)] |
|
|
82 |
bplot_list=bplot_list[order(ord, decreasing = T)] |
|
|
83 |
} |
|
|
84 |
|
|
|
85 |
if(!is.null(sample.annotation)){ |
|
|
86 |
sample.annotation=lapply(logicalVectors, function(v){ |
|
|
87 |
D[v]%in%D[names%in%sample.annotation&v] |
|
|
88 |
}) |
|
|
89 |
names(sample.annotation)=gsub("_", " ", names.lv) |
|
|
90 |
if(order.bl)sample.annotation=sample.annotation[order(ord, decreasing = T)] |
|
|
91 |
} |
|
|
92 |
|
|
|
93 |
if(!is.null(sample.color.continuous)){ |
|
|
94 |
sample.color.continuous=lapply(logicalVectors, function(v){ |
|
|
95 |
sample.color.continuous[v] |
|
|
96 |
}) |
|
|
97 |
|
|
|
98 |
if(order.bl)sample.color.continuous=sample.color.continuous[order(ord, decreasing = T)] |
|
|
99 |
} |
|
|
100 |
|
|
|
101 |
if(N){ |
|
|
102 |
names(bplot_list)=paste0(names(bplot_list), " (n=", sapply(logicalVectors, sum, na.rm=T), ")") |
|
|
103 |
} |
|
|
104 |
|
|
|
105 |
plots=plot.boxplot.list(bplot_list, gene, color.v, order.bl, y.range, spread, sample.annotation, sample.annotation.color, sample.color.continuous,sample.color.continuous.colors,sample.color.continuous.breaks,sample.color.continuous.limits,sample.color.continuous.title, intercept.y, intercept.y.2, ylab, outlier.size) |
|
|
106 |
return(plots) |
|
|
107 |
} |
|
|
108 |
|
|
|
109 |
plot.boxplot.list=function(bplot_list, title="boxplot", color.v, order.bl=F, y.range=NULL, spread=F, sample.annotation=NULL, sample.annotation.color="red", sample.color.continuous=NULL,sample.color.continuous.colors=c("#a52a2a", "#d4d3d1", "#fea719"), sample.color.continuous.breaks=c(0, 0.5, 1), sample.color.continuous.limits=c(0,1), sample.color.continuous.title="methylation\nbeta value", intercept.y=NULL, intercept.y.2=NULL, ylab="Expression (log2)", outlier.size=0.5){ |
|
|
110 |
|
|
|
111 |
|
|
|
112 |
if(!is.null(sample.color.continuous)){ |
|
|
113 |
df=data.frame(reshape2::melt(bplot_list), "cont.colorv"=unlist(sample.color.continuous)) |
|
|
114 |
}else{ |
|
|
115 |
df=reshape2::melt(bplot_list) |
|
|
116 |
} |
|
|
117 |
|
|
|
118 |
df$class <- factor(df[,2], levels = unique(as.character(df[,2])),ordered = TRUE) |
|
|
119 |
|
|
|
120 |
df$Expression=as.numeric(as.vector(df[,1])) |
|
|
121 |
|
|
|
122 |
p <- ggplot(data=df, aes(x=class, y=Expression))+stat_boxplot(geom = "errorbar", width = 0.5) |
|
|
123 |
|
|
|
124 |
|
|
|
125 |
if(spread){ |
|
|
126 |
|
|
|
127 |
names(color.v)=levels(df$class) |
|
|
128 |
colScale=scale_colour_manual(name="class", values=color.v) |
|
|
129 |
df$spreadCol=color.v[match(df$class, names(color.v))] |
|
|
130 |
|
|
|
131 |
if(!is.null(sample.annotation)){ |
|
|
132 |
df$spreadCol2=ifelse(melt(sample.annotation)[,1], sample.annotation.color, "grey20") |
|
|
133 |
|
|
|
134 |
p=p+geom_boxplot(size = 0.0001, outlier.colour = NA, outlier.size = 0, fill=unique(df$spreadCol), fatten = 10000)+ |
|
|
135 |
geom_jitter(width = .3, size=outlier.size, shape=21, color="grey20", fill=df$spreadCol2, stroke = 0) |
|
|
136 |
} |
|
|
137 |
|
|
|
138 |
if(is.null(sample.annotation)&!is.null(sample.color.continuous)){ |
|
|
139 |
library(ggnewscale) |
|
|
140 |
|
|
|
141 |
p=p+geom_boxplot(size = 0.0001, outlier.size = 0,outlier.colour = NA,outlier.shape = NA, fill=unique(df$spreadCol), fatten = 10000)+ |
|
|
142 |
scale_fill_manual(values = unique(df$spreadCol), na.value = "#d4d3d1") + # scale for box fill (cancer color) |
|
|
143 |
new_scale_fill() + |
|
|
144 |
geom_jitter(aes(fill = cont.colorv), width = .3, size=outlier.size, shape=21, stroke = 0) + |
|
|
145 |
scale_fill_gradientn(colors = sample.color.continuous.colors, breaks = sample.color.continuous.breaks, limits = sample.color.continuous.limits, guide = "colourbar") + # scale for dot fill (methylation beta value) |
|
|
146 |
guides(fill = guide_colorbar(title = sample.color.continuous.title)) |
|
|
147 |
|
|
|
148 |
} |
|
|
149 |
|
|
|
150 |
if(is.null(sample.annotation)&is.null(sample.color.continuous)){ |
|
|
151 |
p=p+geom_boxplot(size = 0.0001, outlier.colour = NA, outlier.size = 0, fill=unique(df$spreadCol), fatten = 10000)+ |
|
|
152 |
geom_jitter(width = .3, size=outlier.size, shape=21, color="grey20", fill=df$spreadCol) |
|
|
153 |
} |
|
|
154 |
}else{ |
|
|
155 |
p=p+geom_boxplot(size = 0.0001, outlier.colour = "grey20", outlier.size = 1, fill=color.v, fatten = 10000) |
|
|
156 |
} |
|
|
157 |
|
|
|
158 |
if(!is.null(intercept.y)) p=p+geom_hline(yintercept=intercept.y, linetype="dashed", color = "red") |
|
|
159 |
if(!is.null(intercept.y.2)) p=p+geom_hline(yintercept=intercept.y.2, linetype="dashed", color = "blue") |
|
|
160 |
|
|
|
161 |
p2 <- p + |
|
|
162 |
|
|
|
163 |
#theme with white background |
|
|
164 |
theme_bw() + |
|
|
165 |
|
|
|
166 |
# titles |
|
|
167 |
theme(plot.title = element_text(color="black", size=10, hjust=0)) + |
|
|
168 |
theme(axis.title = element_text(color="black", face=NULL, size=8,angle = 90)) + |
|
|
169 |
theme(axis.title.y = element_text(size = 8, angle = 90, color="black", face=NULL)) + |
|
|
170 |
|
|
|
171 |
ylab(ylab) + |
|
|
172 |
xlab("") + |
|
|
173 |
labs(title=title) + |
|
|
174 |
|
|
|
175 |
#eliminates background, gridlines, and chart border |
|
|
176 |
theme(plot.background = element_blank(), |
|
|
177 |
panel.grid.major = element_blank(), |
|
|
178 |
panel.grid.minor = element_blank())+ |
|
|
179 |
theme(panel.border= element_blank())+ |
|
|
180 |
theme(plot.margin = unit(c(0.1,0.1,0.1,5), "cm"))+ |
|
|
181 |
|
|
|
182 |
#draws x and y axis line |
|
|
183 |
theme(axis.line = element_line(), |
|
|
184 |
axis.line.x = element_line(color="black", size = 0.5), |
|
|
185 |
axis.line.y = element_line(color="black", size = 0.5)) + |
|
|
186 |
|
|
|
187 |
# X - axis text |
|
|
188 |
theme(axis.text.x = element_text(angle=45, hjust=1, color="black", size = 8, face=NULL), |
|
|
189 |
axis.text.y = element_text(hjust=1, color="black", size = 8, face=NULL))+ |
|
|
190 |
|
|
|
191 |
# if want to limit to range |
|
|
192 |
if(!is.null(y.range))scale_y_continuous(breaks=seq(y.range[1], y.range[2], (y.range[2]-y.range[1])/5), limits = y.range) |
|
|
193 |
|
|
|
194 |
return(p2) |
|
|
195 |
} |
|
|
196 |
|
|
|
197 |
get.logical=function(annovector, a=NULL, filterv=NULL, PREFIX=NULL){ |
|
|
198 |
if(sum(filterv)<1&!is.null(filterv))stop("Logical filtering vector is empty") |
|
|
199 |
if(class(annovector)!="list")stop("Annotation vector should be a list") |
|
|
200 |
|
|
|
201 |
binaryfeatures=unlist(lapply(annovector, function(annov, a, filterv, PREFIX){ |
|
|
202 |
|
|
|
203 |
if(is.null(filterv))filterv=rep(T, length(annov)) |
|
|
204 |
|
|
|
205 |
if(is.null(a)){ |
|
|
206 |
a=unique(annov[filterv]) |
|
|
207 |
a=a[!(is.na(a)|a=="na")] |
|
|
208 |
annov[!filterv]=NA |
|
|
209 |
}else{ |
|
|
210 |
b=unique(annov[filterv]) |
|
|
211 |
a=a[a%in%b] |
|
|
212 |
} |
|
|
213 |
FUN_BINARYFEAT=function(type, annovector){ |
|
|
214 |
logv=annovector%in%type |
|
|
215 |
} |
|
|
216 |
# make binary features |
|
|
217 |
binaryfeats=lapply(a, FUN_BINARYFEAT, annov) |
|
|
218 |
if(!is.null(PREFIX))names(binaryfeats)=paste0(a ,"_", PREFIX) |
|
|
219 |
if(is.null(PREFIX))names(binaryfeats)=a |
|
|
220 |
return(binaryfeats) |
|
|
221 |
}, a, filterv, PREFIX), recursive = F) |
|
|
222 |
} |
|
|
223 |
|
|
|
224 |
logicalList2vector=function(lv.list){ |
|
|
225 |
classes=names(lv.list) |
|
|
226 |
|
|
|
227 |
vector.classes=rep(NA, length(lv.list[[1]])) |
|
|
228 |
|
|
|
229 |
for(i in seq(classes)){ |
|
|
230 |
vector.classes[lv.list[[i]]]=classes[i] |
|
|
231 |
} |
|
|
232 |
|
|
|
233 |
return(vector.classes) |
|
|
234 |
|
|
|
235 |
} |
|
|
236 |
|
|
|
237 |
get.data.type=function(type, feats, fm.f, ord, FDR=F, clean_name=T){ |
|
|
238 |
pl=fm.f[match(feats[grepl(type, feats)], rownames(fm.f)),ord,drop=F] |
|
|
239 |
if(dim(pl)[1]==0)return(NULL) |
|
|
240 |
|
|
|
241 |
n=do.call(rbind, strsplit(rownames(pl), ":"))[,1:3] |
|
|
242 |
|
|
|
243 |
if(is.null(dim(n)))n=data.frame(t(n)) |
|
|
244 |
|
|
|
245 |
rownames(pl)=apply(n, 1, paste, collapse = ":") |
|
|
246 |
|
|
|
247 |
if(clean_name){ |
|
|
248 |
rownames(pl)=make.unique(gsub(".*.:", "", rownames(pl))) |
|
|
249 |
rownames(pl)=gsub("_", " ", rownames(pl)) |
|
|
250 |
|
|
|
251 |
} |
|
|
252 |
|
|
|
253 |
return(pl) |
|
|
254 |
} |
|
|
255 |
|
|
|
256 |
make.hm=function(i, dat, param, cluster_rows=F, cluster_columns=F, split=NULL, text_annot=NULL, clean_name=T, WIDTH=50, use_raster=T, show_column_names=F, ...){ |
|
|
257 |
pl=data.matrix(dat[[i]]) |
|
|
258 |
par=param[i,] |
|
|
259 |
name=par$name |
|
|
260 |
color=gsub(" ", "", as.character(unlist(strsplit(par$colors, ",")))) |
|
|
261 |
values=as.numeric(unlist(strsplit(par$values, ","))) |
|
|
262 |
type=ifelse(grepl("^B:", par[1]), "discrete", "numeric") |
|
|
263 |
labels_legend=values |
|
|
264 |
|
|
|
265 |
if(grepl("^B:", par[1]))labels_legend=c(0,1) |
|
|
266 |
if(par$scale){ |
|
|
267 |
pl=t(scale(t(pl))) |
|
|
268 |
pl[pl>2]=2 |
|
|
269 |
pl[pl<(-2)]=-2 |
|
|
270 |
labels_legend=c(-2,-1,0,1,2) |
|
|
271 |
name=paste(name, "Z-score", sep="\n") |
|
|
272 |
} |
|
|
273 |
|
|
|
274 |
ha.r=NULL |
|
|
275 |
if(!is.null(text_annot)&!cluster_rows){ |
|
|
276 |
|
|
|
277 |
if(clean_name){ |
|
|
278 |
names(text_annot)=make.unique(gsub(".*.:", "", names(text_annot))) |
|
|
279 |
names(text_annot)=gsub("_", " ", names(text_annot)) |
|
|
280 |
} |
|
|
281 |
|
|
|
282 |
text=text_annot[match(rownames(pl), names(text_annot))] |
|
|
283 |
if(any(!is.na(text))) ha.r = rowAnnotation(value = anno_text(text, gp = gpar(fontsize = 8))) |
|
|
284 |
} |
|
|
285 |
|
|
|
286 |
p=Heatmap(pl, cluster_columns = cluster_columns, cluster_rows = cluster_rows, row_names_side = "right", |
|
|
287 |
column_names_gp = gpar(fontsize = 8), |
|
|
288 |
row_names_gp = gpar(fontsize = 8), |
|
|
289 |
column_title_gp = gpar(fontsize = 9), |
|
|
290 |
name=par$type, col = colorRamp2(values, color), |
|
|
291 |
show_column_names = show_column_names, width = unit(WIDTH, "mm"), |
|
|
292 |
# rect_gp = gpar(col = "white", lty = 1, lwd = 0.5), |
|
|
293 |
height = unit(3*dim(pl)[1], "mm"), |
|
|
294 |
left_annotation = ha.r, |
|
|
295 |
use_raster = use_raster, |
|
|
296 |
heatmap_legend_param = list(legend_direction = "horizontal",title=name, |
|
|
297 |
legend_width = unit(20, "mm"), title_position = "topcenter",color_bar = type, at = labels_legend, title_gp = gpar(fontsize = 8), legend_gp = gpar(fontsize = 8)), |
|
|
298 |
column_split = split) |
|
|
299 |
|
|
|
300 |
|
|
|
301 |
return(p) |
|
|
302 |
} |
|
|
303 |
|
|
|
304 |
|
|
|
305 |
plot.complexHM.fm=function(feats, fm.f, annotdf=NULL, order_columns=NULL, order_rows=NULL, clean_name=T, feats.barplot=NULL,text_annot=NULL, split.columns=T, plotting.param="plotting_param_fm.txt", NAME=NULL, barplot.height=3, WIDTH=50, show_column_names=F, use_raster=F){ |
|
|
306 |
|
|
|
307 |
if(is.null(order_columns)){ |
|
|
308 |
cluster_columns=T |
|
|
309 |
ord=colnames(fm.f) |
|
|
310 |
}else{ |
|
|
311 |
cluster_columns=F |
|
|
312 |
ord=order_columns |
|
|
313 |
} |
|
|
314 |
if(is.null(order_rows)){ |
|
|
315 |
cluster_rows=T |
|
|
316 |
ord_rows=feats |
|
|
317 |
}else{ |
|
|
318 |
cluster_rows=F |
|
|
319 |
ord_rows=order_rows |
|
|
320 |
} |
|
|
321 |
|
|
|
322 |
if("adj.p"%in%colnames(feats)){ |
|
|
323 |
FDR=feats$adj.p |
|
|
324 |
feats=unique(feats$featureB) |
|
|
325 |
}else{ |
|
|
326 |
feats=as.character(feats) |
|
|
327 |
} |
|
|
328 |
|
|
|
329 |
feats=feats[feats%in%rownames(fm.f)] |
|
|
330 |
|
|
|
331 |
param=data.table::fread(plotting.param, data.table = F) |
|
|
332 |
datatypes=param$type |
|
|
333 |
|
|
|
334 |
dat=lapply(datatypes, get.data.type, feats, fm.f, ord, FDR=F) |
|
|
335 |
names(dat)=datatypes |
|
|
336 |
dat=dat[!sapply(dat, is.null)] |
|
|
337 |
|
|
|
338 |
# remove NA columns if they exist, otherwise clustering fails: |
|
|
339 |
if(cluster_columns){ |
|
|
340 |
rm=lapply(dat, function(d){colSums(is.na(d))==dim(d)[1]}) |
|
|
341 |
|
|
|
342 |
filt=Reduce("|", rm) |
|
|
343 |
|
|
|
344 |
dat=lapply(dat, function(d)d[,!filt]) |
|
|
345 |
|
|
|
346 |
if(sum(filt)>0)warning(paste("Removed ", sum(filt), "samples, all samples NA for clustering")) |
|
|
347 |
} |
|
|
348 |
|
|
|
349 |
if(split.columns&!is.null(annotdf)){ |
|
|
350 |
split=as.character(annotdf[ord,1]) |
|
|
351 |
split=factor(split, levels=unique(split)) |
|
|
352 |
}else{ |
|
|
353 |
split=NULL |
|
|
354 |
} |
|
|
355 |
|
|
|
356 |
param=param[match(names(dat), param[,1]),] |
|
|
357 |
|
|
|
358 |
panels=lapply(seq(dat), make.hm, dat, param, cluster_rows, cluster_columns, split, text_annot, clean_name, WIDTH,use_raster, show_column_names) |
|
|
359 |
panels=panels[!is.null(panels)] |
|
|
360 |
|
|
|
361 |
if(!is.null(annotdf)){ |
|
|
362 |
annotdf=annotdf[ord,,drop=F] |
|
|
363 |
h=dim(annotdf)[2]*3 |
|
|
364 |
|
|
|
365 |
if(!is.null(feats.barplot)){ |
|
|
366 |
f=annotdf[,feats.barplot,drop=F] |
|
|
367 |
annotdf=annotdf[,!colnames(annotdf)%in%feats.barplot, drop=F] |
|
|
368 |
|
|
|
369 |
if(dim(annotdf)[2]==0)annotdf=data.frame("dummy"=c(rep(0, dim(f)[1])[-1], 1)) |
|
|
370 |
h=dim(annotdf)[2]*3+barplot.height |
|
|
371 |
|
|
|
372 |
l.barplot=paste("HeatmapAnnotation(", paste(paste0("'", feats.barplot, "' = anno_barplot(as.numeric(f[,",seq(dim(f)[2]),"]), axis = T, gp = gpar(fill = 'grey25'), height=unit(", barplot.height, ", 'mm'))"), collapse=", "),", height = unit(dim(f)[2]*", h,", 'mm'), annotation_name_gp = gpar(fontsize = 8))") |
|
|
373 |
|
|
|
374 |
ha = eval(parse(text = l.barplot)) |
|
|
375 |
}else{ |
|
|
376 |
ha=HeatmapAnnotation(df = annotdf) |
|
|
377 |
} |
|
|
378 |
|
|
|
379 |
add=Heatmap(t(annotdf), cluster_columns = cluster_columns, top_annotation = ha, cluster_rows = cluster_rows, row_names_side = "right", |
|
|
380 |
column_names_gp = gpar(fontsize = 8), |
|
|
381 |
row_names_gp = gpar(fontsize = 8), |
|
|
382 |
column_title_gp = gpar(fontsize = 9), |
|
|
383 |
show_column_names = show_column_names, width = unit(WIDTH, "mm"), |
|
|
384 |
height = unit(h+10, "mm"), |
|
|
385 |
use_raster=use_raster, |
|
|
386 |
heatmap_legend_param = list(legend_direction = "horizontal",title="Annotations", |
|
|
387 |
legend_width = unit(20, "mm"), title_position = "topcenter", title_gp = gpar(fontsize = 8), legend_gp = gpar(fontsize = 8)), column_split = split) |
|
|
388 |
panels=append(list("Annotations"=add), panels) |
|
|
389 |
dat=append(list("Annotations"=t(annotdf)), dat) |
|
|
390 |
} |
|
|
391 |
|
|
|
392 |
heights=colSums(sapply(panels, component_height))+60 |
|
|
393 |
nrows=sum(heights) |
|
|
394 |
rows_needed=heights |
|
|
395 |
ind=findInterval(seq(nrows), c(1,cumsum(rows_needed)), rightmost.closed = T, left.open=T) |
|
|
396 |
|
|
|
397 |
figure <-multipanelfigure:: multi_panel_figure(width = 150+WIDTH, height = 40+sum(heights), rows = nrows, columns = 1, panel_label_type = "lower-alpha", unit = "mm", row_spacing = unit(5, "mm")) |
|
|
398 |
|
|
|
399 |
for(i in seq(panels))figure <- multipanelfigure::fill_panel(figure, panels[[i]], row = which(ind==i), column = 1) |
|
|
400 |
|
|
|
401 |
if(!is.null(NAME))multipanelfigure::save_multi_panel_figure(figure, filename=paste0(NAME, "_fm_complexheatmap.pdf"), limitsize = FALSE) |
|
|
402 |
return(figure) |
|
|
403 |
} |
|
|
404 |
|
|
|
405 |
|
|
|
406 |
plot.scatter=function(x, y,namev, lv=NULL, group=NULL, colorv=NULL, main="XY-plot", axis.plot=F, xlab="x", ylab="y", SIZE=3, add.proportions=F,add.density=F, add.legend=T,add.labels=F, rasterize=T, width=77, height=74, text.size=10){ |
|
|
407 |
library(ggplot2) |
|
|
408 |
library(reshape2) |
|
|
409 |
library(RColorBrewer) |
|
|
410 |
library(ggrepel) |
|
|
411 |
library(ggrastr) |
|
|
412 |
library(cowplot) |
|
|
413 |
library(dplyr) |
|
|
414 |
|
|
|
415 |
if(is.null(colorv)){ |
|
|
416 |
# http://tools.medialab.sciences-po.fr/iwanthue/ |
|
|
417 |
colorv=c( "#acb839", |
|
|
418 |
"#42c87f", |
|
|
419 |
"#bf4da5", |
|
|
420 |
"#8479e6", |
|
|
421 |
"#cea632", |
|
|
422 |
"#5488e3", |
|
|
423 |
"#d76092", |
|
|
424 |
"#d38725", |
|
|
425 |
"#3e397f", |
|
|
426 |
"#a4a94e", |
|
|
427 |
"#be7cde", |
|
|
428 |
"#4d7122", |
|
|
429 |
"#8460b5", |
|
|
430 |
"#62ac6a", |
|
|
431 |
"#d7a85b", |
|
|
432 |
"#86275d", |
|
|
433 |
"#43c8ac", |
|
|
434 |
"#cf483f", |
|
|
435 |
"#748ed7", |
|
|
436 |
"#ca6e37", |
|
|
437 |
"#de91dc", |
|
|
438 |
"#926a26", |
|
|
439 |
"#94589d", |
|
|
440 |
"#5e2883", |
|
|
441 |
"#822c17", |
|
|
442 |
"#4d56b9", |
|
|
443 |
"#d2745b", |
|
|
444 |
"#b24258", |
|
|
445 |
"#75b550", |
|
|
446 |
"#d35760") |
|
|
447 |
# image(seq(colorv), 1, as.matrix(1:length(colorv)), col=colorv, |
|
|
448 |
# xlab="", ylab = "", xaxt = "n", yaxt = "n", bty = "n") |
|
|
449 |
} |
|
|
450 |
|
|
|
451 |
dat=data.frame("name"=namev, "x"=x,"y"=y) |
|
|
452 |
n=paste0("N = ", dim(dat)[1]) |
|
|
453 |
|
|
|
454 |
if(is.null(lv))lv=rep(F, length(x)) |
|
|
455 |
dat$Significant=lv |
|
|
456 |
|
|
|
457 |
if(is.null(group)){ |
|
|
458 |
dat$group="" |
|
|
459 |
colorv=colorv[1] |
|
|
460 |
}else{ |
|
|
461 |
dat$group=factor(group, levels=unique(group)) |
|
|
462 |
dat=dat[order(dat$group),] |
|
|
463 |
} |
|
|
464 |
|
|
|
465 |
myColors <- colorv |
|
|
466 |
|
|
|
467 |
names(myColors) <- levels(dat$group) |
|
|
468 |
colScale <- scale_colour_manual(name = "group",values = myColors) |
|
|
469 |
|
|
|
470 |
if(add.legend){ |
|
|
471 |
legend <- cowplot::get_legend(ggplot(dat, aes(x, y, colour = group)) + theme_bw() + |
|
|
472 |
geom_point(size=0.6) + colScale +theme(legend.position = "bottom", legend.direction = "horizontal", legend.title = element_blank(), |
|
|
473 |
legend.key=element_blank(), legend.box.background=element_blank(), |
|
|
474 |
legend.text=element_text(size = text.size, face = "bold", family="Helvetica"))+ |
|
|
475 |
theme(plot.margin=unit(c(1,1,1,1), "mm"))+ |
|
|
476 |
guides(colour = guide_legend(override.aes = list(size=text.size/3)))) |
|
|
477 |
nrow=4 |
|
|
478 |
}else{ |
|
|
479 |
nrow=3 |
|
|
480 |
} |
|
|
481 |
|
|
|
482 |
if(rasterize){ |
|
|
483 |
p=ggplot(dat, aes(x, y, colour = group)) + |
|
|
484 |
geom_point_rast(size=SIZE, raster.width = 3, raster.height = 3) + colScale + |
|
|
485 |
geom_point_rast(data = subset(dat, dat$Significant), size=SIZE*1.5, raster.width = 3, raster.height = 3) |
|
|
486 |
}else{ |
|
|
487 |
p=ggplot(dat, aes(x, y, colour = group)) + |
|
|
488 |
geom_point(size=SIZE) + colScale + |
|
|
489 |
geom_point(data = subset(dat, dat$Significant), size=SIZE*1.5) |
|
|
490 |
} |
|
|
491 |
|
|
|
492 |
p=p + |
|
|
493 |
theme_classic(base_size = 12) + |
|
|
494 |
ggtitle(paste(main, n, sep="\n")) + |
|
|
495 |
labs(x = xlab, y = ylab, fill = "") + |
|
|
496 |
scale_y_continuous(breaks = pretty(dat$y, n = 6))+ |
|
|
497 |
theme(legend.position = "none", legend.direction = "horizontal", |
|
|
498 |
axis.line = element_line(size=1, colour = "black"), |
|
|
499 |
panel.grid.major = element_blank(), |
|
|
500 |
panel.grid.minor = element_blank(), |
|
|
501 |
panel.border = element_rect(colour = "black", fill=NA, size=1), |
|
|
502 |
# panel.border = element_blank(), panel.background = element_blank(), |
|
|
503 |
plot.title = element_text(size = text.size, face = "bold", family="Helvetica"), |
|
|
504 |
text=element_text() |
|
|
505 |
)+ |
|
|
506 |
theme( |
|
|
507 |
axis.text.x = element_text(colour="grey20",size=text.size,face="plain", family="Helvetica"), |
|
|
508 |
axis.text.y = element_text(colour="grey20",size=text.size,face="plain", family="Helvetica"), |
|
|
509 |
axis.title.x = element_text(colour="grey20",size=text.size,face="plain", family="Helvetica"), |
|
|
510 |
axis.title.y = element_text(colour="grey20",size=text.size,face="plain", family="Helvetica") |
|
|
511 |
) + |
|
|
512 |
theme(plot.margin=unit(c(1,1,1,1), "mm")) |
|
|
513 |
|
|
|
514 |
if(!axis.plot){ |
|
|
515 |
p=p+theme(axis.title = element_blank(), # remove if needed |
|
|
516 |
axis.ticks = element_blank(), # remove if needed |
|
|
517 |
axis.line = element_blank(), |
|
|
518 |
axis.text = element_blank()) |
|
|
519 |
} |
|
|
520 |
|
|
|
521 |
# add lv labels (useful if plotting genes): |
|
|
522 |
if(add.labels){ |
|
|
523 |
p=p+geom_text_repel( |
|
|
524 |
data = subset(dat, dat$Significant), |
|
|
525 |
aes(label = as.character(dat$name[dat$Significant])), |
|
|
526 |
size = SIZE*1.25, |
|
|
527 |
color="black", |
|
|
528 |
box.padding = unit(0.2, "lines"), |
|
|
529 |
point.padding = unit(0.2, "lines"), |
|
|
530 |
family="Helvetica" |
|
|
531 |
) |
|
|
532 |
} |
|
|
533 |
|
|
|
534 |
theme0 <- function(...) theme( legend.position = "none", |
|
|
535 |
panel.background = element_blank(), |
|
|
536 |
panel.grid.major = element_blank(), |
|
|
537 |
panel.grid.minor = element_blank(), |
|
|
538 |
panel.spacing = unit(0,"null"), |
|
|
539 |
axis.ticks = element_blank(), |
|
|
540 |
axis.text.x = element_blank(), |
|
|
541 |
axis.text.y = element_blank(), |
|
|
542 |
axis.title.x = element_blank(), |
|
|
543 |
axis.title.y = element_blank(), |
|
|
544 |
axis.ticks.length = unit(0,"null"), |
|
|
545 |
panel.border=element_rect(color=NA),...) |
|
|
546 |
|
|
|
547 |
# 74mm * 99mm per final panel |
|
|
548 |
figure <-multipanelfigure:: multi_panel_figure(width = width, height = height, rows = nrow, columns = 5, panel_label_type = "none", unit = "mm", row_spacing = unit(2, "mm"), column_spacing = unit(0, "mm")) |
|
|
549 |
figure <- multipanelfigure::fill_panel(figure, p, row = 1:3, column = 2:5) |
|
|
550 |
|
|
|
551 |
if(add.density){ |
|
|
552 |
|
|
|
553 |
library(ggplot2) |
|
|
554 |
library(gridExtra) |
|
|
555 |
|
|
|
556 |
DF=dat |
|
|
557 |
|
|
|
558 |
p2 <- ggplot(DF,aes(x=x,colour=factor(group))) + colScale + |
|
|
559 |
geom_density(alpha=0.5) + |
|
|
560 |
scale_x_continuous(breaks=NULL,expand=c(0.02,0)) + |
|
|
561 |
scale_y_continuous(breaks=NULL,expand=c(0.02,0)) + |
|
|
562 |
theme_bw() + |
|
|
563 |
theme0(plot.margin = unit(c(1,0,0,2.2),"lines")) |
|
|
564 |
|
|
|
565 |
p3 <- ggplot(DF,aes(x=y,colour=factor(group))) + colScale + |
|
|
566 |
geom_density(alpha=0.5) + |
|
|
567 |
coord_flip() + |
|
|
568 |
scale_x_continuous(labels = NULL,breaks=NULL,expand=c(0.02,0)) + |
|
|
569 |
scale_y_continuous(labels = NULL,breaks=NULL,expand=c(0.02,0)) + |
|
|
570 |
theme_bw() + |
|
|
571 |
theme0(plot.margin = unit(c(0,1,1.2,0),"lines")) |
|
|
572 |
|
|
|
573 |
p=grid.arrange(arrangeGrob(p2,ncol=2,widths=c(3,1)), |
|
|
574 |
arrangeGrob(p,p3,ncol=2,widths=c(3,1)), |
|
|
575 |
heights=c(1,3)) |
|
|
576 |
|
|
|
577 |
} |
|
|
578 |
|
|
|
579 |
|
|
|
580 |
if(add.proportions){ |
|
|
581 |
prop.dat=data.frame(main,as.data.frame(table(group)/length(group), stringsAsFactors=F), stringsAsFactors = F) |
|
|
582 |
ord=order(prop.dat$Freq, decreasing = F) |
|
|
583 |
prop.dat=prop.dat[ord,] |
|
|
584 |
prop.dat$group=factor(prop.dat$group, levels=prop.dat$group) |
|
|
585 |
myColors=colorv |
|
|
586 |
names(myColors) <- levels(dat$group) |
|
|
587 |
colScale2 <- scale_fill_manual(values = myColors) |
|
|
588 |
p2=ggplot(data=prop.dat, |
|
|
589 |
aes(x=main, y=Freq, fill=group)) + colScale2 + |
|
|
590 |
geom_bar(position="fill", stat = "identity", inherit.aes = T) + |
|
|
591 |
ggtitle(paste(" ", " ", sep="\n")) + |
|
|
592 |
theme(legend.position = "none", legend.direction = "horizontal", |
|
|
593 |
axis.line.y = element_line(size=1, colour = "black"), |
|
|
594 |
axis.line.x = element_blank(), |
|
|
595 |
panel.grid.major = element_blank(), |
|
|
596 |
panel.grid.minor = element_blank(), |
|
|
597 |
axis.text.x = element_blank(), |
|
|
598 |
axis.title.x = element_blank(), |
|
|
599 |
axis.title.y = element_blank(), |
|
|
600 |
axis.ticks.x = element_blank(), |
|
|
601 |
axis.text.y = element_text(colour="grey20",size=text.size,face="plain", family="Helvetica"), |
|
|
602 |
axis.ticks.length = unit(2,"mm"), |
|
|
603 |
panel.border = element_blank(), panel.background = element_blank(), |
|
|
604 |
plot.title = element_text(size = text.size, face = "bold", family="Helvetica"), |
|
|
605 |
text=element_text())+ |
|
|
606 |
theme(plot.margin=unit(c(0,0,0,0), "mm")) |
|
|
607 |
|
|
|
608 |
|
|
|
609 |
# 74mm * 99mm per panel |
|
|
610 |
figure <- multipanelfigure::fill_panel(figure, p2, row = 1:3, column = 1) |
|
|
611 |
|
|
|
612 |
} |
|
|
613 |
|
|
|
614 |
if(add.legend)figure <- multipanelfigure::fill_panel(figure, legend, row = 4, column = 2:4) |
|
|
615 |
|
|
|
616 |
|
|
|
617 |
return(figure) |
|
|
618 |
} |
|
|
619 |
|
|
|
620 |
|
|
|
621 |
get.only.legend=function(colorv, group, position="right", direction="vertical", text.size=10){ |
|
|
622 |
dat=data.frame(group, colorv) |
|
|
623 |
levels(dat$group)=group |
|
|
624 |
myColors <- colorv |
|
|
625 |
names(myColors) <- levels(group) |
|
|
626 |
colScale <- scale_colour_manual(name = "group",values = myColors) |
|
|
627 |
dat$x=dim(dat)[1] |
|
|
628 |
dat$y=dim(dat)[1] |
|
|
629 |
|
|
|
630 |
legend <- cowplot::get_legend(ggplot(dat, aes(x, y, colour = group)) + theme_bw() + |
|
|
631 |
geom_point(size=0.6) + colScale +theme(legend.position = position, legend.direction = direction, legend.title = element_blank(), |
|
|
632 |
legend.key=element_blank(), legend.box.background=element_blank(), |
|
|
633 |
legend.text=element_text(size = text.size, face = "bold", family="Helvetica"))+ |
|
|
634 |
theme(plot.margin=unit(c(1,1,1,1), "mm"))+ |
|
|
635 |
guides(colour = guide_legend(override.aes = list(size=text.size/3)))) |
|
|
636 |
return(legend) |
|
|
637 |
} |
|
|
638 |
|
|
|
639 |
|
|
|
640 |
|
|
|
641 |
|
|
|
642 |
plot.DotPlot=function (object, assay = NULL, features, cols = c("lightgrey", "blue"), col.min = -2.5, col.max = 2.5, dot.min = 0, dot.scale = 6, group.by = NULL, split.by = NULL, scale.by = "radius", scale.min = NA, scale.max = NA){ |
|
|
643 |
library(cowplot) |
|
|
644 |
|
|
|
645 |
# if seurat input: |
|
|
646 |
library(Seurat) |
|
|
647 |
|
|
|
648 |
assay <- DefaultAssay(object = object) |
|
|
649 |
DefaultAssay(object = object) <- assay |
|
|
650 |
scale.func <- switch(EXPR = scale.by, size = scale_size, |
|
|
651 |
radius = scale_radius, stop("'scale.by' must be either 'size' or 'radius'")) |
|
|
652 |
data.features <- FetchData(object = object, vars = features) |
|
|
653 |
data.features$id <- if (is.null(x = group.by)) { |
|
|
654 |
Idents(object = object) |
|
|
655 |
}else { |
|
|
656 |
object[[group.by, drop = TRUE]] |
|
|
657 |
} |
|
|
658 |
if (!is.factor(x = data.features$id)) { |
|
|
659 |
data.features$id <- factor(x = data.features$id) |
|
|
660 |
} |
|
|
661 |
id.levels <- levels(x = data.features$id) |
|
|
662 |
data.features$id <- as.vector(x = data.features$id) |
|
|
663 |
if (!is.null(x = split.by)) { |
|
|
664 |
splits <- object[[split.by, drop = TRUE]] |
|
|
665 |
if (length(x = unique(x = splits)) > length(x = cols)) { |
|
|
666 |
stop("Not enought colors for the number of groups") |
|
|
667 |
} |
|
|
668 |
cols <- cols[1:length(x = unique(x = splits))] |
|
|
669 |
names(x = cols) <- unique(x = splits) |
|
|
670 |
data.features$id <- paste(data.features$id, splits, sep = "_") |
|
|
671 |
unique.splits <- unique(x = splits) |
|
|
672 |
id.levels <- paste0(rep(x = id.levels, each = length(x = unique.splits)), |
|
|
673 |
"_", rep(x = unique(x = splits), times = length(x = id.levels))) |
|
|
674 |
} |
|
|
675 |
data.plot <- lapply(X = unique(x = data.features$id), FUN = function(ident) { |
|
|
676 |
data.use <- data.features[data.features$id == ident, |
|
|
677 |
1:(ncol(x = data.features) - 1), drop = FALSE] |
|
|
678 |
avg.exp <- apply(X = data.use, MARGIN = 2, FUN = function(x) { |
|
|
679 |
return(mean(x = expm1(x = x))) |
|
|
680 |
}) |
|
|
681 |
pct.exp <- apply(X = data.use, MARGIN = 2, FUN = PercentAbove, |
|
|
682 |
threshold = 0) |
|
|
683 |
return(list(avg.exp = avg.exp, pct.exp = pct.exp)) |
|
|
684 |
}) |
|
|
685 |
names(x = data.plot) <- unique(x = data.features$id) |
|
|
686 |
data.plot <- lapply(X = names(x = data.plot), FUN = function(x) { |
|
|
687 |
data.use <- as.data.frame(x = data.plot[[x]]) |
|
|
688 |
data.use$features.plot <- rownames(x = data.use) |
|
|
689 |
data.use$id <- x |
|
|
690 |
return(data.use) |
|
|
691 |
}) |
|
|
692 |
data.plot <- do.call(what = "rbind", args = data.plot) |
|
|
693 |
if (!is.null(x = id.levels)) { |
|
|
694 |
data.plot$id <- factor(x = data.plot$id, levels = id.levels) |
|
|
695 |
} |
|
|
696 |
|
|
|
697 |
# could continue here with other kinds of data too |
|
|
698 |
|
|
|
699 |
avg.exp.scaled <- sapply(X = unique(x = data.plot$features.plot), |
|
|
700 |
FUN = function(x) { |
|
|
701 |
data.use <- data.plot[data.plot$features.plot == |
|
|
702 |
x, "avg.exp"] |
|
|
703 |
data.use <- scale(x = data.use) |
|
|
704 |
data.use <- MinMax(data = data.use, min = col.min, |
|
|
705 |
max = col.max) |
|
|
706 |
return(data.use) |
|
|
707 |
}) |
|
|
708 |
avg.exp.scaled <- as.vector(x = t(x = avg.exp.scaled)) |
|
|
709 |
if (!is.null(x = split.by)) { |
|
|
710 |
avg.exp.scaled <- as.numeric(x = cut(x = avg.exp.scaled, |
|
|
711 |
breaks = 20)) |
|
|
712 |
} |
|
|
713 |
data.plot$avg.exp.scaled <- avg.exp.scaled |
|
|
714 |
data.plot$features.plot <- factor(x = data.plot$features.plot, |
|
|
715 |
levels = rev(x = features)) |
|
|
716 |
data.plot$pct.exp[data.plot$pct.exp < dot.min] <- NA |
|
|
717 |
data.plot$pct.exp <- data.plot$pct.exp * 100 |
|
|
718 |
if (!is.null(x = split.by)) { |
|
|
719 |
splits.use <- vapply(X = strsplit(x = as.character(x = data.plot$id), |
|
|
720 |
split = "_"), FUN = "[[", FUN.VALUE = character(length = 1L), |
|
|
721 |
2) |
|
|
722 |
data.plot$colors <- mapply(FUN = function(color, value) { |
|
|
723 |
return(colorRampPalette(colors = c("grey", color))(20)[value]) |
|
|
724 |
}, color = cols[splits.use], value = avg.exp.scaled) |
|
|
725 |
} |
|
|
726 |
color.by <- ifelse(test = is.null(x = split.by), yes = "avg.exp.scaled", |
|
|
727 |
no = "colors") |
|
|
728 |
if (!is.na(x = scale.min)) { |
|
|
729 |
data.plot[data.plot$pct.exp < scale.min, "pct.exp"] <- scale.min |
|
|
730 |
} |
|
|
731 |
if (!is.na(x = scale.max)) { |
|
|
732 |
data.plot[data.plot$pct.exp > scale.max, "pct.exp"] <- scale.max |
|
|
733 |
} |
|
|
734 |
plot <- ggplot(data = data.plot, mapping = aes_string(x = "id", y = "features.plot")) + |
|
|
735 |
geom_point(mapping = aes_string(size = "pct.exp", color = color.by)) + |
|
|
736 |
scale.func(range = c(0, dot.scale), limits = c(scale.min, scale.max)) + |
|
|
737 |
theme(axis.title.x = element_blank(), axis.title.y = element_blank()) + |
|
|
738 |
guides(size = guide_legend(title = "Percent Expressed")) + |
|
|
739 |
labs(x = "", y = ifelse(test = is.null(x = split.by), yes = "", no = "Split Identity")) + |
|
|
740 |
theme_cowplot() + |
|
|
741 |
theme(axis.text.x=element_text(angle=45, hjust=1)) + |
|
|
742 |
theme(axis.text.y = element_text(colour="grey20",size=10,face="plain", family="Helvetica"), axis.text.x = element_text(colour="grey20",size=10,face="plain", family="Helvetica")) + |
|
|
743 |
theme(legend.key=element_blank(), legend.box.background=element_blank(), |
|
|
744 |
legend.text=element_text(size = 10, family="Helvetica"))+ |
|
|
745 |
theme(plot.margin=unit(c(1,1,1,1), "mm")) |
|
|
746 |
|
|
|
747 |
|
|
|
748 |
if (!is.null(x = split.by)) { |
|
|
749 |
plot <- plot + scale_color_identity() |
|
|
750 |
} |
|
|
751 |
else if (length(x = cols) == 1) { |
|
|
752 |
plot <- plot + scale_color_distiller(palette = cols) |
|
|
753 |
} |
|
|
754 |
else { |
|
|
755 |
plot <- plot + scale_color_gradient(low = cols[1], high = cols[2]) |
|
|
756 |
} |
|
|
757 |
if (is.null(x = split.by)) { |
|
|
758 |
plot <- plot + guides(color = guide_colorbar(title = "Average Expression")) |
|
|
759 |
} |
|
|
760 |
return(plot) |
|
|
761 |
} |
|
|
762 |
|
|
|
763 |
PercentAbove <- function(x, threshold) { |
|
|
764 |
return(length(x = x[x > threshold]) / length(x = x)) |
|
|
765 |
} |
|
|
766 |
|
|
|
767 |
RandomName <- function(length = 5L, ...) { |
|
|
768 |
CheckDots(..., fxns = 'sample') |
|
|
769 |
return(paste(sample(x = letters, size = length, ...), collapse = '')) |
|
|
770 |
} |
|
|
771 |
|
|
|
772 |
MinMax=function (data, min, max) { |
|
|
773 |
data2 <- data |
|
|
774 |
data2[data2 > max] <- max |
|
|
775 |
data2[data2 < min] <- min |
|
|
776 |
return(data2) |
|
|
777 |
} |
|
|
778 |
|
|
|
779 |
scale.func <- function (name = waiver(), breaks = waiver(), labels = waiver(), |
|
|
780 |
limits = NULL, range = c(1, 6), trans = "identity", guide = "legend") |
|
|
781 |
{ |
|
|
782 |
continuous_scale("size", "radius", scales::rescale_pal(range), name = name, |
|
|
783 |
breaks = breaks, labels = labels, limits = limits, trans = trans, |
|
|
784 |
guide = guide) |
|
|
785 |
} |
|
|
786 |
|
|
|
787 |
#' Contains columns: variable.1, variable.2, features (y name), id (x name) |
|
|
788 |
#' @examples |
|
|
789 |
#' #'\dontrun{ |
|
|
790 |
#'df=data.frame("variable.1"=c(-2, 4), "variable.2"=c(10,40), "features"=c("feature1", "feature2"), "id"=c("group1", "group2")) |
|
|
791 |
#'plot.DotPlot.df(df) |
|
|
792 |
#'# example, modified: |
|
|
793 |
#'plot.DotPlot.df(df, name.variable.1 = "Fold-Change", name.variable.2 = "FDR (-log10)", cols = c("blue","white", "red"), col.min = -2, col.max = 2, scale.min = 0, scale.max = 20, dot.scale = 4) |
|
|
794 |
#'} |
|
|
795 |
plot.DotPlot.df=function(data.plot, scale.min=NULL, scale.max=NULL, col.min=NULL,col.max=NULL, dot.scale = 6, fontsize=8, cols = c("lightgrey", "red"), name.variable.1="variable.1", name.variable.2="variable.2", number.legend.points=NULL){ |
|
|
796 |
library(cowplot) |
|
|
797 |
|
|
|
798 |
# set scales for data: |
|
|
799 |
if(is.null(col.min))col.min=min(data.plot$variable.1) |
|
|
800 |
if(is.null(col.max))col.max=max(data.plot$variable.1) |
|
|
801 |
if(is.null(scale.min))scale.min=min(data.plot$variable.2) |
|
|
802 |
if(is.null(scale.max))scale.max=max(data.plot$variable.2) |
|
|
803 |
|
|
|
804 |
if(!is.null(number.legend.points)){ |
|
|
805 |
breaks=seq(scale.min, scale.max, length.out=number.legend.points) |
|
|
806 |
}else{ |
|
|
807 |
breaks=waiver() |
|
|
808 |
} |
|
|
809 |
|
|
|
810 |
|
|
|
811 |
# set scales: |
|
|
812 |
data.plot$variable.1 <- MinMax(data = data.plot$variable.1, min = col.min, max = col.max) |
|
|
813 |
data.plot$variable.2 <- MinMax(data = data.plot$variable.2, min = scale.min, max = scale.max) |
|
|
814 |
|
|
|
815 |
# rearrenge, feature1 on top: |
|
|
816 |
data.plot$features=factor(data.plot$features, levels=rev(unique(data.plot$features))) |
|
|
817 |
|
|
|
818 |
plot <- ggplot(data = data.plot, mapping = aes_string(x = "id", y = "features")) + |
|
|
819 |
geom_point(mapping = aes_string(size = "variable.2", color = "variable.1")) + |
|
|
820 |
scale.func(range = c(0, dot.scale), limits = c(scale.min, scale.max), breaks = breaks) + |
|
|
821 |
theme(axis.title.x = element_blank(), axis.title.y = element_blank()) + |
|
|
822 |
guides(size = guide_legend(title = name.variable.2)) + |
|
|
823 |
guides(colour=guide_legend(title = name.variable.1)) + |
|
|
824 |
labs(x = "", y = "") + |
|
|
825 |
theme_cowplot() + |
|
|
826 |
theme(axis.text.x=element_text(angle=45, hjust=1)) + |
|
|
827 |
theme(axis.text.y = element_text(colour="grey20",size=fontsize,face="plain", family="Helvetica"), axis.text.x = element_text(colour="grey20",size=fontsize,face="plain", family="Helvetica")) + |
|
|
828 |
theme(legend.key=element_blank(), legend.box.background=element_blank(), |
|
|
829 |
legend.text=element_text(size=fontsize, family="Helvetica"))+ |
|
|
830 |
theme(plot.margin=unit(c(1,1,1,1), "mm")) |
|
|
831 |
|
|
|
832 |
# 2 color gradient |
|
|
833 |
if(length(cols)==2)plot <- plot + scale_colour_gradient(low = cols[1], high = cols[2]) |
|
|
834 |
|
|
|
835 |
# 3 color gradient |
|
|
836 |
# if(length(cols)==3)plot <- plot + scale_colour_gradient2(low = cols[1],mid = cols[2], high = cols[3], midpoint = 0) |
|
|
837 |
|
|
|
838 |
# forces to range (no midpoint, but middle color will be midpoint): |
|
|
839 |
if(length(cols)>2)plot <- plot + scale_colour_gradientn(colours = cols, limits = c(col.min, col.max)) |
|
|
840 |
|
|
|
841 |
return(plot) |
|
|
842 |
} |