Browse code

subview function

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

g.yu authored on 27/08/2015 04:23:07
Showing 12 changed files

... ...
@@ -1,7 +1,7 @@
1 1
 Package: ggtree
2 2
 Type: Package
3 3
 Title: a phylogenetic tree viewer for different types of tree annotations
4
-Version: 1.1.16
4
+Version: 1.1.17
5 5
 Author: Guangchuang Yu and Tommy Tsan-Yuk Lam
6 6
 Maintainer: Guangchuang Yu <guangchuangyu@gmail.com>
7 7
 Description: ggtree extends the ggplot2 plotting system which implemented the
... ...
@@ -71,6 +71,8 @@ export(rtree)
71 71
 export(scaleClade)
72 72
 export(scale_color)
73 73
 export(scale_x_ggtree)
74
+export(subview)
75
+export(theme_transparent)
74 76
 export(theme_tree)
75 77
 export(theme_tree2)
76 78
 export(write.jplace)
... ...
@@ -129,6 +131,7 @@ importFrom(ggplot2,geom_segment)
129 131
 importFrom(ggplot2,geom_text)
130 132
 importFrom(ggplot2,geom_tile)
131 133
 importFrom(ggplot2,ggplot)
134
+importFrom(ggplot2,ggplotGrob)
132 135
 importFrom(ggplot2,guide_legend)
133 136
 importFrom(ggplot2,guides)
134 137
 importFrom(ggplot2,labs)
... ...
@@ -1,3 +1,10 @@
1
+CHANGES IN VERSION 1.1.17
2
+------------------------
3
+ o add 'width' parameter to add_legend, now user can specify the width of legend bar <2015-08-27, Thu>
4
+ o add 'colnames_position' parameter to gheatmap, now colnames can be display on the top of heatmap <2015-08-27, Thu> 
5
+ o theme_transparent to make background transparent <2015-08-27, Thu>
6
+ o subview for adding ggplot object (subview) to another ggplot object (mainview) <2015-08-27, Thu>  
7
+ 
1 8
 CHANGES IN VERSION 1.1.16
2 9
 ------------------------
3 10
  o update citation <2015-08-17, Mon>
... ...
@@ -36,7 +36,12 @@ ggplotGrob <- ggplot2::ggplotGrob
36 36
 ##' @param stat The statistical transformation to use on the data for this layer
37 37
 ##' @param position The position adjustment to use for overlapping points on this layer
38 38
 ##' @param parse if TRUE, the labels will be passd into expressions
39
+##' @param show.legend logical
40
+##' @param inherit.aes logical
39 41
 ##' @param ... other arguments passed on to 'layer'
42
+##' @param nudge_x horizontal adjustment
43
+##' @param nudge_y vertical adjustment
44
+##' @param check_overlap if TRUE, text that overlaps previous text in the same layer will not be plotted
40 45
 ##' @source
41 46
 ##' This is just the imported function
42 47
 ##' from the ggplot2 package. The documentation you should
