adding more flexibility for clone annotation and legend layouts

chrisamiller · Nov 30, 2020 · 9c6b8e0 · 9c6b8e0
1 parent 3da45eb
commit 9c6b8e0
Show file tree

Hide file tree

Showing 24 changed files with 269 additions and 88 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -12,5 +12,5 @@ Imports:
     plotrix,
     png,
     Hmisc
-RoxygenNote: 5.0.1
+RoxygenNote: 7.1.1
 Packaged: 2017-04-27 04:18:11 PM; cmiller
diff --git a/R/draw.R b/R/draw.R
@@ -8,7 +8,6 @@
 #' @param pad.left A numeric amount of extra padding to add to the left side of the shape
 #' @param ramp.angle A numeric value between 0 and 1 that indicates how steeply the polygon should expand from it's origin to the first measured point
 #' @param border A numeric width for the border line around this polygon
-#' @param col.border A color for the border line
 #'
 #' @return No return value, outputs on graphics device
 #' @examples
@@ -17,7 +16,8 @@
 #' }
 #'
 drawClustPolygon <- function(xpos, ytop, ybtm, color, nest.level, pad.left=0,
-                             border=1,col.border=NULL, ramp.angle=0.5, annot="", annot.angle, annot.col){
+                             border=1,col.border=NULL, ramp.angle=0.5, annot="", 
+                             annot.angle, annot.col, annot.cex, annot.pos, annot.offset){
 
     xst = xpos[1] - pad.left*(0.6^nest.level)
     yst = (ytop[1]+ybtm[1])/2
@@ -34,7 +34,8 @@ drawClustPolygon <- function(xpos, ytop, ybtm, color, nest.level, pad.left=0,
 
     #  Annotate the clones by driver mutations
     if(annot!=""){
-        annotClone(xst, yst, annot, annot.angle, annot.col)
+      annotClone(xst, yst, annot, angle=annot.angle, col=annot.col, 
+                 cex=annot.cex, pos=annot.pos, offset=annot.offset)
     }
 }
 
@@ -56,36 +57,40 @@ drawClustPolygon <- function(xpos, ytop, ybtm, color, nest.level, pad.left=0,
 #' }
 #'
 drawClustBezier <- function(xpos, ytop, ybtm, color, nest.level, pad.left=0,
-                            border=1, col.border=NULL, annot="", annot.angle, annot.col){
-
+                            border=1, col.border=NULL, annot="", 
+                            annot.angle, annot.col, annot.cex, annot.pos, annot.offset){
+
   ##the flank value is used to add extra control points
   ##to the L and R of each real point, which helps to anchor the
   ##curves more firmly to the actual numbers
   range=max(xpos)-min(xpos)
   flank=range*0.01
-
+  
   xst = xpos[1] - pad.left*(0.6^nest.level)
   yst = (ytop[1]+ybtm[1])/2
-
+  
   xpos = c(rbind(xpos-flank*2,xpos-flank,xpos,xpos+flank,xpos+flank*2))
   ybtm = c(rbind(ybtm,ybtm,ybtm,ybtm,ybtm))
   ytop = c(rbind(ytop,ytop,ytop,ytop,ytop))
-
+  
   #top line
   top = Hmisc::bezier(c(xst,xpos),c(yst,ytop),evaluation=100)
   btm = Hmisc::bezier(c(xst,xpos),c(yst,ybtm),evaluation=100)
   polygon(x = c(top$x,rev(btm$x)),
           y = c(top$y,rev(btm$y)),
           col=color, border=col.border, lwd=border)
+
   if(annot!=""){
-      annotClone(xst[2], yst[2], annot, annot.angle, annot.col)
+    annotClone(xst[1], yst[1], annot, annot.angle, annot.col, 
+               cex=annot.cex, pos=annot.pos, offset=annot.offset)
   }
-
+  
   #view control points for testing
   #points(c(xst,xpos,xpos), c(yst,ytop,ybtm), pch=18,cex=0.5)
 }
 
 
+
 #' Draw a single cluster using splined curves
 #'
 #' @param xpos A vector of x values for control points
@@ -103,7 +108,8 @@ drawClustBezier <- function(xpos, ytop, ybtm, color, nest.level, pad.left=0,
 #' drawClustSpline(xpos=c(0,30,75,150), ytop=c(100,51,51,99), ybtm=c(0,49,49,1), color="red", nest.level=1)
 #' }
 drawClustSpline <- function(xpos, ytop, ybtm, color, nest.level, pad.left=0,
-                            border=1, col.border=NULL, annot="", annot.angle, annot.col){
+                            border=1, col.border=NULL, annot="", 
+                            annot.angle, annot.col, annot.cex, annot.pos, annot.offset){
 
   ##the flank value is used to add extra control points
   ##to the L and R of each real point, which helps to anchor the
@@ -135,7 +141,8 @@ drawClustSpline <- function(xpos, ytop, ybtm, color, nest.level, pad.left=0,
 
   #  Annotate the clones by driver mutations
   if(annot!=""){
-      annotClone(xst[2], yst[2], annot, annot.angle, annot.col)
+    annotClone(xst[2], yst[2], annot, angle=annot.angle, col=annot.col, 
+                 cex=annot.cex, pos=annot.pos, offset=annot.offset)
   }
 
   ## #view control points for testing
@@ -147,11 +154,18 @@ drawClustSpline <- function(xpos, ytop, ybtm, color, nest.level, pad.left=0,
 #' @param x graphical x position of the clone origin
 #' @param y graphical y position of the clone origin
 #' @param annot annotation/driver mutations
-
-annotClone <- function(x, y, annot, angle=0, col = "black") {
-  text(x, y, annot, pos = 4, cex = 0.5, col = col, xpd = NA, srt = angle, offset = 0.5)
+#' @param angle clone anotation angle
+#' @param cex clone annotation text size
+#' @param col clone annotation text colour
+#' @param pos clone annotation (1=below, 2=left, 3=above, 4=right)
+#' @param offset clone annotation text offset from start positoin
+#'
+annotClone <- function(x, y, annot, angle=0, col = "black", pos=4, cex=0.5, offset=0.5) {
+  text(x, y, annot, pos = pos, cex = cex, col = col, xpd = NA, srt = angle, offset = offset)
 }
 
+
+
 #' Create the gradient background image for the plot
 #'
 #' @param col A vector of three colors to use for the gradient
@@ -270,23 +284,27 @@ fishPlot <- function(fish,shape="polygon", vlines=NULL, col.vline="#FFFFFF99", v
                         fish@col[i], fish@nest.level[i],
                         pad.left=pad.left, border=border, col.border=col.border,
                         annot = fish@clone.annots[i], annot.angle=fish@clone.annots.angle,
-                        annot.col=fish@clone.annots.col)
+                        annot.col=fish@clone.annots.col,                        
+                        annot.cex=fish@clone.annots.cex, annot.pos=fish@clone.annots.pos, annot.offset=fish@clone.annots.offset)
       } else {
         if(shape=="spline"){
           drawClustSpline(fish@xpos[[i]], fish@ytop[[i]], fish@ybtm[[i]],
                           fish@col[i], fish@nest.level[i],
                           pad.left=pad.left, border=border, col.border=col.border,
                           annot = fish@clone.annots[i], annot.angle=fish@clone.annots.angle,
-                          annot.col=fish@clone.annots.col)
+                          annot.col=fish@clone.annots.col,
+                          annot.cex=fish@clone.annots.cex, annot.pos=fish@clone.annots.pos, annot.offset=fish@clone.annots.offset)
         } else {
           if(!shape=="polygon"){
             print(paste("unknown shape \"",shape,"\". Using polygon representation"))
           }
           drawClustPolygon(fish@xpos[[i]], fish@ytop[[i]], fish@ybtm[[i]],
                            fish@col[i], fish@nest.level[i], ramp.angle=ramp.angle,
-                           pad.left=pad.left, border=border, col.border=col.border,
+                           pad.left=pad.left, border=border, col.border=col.border, 
                            annot = fish@clone.annots[i], annot.angle=fish@clone.annots.angle,
-                        annot.col=fish@clone.annots.col)
+                           annot.col=fish@clone.annots.col,
+                           annot.cex=fish@clone.annots.cex, annot.pos=fish@clone.annots.pos, annot.offset=fish@clone.annots.offset
+                           )
         }
       }
     }
@@ -321,6 +339,8 @@ fishPlot <- function(fish,shape="polygon", vlines=NULL, col.vline="#FFFFFF99", v
 #' @param ypos The y coordinate at which to draw the top of the legend (default -5)
 #' @param nrow An integer number of rows which should be used for the legend
 #' @param cex A numerical value giving the amount by which the legend should be magnified relative to the default.
+#' @param widthratio adjusts width of columns relative to longest legend entry (smaller value = more spacing)
+#' @param xsp horizontal spacing factor
 #'
 #' @return No return value, outputs on graphics device
 #' @examples
@@ -330,20 +350,31 @@ fishPlot <- function(fish,shape="polygon", vlines=NULL, col.vline="#FFFFFF99", v
 #' }
 #' @export
 #'
-drawLegend <- function(fish, xpos=0, ypos=-5, nrow=NULL, cex=1){
+drawLegend <- function(fish, xpos=0, ypos=-5, nrow=NULL, cex=1, widthratio=NULL, xsp=1){
+
   if(is.null(fish@clone.labels)){
-    fish@labels=1:dim(fish@frac.table)[1]
+    fish@labels=1:dim(fish@fish_table)[1]
   }
-
+  
   #do something sensible by default - can fit about 8 per row on a typically sized plot
   if(is.null(nrow)){
     nrow = ceiling(length(fish@clone.labels)/8)
   }
-
+  
   ##reorder for multi-row layout
   ncol = ceiling(length(fish@clone.labels)/nrow)
   lab = as.vector(suppressWarnings(t(matrix(fish@clone.labels,nrow=ncol))))[1:length(fish@clone.labels)]
   col = as.vector(suppressWarnings(t(matrix(fish@col,nrow=ncol))))[1:length(fish@col)]
-
-  legend(xpos,ypos,fill=col, legend=lab, bty="n", ncol=ncol, xpd=T, col="grey30", border="grey30", cex=cex*0.8)
+
+  ##resize column width relative to max label length if requeseted
+  if ( is.null(widthratio) ){
+    col_width= NULL
+  } else {
+    maxlablen <- max(sapply(fish@clone.labels, function(x) nchar(x)))
+    col_width <- maxlablen/(ncol*widthratio)
+  } 
+
+  legend(xpos,ypos,fill=col, legend=lab, bty="n", ncol=ncol, xpd=T, col="grey30", border="grey30", cex=cex*0.8,
+         text.width=col_width, x.intersp=xsp)
+
 }
diff --git a/R/object.R b/R/object.R
@@ -8,10 +8,13 @@ initFishClass <- function(){
                                         frac.table="matrix", parents="numeric",
                                         nest.level="numeric", inner.space="list",
                                         outer.space="numeric", clone.labels="character",
-                                        clone.annots="character", clone.annots.angle="numeric",
-                                        clone.annots.col="character"))
+                                        clone.annots="character", 
+                                        clone.annots.angle="numeric", clone.annots.col="character",
+                                        clone.annots.pos="numeric", clone.annots.cex="numeric", clone.annots.offset="numeric"
+                                        ))
 }
 
+
 ##------------------------------------------------------------------------
 #' Validate some key assumptions about the fish object's data
 #'
@@ -135,6 +138,9 @@ getAllNestLevels <- function(parents){
 #' @param clone.annots A character vector of annotations (mutation) to label to each clone in the plot
 #' @param clone.annots.angle A numeric angle in degrees (0-360) giving the angle at which to plot the annotations
 #' @param clone.annots.col A string giving the color with which to draw the clone annotations
+#' @param clone.annots.pos An integer describing the position for the clone annotations (1=below, 2=left, 3=above, 4=right)
+#' @param clone.annots.cex A numeric specifying the clone annotation text size ("character expansion factor")
+#' @param clone.annots.offset A numeric specifying distance ("offset") of the annotation from the clone start point
 #' @param fix.missing.clones A boolean value, telling whether to "correct" clones that have zero values at timepoints between non-zero values. (the clone must still have been present if it came back). Default FALSE.
 #'
 #' @return A fish object with the relevant slots filled
@@ -151,7 +157,9 @@ getAllNestLevels <- function(parents){
 #' parents = c(0,1,1,3)
 #' fish = createFishObject(frac.table,parents,timepoints=timepoints)
 #'
-createFishObject <- function(frac.table,parents,timepoints=NULL,col=NULL,clone.labels=NULL,clone.annots=NULL,clone.annots.angle=0,clone.annots.col="black",fix.missing.clones=FALSE){
+createFishObject <- function(frac.table,parents,timepoints=NULL,col=NULL,clone.labels=NULL,clone.annots=NULL,
+                             clone.annots.angle=0,clone.annots.col="black",clone.annots.pos=2,clone.annots.cex=0.7,clone.annots.offset=0.2,
+                             fix.missing.clones=FALSE){
 
   nest.level = getAllNestLevels(parents)
 
@@ -189,7 +197,9 @@ createFishObject <- function(frac.table,parents,timepoints=NULL,col=NULL,clone.l
   fish = new("fishObject", ytop=list(), ybtm=list(), col=c("NULL"),
     timepoints=as.numeric(colnames(frac.table)), frac.table=frac.table,
     parents=parents, nest.level=nest.level, inner.space=list(), outer.space=c(0),
-    clone.labels=clone.labels, clone.annots=clone.annots, clone.annots.angle=clone.annots.angle, clone.annots.col=clone.annots.col)
+    clone.labels=clone.labels, clone.annots=clone.annots, clone.annots.angle=clone.annots.angle, clone.annots.col=clone.annots.col,
+    clone.annots.pos=clone.annots.pos, clone.annots.cex=clone.annots.cex, clone.annots.offset=clone.annots.offset
+    )
 
   #set default colors to start
   fish = setCol(fish,col)

diff --git a/R/zzz.R b/R/zzz.R
@@ -22,5 +22,5 @@
 }
 
 .onAttach <- function(libname, pkgname) {
-    packageStartupMessage("Using fishPlot version 0.5")
+    packageStartupMessage("Using fishPlot version 0.5.1")
 }
diff --git a/man/annotClone.Rd b/man/annotClone.Rd
diff --git a/man/checkCol.Rd b/man/checkCol.Rd
diff --git a/man/createBackgroundImage.Rd b/man/createBackgroundImage.Rd
diff --git a/man/createFishObject.Rd b/man/createFishObject.Rd
diff --git a/man/drawClustBezier.Rd b/man/drawClustBezier.Rd