如何在 R 中绘制一棵树（和松鼠）？
How can I plot a tree (and squirrels) in R?
这是我的树：
tree = data.frame(branchID = c(1,11,12,111,112,1121,1122), length = c(32, 21, 19, 5, 12, 6, 2))
> tree
branchID length
1 1 32
2 11 21
3 12 19
4 111 5
5 112 12
6 1121 6
7 1122 2
这棵树是二维的，由树枝组成。每个分支都有一个 ID。 1 是后备箱。然后树干分叉成两个分支，左边是11，右边是12。 11 也分叉为 111（向左）和 112（向右）。等等。每个分支都有一定的长度。
这棵树上有松鼠：
squirrels = data.frame(branchID = c(1,11,1121,11,111), PositionOnBranch = c(23, 12, 4, 2, 1), name=c("FluffyTail", "Ginger", "NutCracker", "SuperSquirrel", "ChipnDale"))
> squirrels
branchID PositionOnBranch name
1 1 23 FluffyTail
2 11 12 Ginger
3 1121 4 NutCracker
4 11 2 SuperSquirrel
5 111 1 ChipnDale
每只松鼠都在特定的树枝上。例如 FluffyTail 在树干上的位置 23（树干的总长度为 32）。 ChipnDale在位置1的分支111上（分支111的总长度为5）。相对于分支的下肢采取的位置。
如何绘制我的树和我的松鼠？
重塑它可能需要一段时间，但这在很大程度上是可能的。例如，重新调整您的数据表示，使其看起来像：
library(igraph)
dat <- read.table(text="1 1n2
1n2 1.1
1n2 1.2
1.1 1.1.1
1.1 1.1.2
1.1.2 1.1.2.1
1.1.2 1.1.2.2",header=FALSE)
g <- graph.data.frame(dat)
tkplot(g)
并在tkplot中手动移动树的各个部分，可以得到：
诚然，自动执行此操作是完全不同的故事。
好吧，您可以转换数据以定义 "tree"，如 ape 包所定义的那样。这是一个可以将您的 data.frame 转换为正确格式的函数。
library(ape)
to.tree <- function(dd) {
dd$parent <- dd$branchID %/% 10
root <- subset(dd, parent==0)
dd <- subset(dd, parent!=0)
ids <- unique(c(dd$parent, dd$branchID))
tip <- !(ids %in% dd$parent)
lvl <- ids[order(!tip, ids)]
edg <- sapply(dd[,c("parent","branchID")],
function(x) as.numeric(factor(x, levels=lvl)))
x<-list(
edge=edg,
edge.length=dd$length,
tip.label=head(lvl, sum(tip)),
node.label=tail(lvl, length(tip)-sum(tip)),
Nnode = length(tip)-sum(tip),
root.edge=root$length[1]
)
class(x)<-"phylo"
reorder(x)
}
然后我们可以稍微轻松地绘制它
xx <- to.tree(tree)
plot(xx, show.node.label=TRUE, root.edge=TRUE)
现在，如果我们要添加松鼠信息，我们需要知道每个分支的位置。我要向this answer借getphylo_x和getphylo_y。那我可以运行
sx<-Vectorize(getphylo_x, "node")(xx, as.character(squirrels$branchID)) -
tree$length[match(squirrels$branchID, tree$branchID)] +
squirrels$PositionOnBranch
sy<-Vectorize(getphylo_y, "node")(xx, as.character(squirrels$branchID))
points(sx,sy)
text(sx,sy, squirrels$name, pos=3)
将松鼠信息添加到剧情中。最后的结果是
它并不完美，但它是一个不错的开始。
我大概over-thought这个，但是...松鼠。
get.coords <- function(a, d, x0, y0) {
a <- ifelse(a <= 90, 90 - a, 450 - a)
data.frame(x = x0 + d * cos(a / 180 * pi),
y = y0+ d * sin(a / 180 * pi))
}
tree$angle <- sapply(gsub(2, '+45', gsub(1, '-45', tree$branchID)),
function(x) eval(parse(text=x)))
tree$tipy <- tree$tipx <- tree$basey <- tree$basex <- NA
for(i in seq_len(nrow(tree))) {
if(tree$branchID[i] == 0) {
tree$basex[i] <- tree$basey[i] <- tree$tipx[i] <- 0
tree$tipy[i] <- tree$length[i]
next
} else if(tree$branchID[i] %in% 1:2) {
parent <- 0
} else {
parent <- substr(tree$branchID[i], 1, nchar(tree$branchID[i])-1)
}
tree$basex[i] <- tree$tipx[which(tree$branchID==parent)]
tree$basey[i] <- tree$tipy[which(tree$branchID==parent)]
tip <- get.coords(tree$angle[i], tree$length[i], tree$basex[i], tree$basey[i])
tree$tipx[i] <- tip[, 1]
tree$tipy[i] <- tip[, 2]
}
squirrels$nesty <- squirrels$nestx <- NA
for (i in seq_len(nrow(squirrels))) {
b <- tree[tree$branchID == squirrels$branchID[i], ]
nest <- get.coords(b$angle, squirrels$PositionOnBranch[i], b$basex, b$basey)
squirrels$nestx[i] <- nest[1]
squirrels$nesty[i] <- nest[2]
}
现在我们绘制。
plot.new()
plot.window(xlim=range(tree$basex, tree$tipx),
ylim=range(tree$basey, tree$tipy), asp=1)
with(tree, segments(basex, basey, tipx, tipy, lwd=pmax(10/nchar(branchID), 1)))
points(squirrels[, c('nestx', 'nesty')], pch=21, cex=3, bg='white', lwd=2)
text(squirrels[, c('nestx', 'nesty')], labels=seq_len(nrow(squirrels)), font=2)
legend('bottomleft', legend=paste(seq_len(nrow(squirrels)), squirrels$name), bty='n')
为了好玩，我们将模拟一棵更大的树（并像 Farmville 中一样在上面放一些苹果）：
twigs <- replicate(50, paste(rbinom(5, 1, 0.5) + 1, collapse=''))
branches <- sort(unique(c(sapply(twigs, function(x) sapply(seq_len(nchar(x)), function(y) substr(x, 1, y))))))
tree <- data.frame(branchID=c(0, branches), length=c(30, sample(10, length(branches), TRUE)),
stringsAsFactors=FALSE)
tree$angle <- sapply(gsub(2, '+45', gsub(1, '-45', tree$branchID)),
function(x) eval(parse(text=x)))
tree$tipy <- tree$tipx <- tree$basey <- tree$basex <- NA
for(i in seq_len(nrow(tree))) {
if(tree$branchID[i] == 0) {
tree$basex[i] <- tree$basey[i] <- tree$tipx[i] <- 0
tree$tipy[i] <- tree$length[i]
next
} else if(tree$branchID[i] %in% 1:2) {
parent <- 0
} else {
parent <- substr(tree$branchID[i], 1, nchar(tree$branchID[i])-1)
}
tree$basex[i] <- tree$tipx[which(tree$branchID==parent)]
tree$basey[i] <- tree$tipy[which(tree$branchID==parent)]
tip <- get.coords(tree$angle[i], tree$length[i], tree$basex[i], tree$basey[i])
tree$tipx[i] <- tip[, 1]
tree$tipy[i] <- tip[, 2]
}
plot.new()
plot.window(xlim=range(tree$basex, tree$tipx),
ylim=range(tree$basey, tree$tipy), asp=1)
par(mar=c(0, 0, 0, 0))
with(tree, segments(basex, basey, tipx, tipy, lwd=pmax(20/nchar(branchID), 1)))
apple_branches <- sample(branches, 10)
sapply(apple_branches, function(x) {
b <- tree[tree$branchID == x, ]
apples <- get.coords(b$angle, runif(sample(2, 1), 0, b$length), b$basex, b$basey)
points(apples, pch=20, col='tomato2', cex=2)
})
我在里面多放了一点thought/time，在包trees、here中打包了一些园艺功能。
使用 trees，您可以：
- 使用
seed(); 生成随机树设计（ 随机种子 ，可以这么说）
- 播下种子，结出一棵壮丽的大树
germinate();
- 用
foliate() 添加 randomly-located 叶子（或松鼠）；
- 使用
squirrels() 将松鼠（例如）添加到指定位置；和
prune()树。
# Install the package and set the RNG state
devtools::install_github('johnbaums/trees')
set.seed(1)
让我们施一粒种子，种一棵树
# Create a tree seed
s <- seed(70, 10, min.branch.length=0, max.branch.length=4,
min.trunk.height=5, max.trunk.height=8)
head(s, 10)
# branch length
# 1 0 6.3039785
# 2 L 2.8500587
# 3 LL 1.5999775
# 4 LLL 1.3014086
# 5 LLLL 3.0283486
# 6 LLLLL 0.8107690
# 7 LLLLLR 2.8444849
# 8 LLLLLRL 0.4867677
# 9 LLLLLRLR 0.9819541
# 10 LLLLLRLRR 0.5732175
# Germinate the seed
g <- germinate(s, col='peachpuff4')
并添加一些树叶
leafygreens <- colorRampPalette(paste0('darkolivegreen', c('', 1:4)))(100)
foliate(g, 5000, 4, pch=24:25, col=NA, cex=1.5, bg=paste0(leafygreens, '30'))
或者一些松鼠
plot(g, col='peachpuff4')
squirrels(g,
branches=c("LLLLRRRL", "LRLRR", "LRRLRLLL", "LRRRLL", "RLLLLLR",
"RLLRL", "RLLRRLRR", "RRRLLRL", "RRRLLRR", "RRRRLR"),
pos=c(0.22, 0.77, 0.16, 0.12, 0.71, 0.23, 0.18, 0.61, 0.8, 2.71),
pch=20, cex=2.5)
绘制@Remi.b的树和松鼠
g <- germinate(list(trunk.height=32,
branches=c(1, 2, 11, 12, 121, 122),
lengths=c(21, 19, 5, 12, 6, 2)),
left='1', right='2', angle=40)
xy <- squirrels(g, c(0, 1, 121, 1, 11), pos=c(23, 12, 4, 2, 1),
left='1', right='2', pch=21, bg='white', cex=3, lwd=2)
text(xy$x, xy$y, labels=seq_len(nrow(xy)), font=2)
legend('bottomleft', bty='n',
legend=paste(seq_len(nrow(xy)),
c('FluffyTail', 'Ginger', 'NutCracker', 'SuperSquirrel',
'ChipnDale'), sep='. '))
编辑：
根据@baptiste 关于@ScottChamberlain 的rphylopic 包的热点提示，是时候将这些点升级为松鼠（尽管它们可能类似于咖啡豆）。
library(rphylopic)
s <- seed(50, 10, min.branch.length=0, max.branch.length=5,
min.trunk.height=5, max.trunk.height=8)
g <- germinate(s, trunk.width=15, col='peachpuff4')
leafygreens <- colorRampPalette(paste0('darkolivegreen', c('', 1:4)))(100)
foliate(g, 2000, 4, pch=24:25, col=NA, cex=1.2, bg=paste0(leafygreens, '50'))
xy <- foliate(g, 2, 2, 4, xy=TRUE, plot=FALSE)
# snazzy drop shadow
add_phylopic_base(
image_data("5ebe5f2c-2407-4245-a8fe-397466bb06da", size = "64")[[1]],
1, xy$x, xy$y, ysize = 2.3, col='black')
add_phylopic_base(
image_data("5ebe5f2c-2407-4245-a8fe-397466bb06da", size = "64")[[1]],
1, xy$x, xy$y, ysize = 2, col='darkorange3')
支持多于两个分支的树的版本。需要做一些工作才能转换为 data.tree 结构，并将松鼠添加到其中。但是一旦你到了那里，策划就很简单了。
df <- data.frame(branchID = c(1,11,12,13, 14, 111,112,1121,1122), length = c(32, 21, 12, 8, 19, 5, 12, 6, 2))
squirrels <- data.frame(branchID = c(1,11,1121,11,111), PositionOnBranch = c(23, 12, 4, 2, 1), squirrel=c("FluffyTail", "Ginger", "NutCracker", "SuperSquirrel", "ChipnDale"), stringsAsFactors = FALSE)
library(magrittr)
#derive pathString from branchID, so we can convert it to data.tree structure
df$branchID %>%
as.character %>%
sapply(function(x) strsplit(x, split = "")) %>%
sapply(function(x) paste(x, collapse = "/")) ->
df$pathString
df$type <- "branch"
library(data.tree)
tree <- FromDataFrameTable(df)
#climb, little squirrels!
for (i in 1:nrow(squirrels)) {
squirrels[i, 'branchID'] %>%
as.character %>%
strsplit(split = "") %>%
extract2(1) %>%
extract(-1) -> path
if (length(path) > 0) branch <- tree$Climb(path)
else branch <- tree
#actually, we add the squirrels as branches to our tree
#What a symbiotic coexistence!
#advantage: Our SetCoordinates can be re-used as is
#disadvantage: may be confusing, and it requires us
#to do some filtering later
branch$AddChild(squirrels[i, 'squirrel'],
length = squirrels[i, 'PositionOnBranch'],
type = "squirrel")
}
SetCoordinates <- function(node, branch) {
if (branch$isRoot) {
node$x0 <- 0
node$y0 <- 0
} else {
node$x0 <- branch$parent$x1
node$y0 <- branch$parent$y1
}
#let's hope our squirrels didn't flunk in trigonometry ;-)
angle <- branch$position / (sum(Get(branch$siblings, "type") == "branch") + 2)
x <- - node$length * cospi(angle)
y <- sqrt(node$length^2 - x^2)
node$x1 <- node$x0 + x
node$y1 <- node$y0 + y
}
#let it grow!
tree$Do(function(node) {
SetCoordinates(node, node)
node$lwd <- 10 * (node$root$height - node$level + 1) / node$root$height
}, filterFun = function(node) node$type == "branch")
tree$Do(function(node) SetCoordinates(node, node$parent), filterFun = function(node) node$type == "squirrel")
查看数据：
print(tree, "type", "length", "x0", "y0", "x1", "y1")
打印如下：
levelName type length x0 y0 x1 y1
1 1 branch 32 0.00000 0.00000 0.000000 32.00000
2 ¦--1 branch 21 0.00000 32.00000 -16.989357 44.34349
3 ¦ ¦--1 branch 5 -16.98936 44.34349 -19.489357 48.67362
4 ¦ ¦ °--ChipnDale squirrel 1 -16.98936 44.34349 -17.489357 45.20952
5 ¦ ¦--2 branch 12 -16.98936 44.34349 -10.989357 54.73580
6 ¦ ¦ ¦--1 branch 6 -10.98936 54.73580 -13.989357 59.93195
7 ¦ ¦ ¦ °--NutCracker squirrel 4 -10.98936 54.73580 -12.989357 58.19990
8 ¦ ¦ °--2 branch 2 -10.98936 54.73580 -9.989357 56.46785
9 ¦ ¦--Ginger squirrel 12 0.00000 32.00000 -9.708204 39.05342
10 ¦ °--SuperSquirrel squirrel 2 0.00000 32.00000 -1.618034 33.17557
11 ¦--2 branch 12 0.00000 32.00000 -3.708204 43.41268
12 ¦--3 branch 8 0.00000 32.00000 2.472136 39.60845
13 ¦--4 branch 19 0.00000 32.00000 15.371323 43.16792
14 °--FluffyTail squirrel 23 0.00000 0.00000 0.000000 23.00000
一旦我们到了这里，绘图也很容易：
plot(c(min(tree$Get("x0")), max(tree$Get("x1"))),
c(min(tree$Get("y0")), max(tree$Get("y1"))),
type='n', asp=1, axes=FALSE, xlab='', ylab='')
tree$Do(function(node) segments(node$x0, node$y0, node$x1, node$y1, lwd = node$lwd),
filterFun = function(node) node$type == "branch")
tree$Do(function(node) {
points(node$x1, node$y1, lwd = 8, col = "saddlebrown")
text(node$x1, node$y1, labels = node$name, pos = 2, cex = 0.7)
},
filterFun = function(node) node$type == "squirrel")
这是我的树：
tree = data.frame(branchID = c(1,11,12,111,112,1121,1122), length = c(32, 21, 19, 5, 12, 6, 2))
> tree
branchID length
1 1 32
2 11 21
3 12 19
4 111 5
5 112 12
6 1121 6
7 1122 2
这棵树是二维的，由树枝组成。每个分支都有一个 ID。 1 是后备箱。然后树干分叉成两个分支，左边是11，右边是12。 11 也分叉为 111（向左）和 112（向右）。等等。每个分支都有一定的长度。
这棵树上有松鼠：
squirrels = data.frame(branchID = c(1,11,1121,11,111), PositionOnBranch = c(23, 12, 4, 2, 1), name=c("FluffyTail", "Ginger", "NutCracker", "SuperSquirrel", "ChipnDale"))
> squirrels
branchID PositionOnBranch name
1 1 23 FluffyTail
2 11 12 Ginger
3 1121 4 NutCracker
4 11 2 SuperSquirrel
5 111 1 ChipnDale
每只松鼠都在特定的树枝上。例如 FluffyTail 在树干上的位置 23（树干的总长度为 32）。 ChipnDale在位置1的分支111上（分支111的总长度为5）。相对于分支的下肢采取的位置。
如何绘制我的树和我的松鼠？
重塑它可能需要一段时间，但这在很大程度上是可能的。例如，重新调整您的数据表示，使其看起来像：
library(igraph)
dat <- read.table(text="1 1n2
1n2 1.1
1n2 1.2
1.1 1.1.1
1.1 1.1.2
1.1.2 1.1.2.1
1.1.2 1.1.2.2",header=FALSE)
g <- graph.data.frame(dat)
tkplot(g)
并在tkplot中手动移动树的各个部分，可以得到：
诚然，自动执行此操作是完全不同的故事。
好吧，您可以转换数据以定义 "tree"，如 ape 包所定义的那样。这是一个可以将您的 data.frame 转换为正确格式的函数。
library(ape)
to.tree <- function(dd) {
dd$parent <- dd$branchID %/% 10
root <- subset(dd, parent==0)
dd <- subset(dd, parent!=0)
ids <- unique(c(dd$parent, dd$branchID))
tip <- !(ids %in% dd$parent)
lvl <- ids[order(!tip, ids)]
edg <- sapply(dd[,c("parent","branchID")],
function(x) as.numeric(factor(x, levels=lvl)))
x<-list(
edge=edg,
edge.length=dd$length,
tip.label=head(lvl, sum(tip)),
node.label=tail(lvl, length(tip)-sum(tip)),
Nnode = length(tip)-sum(tip),
root.edge=root$length[1]
)
class(x)<-"phylo"
reorder(x)
}
然后我们可以稍微轻松地绘制它
xx <- to.tree(tree)
plot(xx, show.node.label=TRUE, root.edge=TRUE)
现在，如果我们要添加松鼠信息，我们需要知道每个分支的位置。我要向this answer借getphylo_x和getphylo_y。那我可以运行
sx<-Vectorize(getphylo_x, "node")(xx, as.character(squirrels$branchID)) -
tree$length[match(squirrels$branchID, tree$branchID)] +
squirrels$PositionOnBranch
sy<-Vectorize(getphylo_y, "node")(xx, as.character(squirrels$branchID))
points(sx,sy)
text(sx,sy, squirrels$name, pos=3)
将松鼠信息添加到剧情中。最后的结果是
它并不完美，但它是一个不错的开始。
我大概over-thought这个，但是...松鼠。
get.coords <- function(a, d, x0, y0) {
a <- ifelse(a <= 90, 90 - a, 450 - a)
data.frame(x = x0 + d * cos(a / 180 * pi),
y = y0+ d * sin(a / 180 * pi))
}
tree$angle <- sapply(gsub(2, '+45', gsub(1, '-45', tree$branchID)),
function(x) eval(parse(text=x)))
tree$tipy <- tree$tipx <- tree$basey <- tree$basex <- NA
for(i in seq_len(nrow(tree))) {
if(tree$branchID[i] == 0) {
tree$basex[i] <- tree$basey[i] <- tree$tipx[i] <- 0
tree$tipy[i] <- tree$length[i]
next
} else if(tree$branchID[i] %in% 1:2) {
parent <- 0
} else {
parent <- substr(tree$branchID[i], 1, nchar(tree$branchID[i])-1)
}
tree$basex[i] <- tree$tipx[which(tree$branchID==parent)]
tree$basey[i] <- tree$tipy[which(tree$branchID==parent)]
tip <- get.coords(tree$angle[i], tree$length[i], tree$basex[i], tree$basey[i])
tree$tipx[i] <- tip[, 1]
tree$tipy[i] <- tip[, 2]
}
squirrels$nesty <- squirrels$nestx <- NA
for (i in seq_len(nrow(squirrels))) {
b <- tree[tree$branchID == squirrels$branchID[i], ]
nest <- get.coords(b$angle, squirrels$PositionOnBranch[i], b$basex, b$basey)
squirrels$nestx[i] <- nest[1]
squirrels$nesty[i] <- nest[2]
}
现在我们绘制。
plot.new()
plot.window(xlim=range(tree$basex, tree$tipx),
ylim=range(tree$basey, tree$tipy), asp=1)
with(tree, segments(basex, basey, tipx, tipy, lwd=pmax(10/nchar(branchID), 1)))
points(squirrels[, c('nestx', 'nesty')], pch=21, cex=3, bg='white', lwd=2)
text(squirrels[, c('nestx', 'nesty')], labels=seq_len(nrow(squirrels)), font=2)
legend('bottomleft', legend=paste(seq_len(nrow(squirrels)), squirrels$name), bty='n')
为了好玩，我们将模拟一棵更大的树（并像 Farmville 中一样在上面放一些苹果）：
twigs <- replicate(50, paste(rbinom(5, 1, 0.5) + 1, collapse=''))
branches <- sort(unique(c(sapply(twigs, function(x) sapply(seq_len(nchar(x)), function(y) substr(x, 1, y))))))
tree <- data.frame(branchID=c(0, branches), length=c(30, sample(10, length(branches), TRUE)),
stringsAsFactors=FALSE)
tree$angle <- sapply(gsub(2, '+45', gsub(1, '-45', tree$branchID)),
function(x) eval(parse(text=x)))
tree$tipy <- tree$tipx <- tree$basey <- tree$basex <- NA
for(i in seq_len(nrow(tree))) {
if(tree$branchID[i] == 0) {
tree$basex[i] <- tree$basey[i] <- tree$tipx[i] <- 0
tree$tipy[i] <- tree$length[i]
next
} else if(tree$branchID[i] %in% 1:2) {
parent <- 0
} else {
parent <- substr(tree$branchID[i], 1, nchar(tree$branchID[i])-1)
}
tree$basex[i] <- tree$tipx[which(tree$branchID==parent)]
tree$basey[i] <- tree$tipy[which(tree$branchID==parent)]
tip <- get.coords(tree$angle[i], tree$length[i], tree$basex[i], tree$basey[i])
tree$tipx[i] <- tip[, 1]
tree$tipy[i] <- tip[, 2]
}
plot.new()
plot.window(xlim=range(tree$basex, tree$tipx),
ylim=range(tree$basey, tree$tipy), asp=1)
par(mar=c(0, 0, 0, 0))
with(tree, segments(basex, basey, tipx, tipy, lwd=pmax(20/nchar(branchID), 1)))
apple_branches <- sample(branches, 10)
sapply(apple_branches, function(x) {
b <- tree[tree$branchID == x, ]
apples <- get.coords(b$angle, runif(sample(2, 1), 0, b$length), b$basex, b$basey)
points(apples, pch=20, col='tomato2', cex=2)
})
我在里面多放了一点thought/time，在包trees、here中打包了一些园艺功能。
使用 trees，您可以：
- 使用
seed(); 生成随机树设计（ 随机种子 ，可以这么说）
- 播下种子，结出一棵壮丽的大树
germinate(); - 用
foliate()添加 randomly-located 叶子（或松鼠）； - 使用
squirrels()将松鼠（例如）添加到指定位置；和 prune()树。
# Install the package and set the RNG state
devtools::install_github('johnbaums/trees')
set.seed(1)
让我们施一粒种子，种一棵树
# Create a tree seed
s <- seed(70, 10, min.branch.length=0, max.branch.length=4,
min.trunk.height=5, max.trunk.height=8)
head(s, 10)
# branch length
# 1 0 6.3039785
# 2 L 2.8500587
# 3 LL 1.5999775
# 4 LLL 1.3014086
# 5 LLLL 3.0283486
# 6 LLLLL 0.8107690
# 7 LLLLLR 2.8444849
# 8 LLLLLRL 0.4867677
# 9 LLLLLRLR 0.9819541
# 10 LLLLLRLRR 0.5732175
# Germinate the seed
g <- germinate(s, col='peachpuff4')
并添加一些树叶
leafygreens <- colorRampPalette(paste0('darkolivegreen', c('', 1:4)))(100)
foliate(g, 5000, 4, pch=24:25, col=NA, cex=1.5, bg=paste0(leafygreens, '30'))
或者一些松鼠
plot(g, col='peachpuff4')
squirrels(g,
branches=c("LLLLRRRL", "LRLRR", "LRRLRLLL", "LRRRLL", "RLLLLLR",
"RLLRL", "RLLRRLRR", "RRRLLRL", "RRRLLRR", "RRRRLR"),
pos=c(0.22, 0.77, 0.16, 0.12, 0.71, 0.23, 0.18, 0.61, 0.8, 2.71),
pch=20, cex=2.5)
绘制@Remi.b的树和松鼠
g <- germinate(list(trunk.height=32,
branches=c(1, 2, 11, 12, 121, 122),
lengths=c(21, 19, 5, 12, 6, 2)),
left='1', right='2', angle=40)
xy <- squirrels(g, c(0, 1, 121, 1, 11), pos=c(23, 12, 4, 2, 1),
left='1', right='2', pch=21, bg='white', cex=3, lwd=2)
text(xy$x, xy$y, labels=seq_len(nrow(xy)), font=2)
legend('bottomleft', bty='n',
legend=paste(seq_len(nrow(xy)),
c('FluffyTail', 'Ginger', 'NutCracker', 'SuperSquirrel',
'ChipnDale'), sep='. '))
编辑：
根据@baptiste 关于@ScottChamberlain 的rphylopic 包的热点提示，是时候将这些点升级为松鼠（尽管它们可能类似于咖啡豆）。
library(rphylopic)
s <- seed(50, 10, min.branch.length=0, max.branch.length=5,
min.trunk.height=5, max.trunk.height=8)
g <- germinate(s, trunk.width=15, col='peachpuff4')
leafygreens <- colorRampPalette(paste0('darkolivegreen', c('', 1:4)))(100)
foliate(g, 2000, 4, pch=24:25, col=NA, cex=1.2, bg=paste0(leafygreens, '50'))
xy <- foliate(g, 2, 2, 4, xy=TRUE, plot=FALSE)
# snazzy drop shadow
add_phylopic_base(
image_data("5ebe5f2c-2407-4245-a8fe-397466bb06da", size = "64")[[1]],
1, xy$x, xy$y, ysize = 2.3, col='black')
add_phylopic_base(
image_data("5ebe5f2c-2407-4245-a8fe-397466bb06da", size = "64")[[1]],
1, xy$x, xy$y, ysize = 2, col='darkorange3')
支持多于两个分支的树的版本。需要做一些工作才能转换为 data.tree 结构，并将松鼠添加到其中。但是一旦你到了那里，策划就很简单了。
df <- data.frame(branchID = c(1,11,12,13, 14, 111,112,1121,1122), length = c(32, 21, 12, 8, 19, 5, 12, 6, 2))
squirrels <- data.frame(branchID = c(1,11,1121,11,111), PositionOnBranch = c(23, 12, 4, 2, 1), squirrel=c("FluffyTail", "Ginger", "NutCracker", "SuperSquirrel", "ChipnDale"), stringsAsFactors = FALSE)
library(magrittr)
#derive pathString from branchID, so we can convert it to data.tree structure
df$branchID %>%
as.character %>%
sapply(function(x) strsplit(x, split = "")) %>%
sapply(function(x) paste(x, collapse = "/")) ->
df$pathString
df$type <- "branch"
library(data.tree)
tree <- FromDataFrameTable(df)
#climb, little squirrels!
for (i in 1:nrow(squirrels)) {
squirrels[i, 'branchID'] %>%
as.character %>%
strsplit(split = "") %>%
extract2(1) %>%
extract(-1) -> path
if (length(path) > 0) branch <- tree$Climb(path)
else branch <- tree
#actually, we add the squirrels as branches to our tree
#What a symbiotic coexistence!
#advantage: Our SetCoordinates can be re-used as is
#disadvantage: may be confusing, and it requires us
#to do some filtering later
branch$AddChild(squirrels[i, 'squirrel'],
length = squirrels[i, 'PositionOnBranch'],
type = "squirrel")
}
SetCoordinates <- function(node, branch) {
if (branch$isRoot) {
node$x0 <- 0
node$y0 <- 0
} else {
node$x0 <- branch$parent$x1
node$y0 <- branch$parent$y1
}
#let's hope our squirrels didn't flunk in trigonometry ;-)
angle <- branch$position / (sum(Get(branch$siblings, "type") == "branch") + 2)
x <- - node$length * cospi(angle)
y <- sqrt(node$length^2 - x^2)
node$x1 <- node$x0 + x
node$y1 <- node$y0 + y
}
#let it grow!
tree$Do(function(node) {
SetCoordinates(node, node)
node$lwd <- 10 * (node$root$height - node$level + 1) / node$root$height
}, filterFun = function(node) node$type == "branch")
tree$Do(function(node) SetCoordinates(node, node$parent), filterFun = function(node) node$type == "squirrel")
查看数据：
print(tree, "type", "length", "x0", "y0", "x1", "y1")
打印如下：
levelName type length x0 y0 x1 y1
1 1 branch 32 0.00000 0.00000 0.000000 32.00000
2 ¦--1 branch 21 0.00000 32.00000 -16.989357 44.34349
3 ¦ ¦--1 branch 5 -16.98936 44.34349 -19.489357 48.67362
4 ¦ ¦ °--ChipnDale squirrel 1 -16.98936 44.34349 -17.489357 45.20952
5 ¦ ¦--2 branch 12 -16.98936 44.34349 -10.989357 54.73580
6 ¦ ¦ ¦--1 branch 6 -10.98936 54.73580 -13.989357 59.93195
7 ¦ ¦ ¦ °--NutCracker squirrel 4 -10.98936 54.73580 -12.989357 58.19990
8 ¦ ¦ °--2 branch 2 -10.98936 54.73580 -9.989357 56.46785
9 ¦ ¦--Ginger squirrel 12 0.00000 32.00000 -9.708204 39.05342
10 ¦ °--SuperSquirrel squirrel 2 0.00000 32.00000 -1.618034 33.17557
11 ¦--2 branch 12 0.00000 32.00000 -3.708204 43.41268
12 ¦--3 branch 8 0.00000 32.00000 2.472136 39.60845
13 ¦--4 branch 19 0.00000 32.00000 15.371323 43.16792
14 °--FluffyTail squirrel 23 0.00000 0.00000 0.000000 23.00000
一旦我们到了这里，绘图也很容易：
plot(c(min(tree$Get("x0")), max(tree$Get("x1"))),
c(min(tree$Get("y0")), max(tree$Get("y1"))),
type='n', asp=1, axes=FALSE, xlab='', ylab='')
tree$Do(function(node) segments(node$x0, node$y0, node$x1, node$y1, lwd = node$lwd),
filterFun = function(node) node$type == "branch")
tree$Do(function(node) {
points(node$x1, node$y1, lwd = 8, col = "saddlebrown")
text(node$x1, node$y1, labels = node$name, pos = 2, cex = 0.7)
},
filterFun = function(node) node$type == "squirrel")