subview function

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/ggtree@107837 bc3139a8-67e5-0310-9ffc-ced21a209358

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: ggtree
 Type: Package
 Title: a phylogenetic tree viewer for different types of tree annotations
-Version: 1.1.16
+Version: 1.1.17
 Author: Guangchuang Yu and Tommy Tsan-Yuk Lam
 Maintainer: Guangchuang Yu <guangchuangyu@gmail.com>
 Description: ggtree extends the ggplot2 plotting system which implemented the

NAMESPACE

@@ -71,6 +71,8 @@ export(rtree)
 export(scaleClade)
 export(scale_color)
 export(scale_x_ggtree)
+export(subview)
+export(theme_transparent)
 export(theme_tree)
 export(theme_tree2)
 export(write.jplace)
@@ -129,6 +131,7 @@ importFrom(ggplot2,geom_segment)
 importFrom(ggplot2,geom_text)
 importFrom(ggplot2,geom_tile)
 importFrom(ggplot2,ggplot)
+importFrom(ggplot2,ggplotGrob)
 importFrom(ggplot2,guide_legend)
 importFrom(ggplot2,guides)
 importFrom(ggplot2,labs)

NEWS

@@ -1,3 +1,10 @@
+CHANGES IN VERSION 1.1.17
+------------------------
+ o add 'width' parameter to add_legend, now user can specify the width of legend bar <2015-08-27, Thu>
+ o add 'colnames_position' parameter to gheatmap, now colnames can be display on the top of heatmap <2015-08-27, Thu> 
+ o theme_transparent to make background transparent <2015-08-27, Thu>
+ o subview for adding ggplot object (subview) to another ggplot object (mainview) <2015-08-27, Thu>  
+
 CHANGES IN VERSION 1.1.16
 ------------------------
  o update citation <2015-08-17, Mon>

R/ggplot2.R

@@ -36,7 +36,12 @@ ggplotGrob <- ggplot2::ggplotGrob
 ##' @param stat The statistical transformation to use on the data for this layer
 ##' @param position The position adjustment to use for overlapping points on this layer
 ##' @param parse if TRUE, the labels will be passd into expressions
+##' @param show.legend logical
+##' @param inherit.aes logical
 ##' @param ... other arguments passed on to 'layer'
+##' @param nudge_x horizontal adjustment
+##' @param nudge_y vertical adjustment
+##' @param check_overlap if TRUE, text that overlaps previous text in the same layer will not be plotted
 ##' @source
 ##' This is just the imported function
 ##' from the ggplot2 package. The documentation you should

R/ggtree.R

