Switch to unified view

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
}