a b/R/part01.R
1
################################################################################
2
# Function which plots the drug characteristics
3
################################################################################
4
5
plotPathways = function(dat) {
6
  
7
  # quiets concerns of R CMD check "no visible binding for global variable"
8
  Pathway=NULL; No=NULL; Group=NULL
9
  
10
  ordM = sort(table(dat$group), decreasing=TRUE)
11
  ordS = tapply(dat$"target_category", dat$group, function(pth) {
12
    sort(table(pth), decreasing=TRUE)
13
  })
14
  
15
  ocur  = ordS[names(ordM)]
16
  
17
  # transform the list to LF df
18
  tmp = do.call(rbind, lapply(names(ocur), function(pathgroup) {
19
    data.frame(Group=pathgroup,
20
               Pathway=names(ocur[[pathgroup]]),
21
               No=as.vector(unname(ocur[[pathgroup]])))
22
  }))
23
  tmp$Group = factor(tmp$Group, levels=rev(names(ocur)))
24
  # order the targets by occurance and leave Other last
25
  lev = sort(tapply(tmp$No, tmp$Pathway, function(x) sum(x)), decreasing=TRUE)
26
  lev = c(lev[-which(names(lev)=="Other")], lev["Other"])
27
  tmp$Pathway = factor(tmp$Pathway, levels=names(lev))
28
  
29
  # range to be plotted on the x axis
30
  widthmax = max(lev)+1
31
  
32
  g = ggplot(tmp, aes(x=Pathway, y=No, fill=Group)) +
33
    geom_bar(width=0.6, stat="identity") +
34
    theme_bw() + scale_fill_manual(values=typeColor, name="Drug type") +
35
    scale_y_continuous(breaks=seq(0,20,2), expand = c(0,0),
36
                       limits = c(0,widthmax)) +
37
    xlab("") + ylab("Number of drugs") +
38
    theme(axis.text.x=element_text(size=12, angle = 45, vjust = 1, hjust=1),
39
          axis.text.y=element_text(size=12), axis.title.y=element_text(size=12),
40
          legend.text=element_text(size=12), legend.title=element_text(size=12))
41
  
42
  # make gtable
43
  hghts = c(0.2,0.22*widthmax,1.7)
44
  wdths = c(1,0.3,0.2,0.26*length(levels(tmp$Pathway)),0.1)
45
  
46
  gg = ggplotGrob(g)
47
  
48
  gt = gtable(widths=unit(wdths, "in"), heights=unit(hghts, "in"))
49
  # fill in the gtable
50
  gt = gtable_add_grob(gt, gtable_filter(gg, "panel"), 2, 4) # panel
51
  gt = gtable_add_grob(gt, gg$grobs[[whichInGrob(gg, "axis-b")]], 3, 4) # x axis
52
  gt = gtable_add_grob(gt, gg$grobs[[whichInGrob(gg, "axis-l")]], 2, 3) # y axis
53
  gt = gtable_add_grob(gt, gg$grobs[[whichInGrob(gg, "ylab-l")]], 2, 2)
54
  
55
  # make legend
56
  wdthsl = c(2)
57
  hghtsl = c(1.5)
58
  gtl = gtable(widths=unit(wdthsl, "in"), heights=unit(hghtsl, "in"))
59
  gtl = gtable_add_grob(gtl, gg$grobs[[whichInGrob(gg, "guide-box-right")]], 1, 1)
60
  
61
  return(list("figure"=list(width=sum(wdths), height=sum(hghts), plot=gt),
62
              "legend"=list(width=sum(wdthsl), height=sum(hghtsl), plot=gtl)))
63
}
64
65
################################################################################
66
# Function which plots the patient characteristics as a bar plot
67
################################################################################
68
plotPatientStat = function(pats, gap, ptab=BloodCancerMultiOmics2017::patmeta) {
69
70
  # quiets concerns of R CMD check "no visible binding for global variable"
71
  Diagnosis=NULL; NO=NULL; Origin=NULL
72
  
73
  # create plotting data.frame with Diagnosis, Origin and number of cases 
74
  plotDF = data.frame(table(ptab[pats,"Diagnosis"]))
75
  colnames(plotDF) = c("Diagnosis","NO")
76
  plotDF$Diagnosis = as.character(plotDF$Diagnosis)
77
  plotDF$Origin = 
78
    names(diagAmt)[unlist(sapply(plotDF$Diagnosis,
79
                                        function(x) grep(x, diagAmt)))]
80
  
81
  # set the order of Diagnosis
82
  ord = smunlist(
83
    tapply(1:nrow(plotDF), plotDF$Origin,
84
           function(idx) plotDF$Diagnosis[idx[order(plotDF[idx,"NO"], 
85
           decreasing=TRUE)]])[names(diagAmt)])
86
  plotDF$Diagnosis = factor(plotDF$Diagnosis, levels=ord)
87
  
88
  # adjustments for gap
89
  if(any(plotDF$NO>gap[1] & plotDF$NO<gap[2]))
90
    stop("Gap is wrongly defined")
91
  idx = plotDF$NO > gap[2]
92
  plotDF$NO[idx] = plotDF$NO[idx] - (gap[2]-gap[1])
93
  
94
  # round the ceiling to tens (find the latest break point)
95
  xlimits = c(0, moround(max(plotDF$NO),5)) 
96
  xbreaks = seq(0, xlimits[2], 10)
97
  # labels for breaks
98
  xlabels = ifelse(xbreaks>gap[1], xbreaks + (gap[2]-gap[1]), xbreaks)
99
  
100
  g = ggplot() + geom_bar(data=plotDF, aes(x=Diagnosis, y=NO, fill=Origin),
101
                          stat="identity", colour="black", size=0.1, width=.5) +
102
    theme_bw() + scale_x_discrete() +
103
    scale_fill_manual(values=colDiagL) +
104
    scale_y_continuous(breaks=xbreaks, labels=xlabels, expand=c(0,0),
105
                       limits=xlimits) +
106
    geom_hline(yintercept=c(gap[1]+5,gap[1]+5.5), linetype="dashed", size=0.3) +
107
    xlab("") + ylab("") +
108
    theme(axis.text.x=element_text(size=12, angle=45, hjust=1),
109
          axis.text.y=element_text(size=12),
110
          legend.text=element_text(size=12),
111
          legend.title=element_text(size=12),
112
          legend.key.size=unit(0.2,"in"),
113
          legend.title.align=0.5, legend.text.align=0,
114
          panel.border=element_rect(color="black", size=0.1))
115
  
116
  # construct the gtable
117
  wdths = c(0.4, 0.4*length(levels(plotDF$Diagnosis)), 0.1) 
118
  hghts = c(0.2, 0.04*max(xbreaks), 1)
119
  gt = gtable(widths=unit(wdths, "in"), heights=unit(hghts, "in"))
120
  ## make grobs
121
  gg = ggplotGrob(g)
122
  ## fill in the gtable
123
  gt = gtable_add_grob(gt, gtable_filter(gg, "panel"), 2, 2)
124
  gt = gtable_add_grob(gt, gg$grobs[[whichInGrob(gg, "axis-l")]], 2, 1) # y axis
125
  gt = gtable_add_grob(gt, gg$grobs[[whichInGrob(gg, "axis-b")]], 3, 2) # x axis
126
  
127
  # make legend
128
  wdthsl = c(2)
129
  hghtsl = c(1.5)
130
  gtl = gtable(widths=unit(wdthsl, "in"), heights=unit(hghtsl, "in"))
131
  gtl = gtable_add_grob(gtl, gg$grobs[[whichInGrob(gg, "guide-box-right")]], 1, 1)
132
  
133
  return(list("figure"=list(width=sum(wdths), height=sum(hghts), plot=gt),
134
              "legend"=list(width=sum(wdthsl), height=sum(hghtsl), plot=gtl)))
135
  
136
}
137
138
################################################################################
139
# Function which plots the legends in one row
140
################################################################################
141
drawLegends = function(plobj, lng=5, w=2, h=2) { #, alone=FALSE
142
  
143
  gt = gtable(widths=unit(rep(w, lng), "in"), heights=unit(h, "in"))
144
  plotlen = length(plobj)
145
  
146
  if(plotlen>lng)
147
    stop("Number of objects to plot exceeds the number of available slots!")
148
149
  for(po in 1:plotlen) {
150
    gt = gtable_add_grob(gt,
151
                         plobj[[po]]$grobs[[whichInGrob(plobj[[po]],
152
                                                        "guide-box-right")]], 1, po)
153
  }
154
  
155
  grid.draw(gt)
156
}