--- a +++ b/R/part01.R @@ -0,0 +1,156 @@ +################################################################################ +# Function which plots the drug characteristics +################################################################################ + +plotPathways = function(dat) { + + # quiets concerns of R CMD check "no visible binding for global variable" + Pathway=NULL; No=NULL; Group=NULL + + ordM = sort(table(dat$group), decreasing=TRUE) + ordS = tapply(dat$"target_category", dat$group, function(pth) { + sort(table(pth), decreasing=TRUE) + }) + + ocur = ordS[names(ordM)] + + # transform the list to LF df + tmp = do.call(rbind, lapply(names(ocur), function(pathgroup) { + data.frame(Group=pathgroup, + Pathway=names(ocur[[pathgroup]]), + No=as.vector(unname(ocur[[pathgroup]]))) + })) + tmp$Group = factor(tmp$Group, levels=rev(names(ocur))) + # order the targets by occurance and leave Other last + lev = sort(tapply(tmp$No, tmp$Pathway, function(x) sum(x)), decreasing=TRUE) + lev = c(lev[-which(names(lev)=="Other")], lev["Other"]) + tmp$Pathway = factor(tmp$Pathway, levels=names(lev)) + + # range to be plotted on the x axis + widthmax = max(lev)+1 + + g = ggplot(tmp, aes(x=Pathway, y=No, fill=Group)) + + geom_bar(width=0.6, stat="identity") + + theme_bw() + scale_fill_manual(values=typeColor, name="Drug type") + + scale_y_continuous(breaks=seq(0,20,2), expand = c(0,0), + limits = c(0,widthmax)) + + xlab("") + ylab("Number of drugs") + + theme(axis.text.x=element_text(size=12, angle = 45, vjust = 1, hjust=1), + axis.text.y=element_text(size=12), axis.title.y=element_text(size=12), + legend.text=element_text(size=12), legend.title=element_text(size=12)) + + # make gtable + hghts = c(0.2,0.22*widthmax,1.7) + wdths = c(1,0.3,0.2,0.26*length(levels(tmp$Pathway)),0.1) + + gg = ggplotGrob(g) + + gt = gtable(widths=unit(wdths, "in"), heights=unit(hghts, "in")) + # fill in the gtable + gt = gtable_add_grob(gt, gtable_filter(gg, "panel"), 2, 4) # panel + gt = gtable_add_grob(gt, gg$grobs[[whichInGrob(gg, "axis-b")]], 3, 4) # x axis + gt = gtable_add_grob(gt, gg$grobs[[whichInGrob(gg, "axis-l")]], 2, 3) # y axis + gt = gtable_add_grob(gt, gg$grobs[[whichInGrob(gg, "ylab-l")]], 2, 2) + + # make legend + wdthsl = c(2) + hghtsl = c(1.5) + gtl = gtable(widths=unit(wdthsl, "in"), heights=unit(hghtsl, "in")) + gtl = gtable_add_grob(gtl, gg$grobs[[whichInGrob(gg, "guide-box-right")]], 1, 1) + + return(list("figure"=list(width=sum(wdths), height=sum(hghts), plot=gt), + "legend"=list(width=sum(wdthsl), height=sum(hghtsl), plot=gtl))) +} + +################################################################################ +# Function which plots the patient characteristics as a bar plot +################################################################################ +plotPatientStat = function(pats, gap, ptab=BloodCancerMultiOmics2017::patmeta) { + + # quiets concerns of R CMD check "no visible binding for global variable" + Diagnosis=NULL; NO=NULL; Origin=NULL + + # create plotting data.frame with Diagnosis, Origin and number of cases + plotDF = data.frame(table(ptab[pats,"Diagnosis"])) + colnames(plotDF) = c("Diagnosis","NO") + plotDF$Diagnosis = as.character(plotDF$Diagnosis) + plotDF$Origin = + names(diagAmt)[unlist(sapply(plotDF$Diagnosis, + function(x) grep(x, diagAmt)))] + + # set the order of Diagnosis + ord = smunlist( + tapply(1:nrow(plotDF), plotDF$Origin, + function(idx) plotDF$Diagnosis[idx[order(plotDF[idx,"NO"], + decreasing=TRUE)]])[names(diagAmt)]) + plotDF$Diagnosis = factor(plotDF$Diagnosis, levels=ord) + + # adjustments for gap + if(any(plotDF$NO>gap[1] & plotDF$NO<gap[2])) + stop("Gap is wrongly defined") + idx = plotDF$NO > gap[2] + plotDF$NO[idx] = plotDF$NO[idx] - (gap[2]-gap[1]) + + # round the ceiling to tens (find the latest break point) + xlimits = c(0, moround(max(plotDF$NO),5)) + xbreaks = seq(0, xlimits[2], 10) + # labels for breaks + xlabels = ifelse(xbreaks>gap[1], xbreaks + (gap[2]-gap[1]), xbreaks) + + g = ggplot() + geom_bar(data=plotDF, aes(x=Diagnosis, y=NO, fill=Origin), + stat="identity", colour="black", size=0.1, width=.5) + + theme_bw() + scale_x_discrete() + + scale_fill_manual(values=colDiagL) + + scale_y_continuous(breaks=xbreaks, labels=xlabels, expand=c(0,0), + limits=xlimits) + + geom_hline(yintercept=c(gap[1]+5,gap[1]+5.5), linetype="dashed", size=0.3) + + xlab("") + ylab("") + + theme(axis.text.x=element_text(size=12, angle=45, hjust=1), + axis.text.y=element_text(size=12), + legend.text=element_text(size=12), + legend.title=element_text(size=12), + legend.key.size=unit(0.2,"in"), + legend.title.align=0.5, legend.text.align=0, + panel.border=element_rect(color="black", size=0.1)) + + # construct the gtable + wdths = c(0.4, 0.4*length(levels(plotDF$Diagnosis)), 0.1) + hghts = c(0.2, 0.04*max(xbreaks), 1) + gt = gtable(widths=unit(wdths, "in"), heights=unit(hghts, "in")) + ## make grobs + gg = ggplotGrob(g) + ## fill in the gtable + gt = gtable_add_grob(gt, gtable_filter(gg, "panel"), 2, 2) + gt = gtable_add_grob(gt, gg$grobs[[whichInGrob(gg, "axis-l")]], 2, 1) # y axis + gt = gtable_add_grob(gt, gg$grobs[[whichInGrob(gg, "axis-b")]], 3, 2) # x axis + + # make legend + wdthsl = c(2) + hghtsl = c(1.5) + gtl = gtable(widths=unit(wdthsl, "in"), heights=unit(hghtsl, "in")) + gtl = gtable_add_grob(gtl, gg$grobs[[whichInGrob(gg, "guide-box-right")]], 1, 1) + + return(list("figure"=list(width=sum(wdths), height=sum(hghts), plot=gt), + "legend"=list(width=sum(wdthsl), height=sum(hghtsl), plot=gtl))) + +} + +################################################################################ +# Function which plots the legends in one row +################################################################################ +drawLegends = function(plobj, lng=5, w=2, h=2) { #, alone=FALSE + + gt = gtable(widths=unit(rep(w, lng), "in"), heights=unit(h, "in")) + plotlen = length(plobj) + + if(plotlen>lng) + stop("Number of objects to plot exceeds the number of available slots!") + + for(po in 1:plotlen) { + gt = gtable_add_grob(gt, + plobj[[po]]$grobs[[whichInGrob(plobj[[po]], + "guide-box-right")]], 1, po) + } + + grid.draw(gt) +} \ No newline at end of file