... ...
@@ -267,7 +267,7 @@ geom_tippoint <- function(...) {
267 267
 theme_tree <- function(bgcolor="white", fgcolor="black", ...) {
268 268
     theme_tree2() %+replace%
269 269
     theme(panel.background=element_rect(fill=bgcolor, colour=bgcolor),
270
-          axis.line.x = element_line(color=bgcolor),
270
+          axis.line.x = element_blank(),
271 271
           axis.text.x = element_blank(),
272 272
           axis.ticks.x = element_blank(),
273 273
           ...)
... ...
@@ -301,12 +301,32 @@ theme_tree2 <- function(bgcolor="white", fgcolor="black", ...) {
301 301
           panel.background=element_rect(fill=bgcolor, colour=bgcolor),
302 302
           panel.border=element_blank(),
303 303
           axis.line=element_line(color=fgcolor),
304
-          axis.line.y=element_line(color=bgcolor),
304
+          axis.line.y=element_blank(),
305 305
           axis.ticks.y=element_blank(),
306 306
           axis.text.y=element_blank(),
307 307
           ...)
308 308
 }
309 309
 
310
+##' transparent background theme
311
+##'
312
+##' 
313
+##' @title theme_transparent
314
+##' @param ... additional parameter to tweak the theme
315
+##' @return ggplot object
316
+##' @importFrom ggplot2 theme
317
+##' @importFrom ggplot2 element_rect
318
+##' @export
319
+##' @author Guangchuang Yu
320
+theme_transparent <- function(...) {
321
+    theme(panel.background = element_rect(
322
+              fill = "transparent",
323
+              colour = NA),
324
+          plot.background = element_rect(
325
+              fill = "transparent",
326
+              colour = NA), ...)
327
+}
328
+
329
+
310 330
 ##' hilight clade with rectangle
311 331
 ##'
312 332
 ##' 
... ...
@@ -642,6 +662,7 @@ add_colorbar <- function(p, color, x=NULL, ymin=NULL, ymax=NULL, font.size=4) {
642 662
 ##' 
643 663
 ##' @title add_legend
644 664
 ##' @param p tree view
665
+##' @param width width of legend
645 666
 ##' @param x x position
646 667
 ##' @param y y position
647 668
 ##' @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) {
654 675
 ##' @importFrom ggplot2 ylim
655 676
 ##' @export
656 677
 ##' @author Guangchuang Yu
657
-add_legend <- function(p, x=NULL, y=NULL, offset=NULL, font.size=4, ...) {
678
+add_legend <- function(p, width=NULL, x=NULL, y=NULL, offset=NULL, font.size=4, ...) {
658 679
     dx <- p$data$x %>% range %>% diff
659 680
     
660 681
     if (is.null(x)) {
... ...
@@ -666,14 +687,18 @@ add_legend <- function(p, x=NULL, y=NULL, offset=NULL, font.size=4, ...) {
666 687
         p <- p + ylim(0, max(p$data$y))
667 688
     }
668 689
 
669
-
670
-    d <- dx/10 
671
-    n <- 0
672
-    while (d < 1) {
673
-        d <- d*10
674
-        n <- n + 1
690
+    if (is.null(width) || is.na(width)) {
691
+        d <- dx/10 
692
+        n <- 0
693
+        while (d < 1) {
694
+            d <- d*10
695
+            n <- n + 1
696
+        }
697
+        d <- floor(d)/(10^n)
698
+    } else {
699
+        d <- width
675 700
     }
676
-    d <- floor(d)/(10^n)
701
+    
677 702
     if (is.null(offset)) {
678 703
         offset <- 0.4
679 704
     }
... ...
@@ -10,6 +10,7 @@
10 10
 ##' @param high color of highest value
11 11
 ##' @param color color of heatmap cell border
12 12
 ##' @param colnames logical, add matrix colnames or not
13
+##' @param colnames_position one of 'bottom' or 'top'
13 14
 ##' @param font.size font size of matrix colnames
14 15
 ##' @return tree view
15 16
 ##' @importFrom reshape2 melt
... ...
@@ -22,7 +23,10 @@
22 23
 ##' @export
23 24
 ##' @author Guangchuang Yu
24 25
 gheatmap <- function(p, data, offset=0, width=1, low="green", high="red",
25
-                     color="white", colnames=TRUE, font.size=4) {
26
+                     color="white", colnames=TRUE, colnames_position="bottom", font.size=4) {
27
+
28
+    colnames_position %<>% match.arg(c("bottom", "top"))
29
+    
26 30
     ## if (is.null(width)) {
27 31
     ##     width <- (p$data$x %>% range %>% diff)/30
28 32
     ## }
... ...
@@ -61,7 +65,12 @@ gheatmap <- function(p, data, offset=0, width=1, low="green", high="red",
61 65
     }
62 66
     
63 67
     if (colnames) {
64
-        p2 <- p2 + geom_text(data=mapping, aes(x=to, label=from), y=0, size=font.size)
68
+        if (colnames_position == "bottom") {
69
+            y <- 0
70
+        } else {
71
+            y <- max(p$data$y) + 1
72
+        }
73
+        p2 <- p2 + geom_text(data=mapping, aes(x=to, label=from), y=y, size=font.size)
65 74
     }
66 75
 
67 76
     p2 <- p2 + theme(legend.position="right", legend.title=element_blank())
68 77
new file mode 100644
... ...
@@ -0,0 +1,26 @@
1
+##' add subview to mainview for ggplot2 objects
2
+##'
3
+##' 
4
+##' @title subview
5
+##' @param mainview main view
6
+##' @param subview sub view
7
+##' @param x x position
8
+##' @param y y position
9
+##' @param width width of subview, [0,1]
10
+##' @param height height of subview, [0,1]
11
+##' @return ggplot object
12
+##' @importFrom ggplot2 annotation_custom
13
+##' @importFrom ggplot2 ggplotGrob
14
+##' @export
15
+##' @author Guangchuang Yu
16
+subview <- function(mainview, subview, x, y, width=.1, height=.1) {
17
+    xrng <- mainview$data$x %>% range %>% diff
18
+    yrng <- mainview$data$y %>% range %>% diff
19
+   
20
+    mainview + annotation_custom(
21
+        ggplotGrob(subview),
22
+        xmin = x - width*xrng,
23
+        xmax = x + width*xrng,
24
+        ymin = y - height*yrng,
25
+        ymax = y + height*yrng)
26
+}
... ...
@@ -4,11 +4,14 @@
4 4
 \alias{add_legend}
5 5
 \title{add_legend}
6 6
 \usage{
7
-add_legend(p, x = NULL, y = NULL, offset = NULL, font.size = 4, ...)
7
+add_legend(p, width = NULL, x = NULL, y = NULL, offset = NULL,
8
+  font.size = 4, ...)
8 9
 }
9 10
 \arguments{
10 11
 \item{p}{tree view}
11 12
 
13
+\item{width}{width of legend}
14
+
12 15
 \item{x}{x position}
13 16
 
14 17
 \item{y}{y position}
... ...
@@ -10,7 +10,9 @@ read for the geom_text function can be found here: \link[ggplot2]{geom_text}
10 10
 }
11 11
 \usage{
12 12
 geom_text(mapping = NULL, data = NULL, stat = "identity",
13
-  position = "identity", parse = FALSE, ...)
13
+  position = "identity", parse = FALSE, show.legend = NA,
14
+  inherit.aes = TRUE, ..., nudge_x = 0, nudge_y = 0,
15
+  check_overlap = FALSE)
14 16
 }
15 17
 \arguments{
16 18
 \item{mapping}{the aesthetic mapping}
... ...
@@ -24,7 +26,17 @@ only needed if you want to override he plot defaults.}
24 26
 
25 27
 \item{parse}{if TRUE, the labels will be passd into expressions}
26 28
 
29
+\item{show.legend}{logical}
30
+
31
+\item{inherit.aes}{logical}
32
+
27 33
 \item{...}{other arguments passed on to 'layer'}
34
+
35
+\item{nudge_x}{horizontal adjustment}
36
+
37
+\item{nudge_y}{vertical adjustment}
38
+
39
+\item{check_overlap}{if TRUE, text that overlaps previous text in the same layer will not be plotted}
28 40
 }
29 41
 \description{
30 42
 text annotations
... ...
@@ -5,7 +5,8 @@
5 5
 \title{gheatmap}
6 6
 \usage{
7 7
 gheatmap(p, data, offset = 0, width = 1, low = "green", high = "red",
8
-  color = "white", colnames = TRUE, font.size = 4)
8
+  color = "white", colnames = TRUE, colnames_position = "bottom",
9
+  font.size = 4)
9 10
 }
10 11
 \arguments{
11 12
 \item{p}{tree view}
... ...
@@ -24,6 +25,8 @@ gheatmap(p, data, offset = 0, width = 1, low = "green", high = "red",
24 25
 
25 26
 \item{colnames}{logical, add matrix colnames or not}
26 27
 
28
+\item{colnames_position}{one of 'bottom' or 'top'}
29
+
27 30
 \item{font.size}{font size of matrix colnames}
28 31
 }
29 32
 \value{
30 33
new file mode 100644
... ...
@@ -0,0 +1,31 @@
1
+% Generated by roxygen2 (4.1.1): do not edit by hand
2
+% Please edit documentation in R/subview.R
3
+\name{subview}
4
+\alias{subview}
5
+\title{subview}
6
+\usage{
7
+subview(mainview, subview, x, y, width = 0.1, height = 0.1)
8
+}
9
+\arguments{
10
+\item{mainview}{main view}
11
+
12
+\item{subview}{sub view}
13
+
14
+\item{x}{x position}
15
+
16
+\item{y}{y position}
17
+
18
+\item{width}{width of subview, [0,1]}
19
+
20
+\item{height}{height of subview, [0,1]}
21
+}
22
+\value{
23
+ggplot object
24
+}
25
+\description{
26
+add subview to mainview for ggplot2 objects
27
+}
28
+\author{
29
+Guangchuang Yu
30
+}
31
+
0 32
new file mode 100644
... ...
@@ -0,0 +1,21 @@
1
+% Generated by roxygen2 (4.1.1): do not edit by hand
2
+% Please edit documentation in R/ggtree.R
3
+\name{theme_transparent}
4
+\alias{theme_transparent}
5
+\title{theme_transparent}
6
+\usage{
7
+theme_transparent(...)
8
+}
9
+\arguments{
10
+\item{...}{additional parameter to tweak the theme}
11
+}
12
+\value{
13
+ggplot object
14
+}
15
+\description{
16
+transparent background theme
17
+}
18
+\author{
19
+Guangchuang Yu
20
+}
21
+