@@ -267,7 +267,7 @@ geom_tippoint <- function(...) {
 theme_tree <- function(bgcolor="white", fgcolor="black", ...) {
     theme_tree2() %+replace%
     theme(panel.background=element_rect(fill=bgcolor, colour=bgcolor),
-          axis.line.x = element_line(color=bgcolor),
+          axis.line.x = element_blank(),
           axis.text.x = element_blank(),
           axis.ticks.x = element_blank(),
           ...)
@@ -301,12 +301,32 @@ theme_tree2 <- function(bgcolor="white", fgcolor="black", ...) {
           panel.background=element_rect(fill=bgcolor, colour=bgcolor),
           panel.border=element_blank(),
           axis.line=element_line(color=fgcolor),
-          axis.line.y=element_line(color=bgcolor),
+          axis.line.y=element_blank(),
           axis.ticks.y=element_blank(),
           axis.text.y=element_blank(),
           ...)
 }
 
+##' transparent background theme
+##'
+##' 
+##' @title theme_transparent
+##' @param ... additional parameter to tweak the theme
+##' @return ggplot object
+##' @importFrom ggplot2 theme
+##' @importFrom ggplot2 element_rect
+##' @export
+##' @author Guangchuang Yu
+theme_transparent <- function(...) {
+    theme(panel.background = element_rect(
+              fill = "transparent",
+              colour = NA),
+          plot.background = element_rect(
+              fill = "transparent",
+              colour = NA), ...)
+}
+
+
 ##' hilight clade with rectangle
 ##'
 ##' 
@@ -642,6 +662,7 @@ add_colorbar <- function(p, color, x=NULL, ymin=NULL, ymax=NULL, font.size=4) {
 ##' 
 ##' @title add_legend
 ##' @param p tree view
+##' @param width width of legend
 ##' @param x x position
 ##' @param y y position
 ##' @param offset offset of text and line
@@ -654,7 +675,7 @@ add_colorbar <- function(p, color, x=NULL, ymin=NULL, ymax=NULL, font.size=4) {
 ##' @importFrom ggplot2 ylim
 ##' @export
 ##' @author Guangchuang Yu
-add_legend <- function(p, x=NULL, y=NULL, offset=NULL, font.size=4, ...) {
+add_legend <- function(p, width=NULL, x=NULL, y=NULL, offset=NULL, font.size=4, ...) {
     dx <- p$data$x %>% range %>% diff
 
     if (is.null(x)) {
@@ -666,14 +687,18 @@ add_legend <- function(p, x=NULL, y=NULL, offset=NULL, font.size=4, ...) {
         p <- p + ylim(0, max(p$data$y))
     }
 
-
-    d <- dx/10 
-    n <- 0
-    while (d < 1) {
-        d <- d*10
-        n <- n + 1
+    if (is.null(width) || is.na(width)) {
+        d <- dx/10 
+        n <- 0
+        while (d < 1) {
+            d <- d*10
+            n <- n + 1
+        }
+        d <- floor(d)/(10^n)
+    } else {
+        d <- width
     }
-    d <- floor(d)/(10^n)
+
     if (is.null(offset)) {
         offset <- 0.4
     }

R/gplot.R

@@ -10,6 +10,7 @@
 ##' @param high color of highest value
 ##' @param color color of heatmap cell border
 ##' @param colnames logical, add matrix colnames or not
+##' @param colnames_position one of 'bottom' or 'top'
 ##' @param font.size font size of matrix colnames
 ##' @return tree view
 ##' @importFrom reshape2 melt
@@ -22,7 +23,10 @@
 ##' @export
 ##' @author Guangchuang Yu
 gheatmap <- function(p, data, offset=0, width=1, low="green", high="red",
-                     color="white", colnames=TRUE, font.size=4) {
+                     color="white", colnames=TRUE, colnames_position="bottom", font.size=4) {
+
+    colnames_position %<>% match.arg(c("bottom", "top"))
+
     ## if (is.null(width)) {
     ##     width <- (p$data$x %>% range %>% diff)/30
     ## }
@@ -61,7 +65,12 @@ gheatmap <- function(p, data, offset=0, width=1, low="green", high="red",
     }
 
     if (colnames) {
-        p2 <- p2 + geom_text(data=mapping, aes(x=to, label=from), y=0, size=font.size)
+        if (colnames_position == "bottom") {
+            y <- 0
+        } else {
+            y <- max(p$data$y) + 1
+        }
+        p2 <- p2 + geom_text(data=mapping, aes(x=to, label=from), y=y, size=font.size)
     }
 
     p2 <- p2 + theme(legend.position="right", legend.title=element_blank())

R/subview.R

@@ -0,0 +1,26 @@
+##' add subview to mainview for ggplot2 objects
+##'
+##' 
+##' @title subview
+##' @param mainview main view
+##' @param subview sub view
+##' @param x x position
+##' @param y y position
+##' @param width width of subview, [0,1]
+##' @param height height of subview, [0,1]
+##' @return ggplot object
+##' @importFrom ggplot2 annotation_custom
+##' @importFrom ggplot2 ggplotGrob
+##' @export
+##' @author Guangchuang Yu
+subview <- function(mainview, subview, x, y, width=.1, height=.1) {
+    xrng <- mainview$data$x %>% range %>% diff
+    yrng <- mainview$data$y %>% range %>% diff
+
+    mainview + annotation_custom(
+        ggplotGrob(subview),
+        xmin = x - width*xrng,
+        xmax = x + width*xrng,
+        ymin = y - height*yrng,
+        ymax = y + height*yrng)
+}

man/add_legend.Rd

@@ -4,11 +4,14 @@
 \alias{add_legend}
 \title{add_legend}
 \usage{
-add_legend(p, x = NULL, y = NULL, offset = NULL, font.size = 4, ...)
+add_legend(p, width = NULL, x = NULL, y = NULL, offset = NULL,
+  font.size = 4, ...)
 }
 \arguments{
 \item{p}{tree view}
 
+\item{width}{width of legend}
+
 \item{x}{x position}
 
 \item{y}{y position}

man/geom_text.Rd

@@ -10,7 +10,9 @@ read for the geom_text function can be found here: \link[ggplot2]{geom_text}
 }
 \usage{
 geom_text(mapping = NULL, data = NULL, stat = "identity",
-  position = "identity", parse = FALSE, ...)
+  position = "identity", parse = FALSE, show.legend = NA,
+  inherit.aes = TRUE, ..., nudge_x = 0, nudge_y = 0,
+  check_overlap = FALSE)
 }
 \arguments{
 \item{mapping}{the aesthetic mapping}
@@ -24,7 +26,17 @@ only needed if you want to override he plot defaults.}
 
 \item{parse}{if TRUE, the labels will be passd into expressions}
 
+\item{show.legend}{logical}
+
+\item{inherit.aes}{logical}
+
 \item{...}{other arguments passed on to 'layer'}
+
+\item{nudge_x}{horizontal adjustment}
+
+\item{nudge_y}{vertical adjustment}
+
+\item{check_overlap}{if TRUE, text that overlaps previous text in the same layer will not be plotted}
 }
 \description{
 text annotations

man/gheatmap.Rd

@@ -5,7 +5,8 @@
 \title{gheatmap}
 \usage{
 gheatmap(p, data, offset = 0, width = 1, low = "green", high = "red",
-  color = "white", colnames = TRUE, font.size = 4)
+  color = "white", colnames = TRUE, colnames_position = "bottom",
+  font.size = 4)
 }
 \arguments{
 \item{p}{tree view}
@@ -24,6 +25,8 @@ gheatmap(p, data, offset = 0, width = 1, low = "green", high = "red",
 
 \item{colnames}{logical, add matrix colnames or not}
 
+\item{colnames_position}{one of 'bottom' or 'top'}
+
 \item{font.size}{font size of matrix colnames}
 }
 \value{

man/subview.Rd

@@ -0,0 +1,31 @@
+% Generated by roxygen2 (4.1.1): do not edit by hand
+% Please edit documentation in R/subview.R
+\name{subview}
+\alias{subview}
+\title{subview}
+\usage{
+subview(mainview, subview, x, y, width = 0.1, height = 0.1)
+}
+\arguments{
+\item{mainview}{main view}
+
+\item{subview}{sub view}
+
+\item{x}{x position}
+
+\item{y}{y position}
+
+\item{width}{width of subview, [0,1]}
+
+\item{height}{height of subview, [0,1]}
+}
+\value{
+ggplot object
+}
+\description{
+add subview to mainview for ggplot2 objects
+}
+\author{
+Guangchuang Yu
+}
+

man/theme_transparent.Rd

@@ -0,0 +1,21 @@
+% Generated by roxygen2 (4.1.1): do not edit by hand
+% Please edit documentation in R/ggtree.R
+\name{theme_transparent}
+\alias{theme_transparent}
+\title{theme_transparent}
+\usage{
+theme_transparent(...)
+}
+\arguments{
+\item{...}{additional parameter to tweak the theme}
+}
+\value{
+ggplot object
+}
+\description{
+transparent background theme
+}
+\author{
+Guangchuang Yu
+}
+