git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/ggtree@115593 bc3139a8-67e5-0310-9ffc-ced21a209358
... | ... |
@@ -43,6 +43,7 @@ export(geom_point2) |
43 | 43 |
export(geom_range) |
44 | 44 |
export(geom_rootpoint) |
45 | 45 |
export(geom_segment2) |
46 |
+export(geom_taxalink) |
|
46 | 47 |
export(geom_text2) |
47 | 48 |
export(geom_tiplab) |
48 | 49 |
export(geom_tippoint) |
... | ... |
@@ -153,6 +154,7 @@ importFrom(ape,reorder.phylo) |
153 | 154 |
importFrom(ape,which.edge) |
154 | 155 |
importFrom(ape,write.tree) |
155 | 156 |
importFrom(ggplot2,"%+replace%") |
157 |
+importFrom(ggplot2,GeomCurve) |
|
156 | 158 |
importFrom(ggplot2,GeomPoint) |
157 | 159 |
importFrom(ggplot2,GeomRect) |
158 | 160 |
importFrom(ggplot2,GeomSegment) |
17 | 15 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,55 @@ |
1 |
+##' link between taxa |
|
2 |
+##' |
|
3 |
+##' |
|
4 |
+##' @title geom_taxalink |
|
5 |
+##' @param taxa1 taxa1, can be label or node number |
|
6 |
+##' @param taxa2 taxa2, can be label or node number |
|
7 |
+##' @param curvature A numeric value giving the amount of curvature. |
|
8 |
+##' Negative values produce left-hand curves, |
|
9 |
+##' positive values produce right-hand curves, and zero produces a straight line. |
|
10 |
+##' @param ... additional parameter |
|
11 |
+##' @return ggplot layer |
|
12 |
+##' @export |
|
13 |
+##' @importFrom ggplot2 GeomCurve |
|
14 |
+##' @author Guangchuang Yu |
|
15 |
+geom_taxalink <- function(taxa1, taxa2, curvature=0.5, ...) { |
|
16 |
+ position = "identity" |
|
17 |
+ show.legend = NA |
|
18 |
+ na.rm = TRUE |
|
19 |
+ inherit.aes = FALSE |
|
20 |
+ |
|
21 |
+ mapping <- aes_(x=~x, y=~y, node=~node, label=~label) |
|
22 |
+ |
|
23 |
+ layer(stat=StatTaxalink, |
|
24 |
+ mapping=aes_(x=~x, y=~y, node=~node, label=~label), |
|
25 |
+ geom=GeomCurve, |
|
26 |
+ position='identity', |
|
27 |
+ show.legend=show.legend, |
|
28 |
+ inherit.aes = inherit.aes, |
|
29 |
+ params = list(taxa1 = taxa1, |
|
30 |
+ taxa2 = taxa2, |
|
31 |
+ curvature = curvature, |
|
32 |
+ na.rm = na.rm, |
|
33 |
+ ...) |
|
34 |
+ ) |
|
35 |
+} |
|
36 |
+ |
|
37 |
+ |
|
38 |
+StatTaxalink <- ggproto("StatTaxalink", Stat, |
|
39 |
+ compute_group = function(self, data, scales, params, taxa1, taxa2) { |
|
40 |
+ node <- data$node |
|
41 |
+ label <- data$label |
|
42 |
+ node1 <- which(taxa1 == label | taxa1 == node) |
|
43 |
+ node2 <- which(taxa2 == label | taxa2 == node) |
|
44 |
+ x <- data$x |
|
45 |
+ y <- data$y |
|
46 |
+ |
|
47 |
+ data.frame(x = x[node1], |
|
48 |
+ xend = x[node2], |
|
49 |
+ y = y[node1], |
|
50 |
+ yend = y[node2]) |
|
51 |
+ |
|
52 |
+ }, |
|
53 |
+ required_aes = c("x", "y", "xend", "yend") |
|
54 |
+ ) |
|
55 |
+ |
0 | 56 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,29 @@ |
1 |
+% Generated by roxygen2: do not edit by hand |
|
2 |
+% Please edit documentation in R/geom_taxalink.R |
|
3 |
+\name{geom_taxalink} |
|
4 |
+\alias{geom_taxalink} |
|
5 |
+\title{geom_taxalink} |
|
6 |
+\usage{ |
|
7 |
+geom_taxalink(taxa1, taxa2, curvature = -0.5, ...) |
|
8 |
+} |
|
9 |
+\arguments{ |
|
10 |
+\item{taxa1}{taxa1, can be label or node number} |
|
11 |
+ |
|
12 |
+\item{taxa2}{taxa2, can be label or node number} |
|
13 |
+ |
|
14 |
+\item{curvature}{A numeric value giving the amount of curvature. |
|
15 |
+Negative values produce left-hand curves, |
|
16 |
+positive values produce right-hand curves, and zero produces a straight line.} |
|
17 |
+ |
|
18 |
+\item{...}{additional parameter} |
|
19 |
+} |
|
20 |
+\value{ |
|
21 |
+ggplot layer |
|
22 |
+} |
|
23 |
+\description{ |
|
24 |
+link between taxa |
|
25 |
+} |
|
26 |
+\author{ |
|
27 |
+Guangchuang Yu |
|
28 |
+} |
|
29 |
+ |