如何在 R 中绘制树（和松鼠）？
Posted
技术标签:
【中文标题】如何在 R 中绘制树（和松鼠）？【英文标题】：How can I plot a tree (and squirrels) in R? 【发布时间】：2015-01-27 05:43:16 【问题描述】：这是我的树：
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）。该位置相对于分支的下端。
如何绘制我的树和松鼠？
【问题讨论】：
也许还可以考虑对rpart 绘图进行一些修改以适合您的树结构？
【参考方案1】：
我对此投入了更多的思考/时间，并在包trees、here 中打包了一些园艺功能。
使用trees，您可以：
seed() 生成随机树设计（随机种子）；
用germinate()播下种子，长成一棵壮丽的树；
用foliate()添加随机位置的叶子（或松鼠）；
用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')
【讨论】：
好吧，这太疯狂了！你真的为我的需要创建了一个包吗？！这些树看起来很酷。非常感谢。 @Remi.b：我创建了一个包，因为这是一个有趣的问题！:-)
这可能是我在 R 标签中见过的最棒的答案。太棒了！
你应该尝试用这个包添加松鼠github.com/sckott/rphylopic
grid::grid.raster(rphylopic::image_data("5ebe5f2c-2407-4245-a8fe-397466bb06da", size = "thumb")[[1]]) 绘制一个【参考方案2】：
我可能想多了，但是……松鼠。
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)
)
【讨论】：
我忘了提到我冒昧地给了树干branchID=0，并从其他所有东西中删除了第一个1（所以树干的前两个分支是1和2.
哈哈这太棒了！做得好。我实际上只是写了一个代码来随机生成树。但是你的代码似乎比我的更高效，而且情节也很棒。我可能会忘记我的并拿走你的。您能否指出我如何在您的代码中定义从中获取分支长度的分布以及定义分支的 nb 的位置以及如何将苹果随机放置在树上。非常感谢！
@Remi.b 我将通过这个答案整理并在我有时间的时候回答你的问题。不过，简而言之，我随机抽取了 50 个第 6 层分支的样本（paste(rbinom(5, 1, 0.5) + 1, collapse='') 给出了一个这样的分支，我复制了 50 次），并将这个样本减少到一个唯一的集合。这种方法不能完全控制分支的数量，而是在一定程度上被replicate(50, ...) 操纵。然后我将所有父分支添加到集合中，包括主干。
对于苹果，我选择了 10 个分支的随机样本 (apple_branches <- sample(branches, 10))，对于这些分支中的每一个，我随机选择放置 1 个或 2 个苹果，这些苹果的位置是随机的介于 0（分支开始）和 b$length（分支结束）之间。【参考方案3】：
好吧，您可以转换您的数据以定义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)
将松鼠信息添加到情节中。最终结果是
这并不完美，但也不是一个糟糕的开始。
【讨论】：
看起来真不错！ +1。谢谢你。但是，我无法复制您的树。to_tree 中的函数 reorder 会引发错误。我对绘制系统发育一无所知。您知道我们是否可以轻松修改您的图表，使分支笔直（不弯曲）并以一定角度离开分叉（例如，新分支形成 80 度角）？
我忘了包含该行，但请确保您加载了 ape 库。该库确实有其他用于绘制树的选项，但我编写的用于放置松鼠的代码都不适用于对角分支。
是的，我加载了ape 包。但是，reorder 函数需要两个参数，它在to.tree 函数中运行时返回Error in tapply(X = X, INDEX = x, FUN = FUN, ...) : argument "X" is missing, with no default。我尝试使用reorder.phylo，但随后情节失败并抛出消息'x' is a list, but does not have components 'x' and 'y'。有什么我弄错了吗？ （我使用的是R 3.1.2 GUI 1.65 Mavericks build）。
哦，好吧。我应该自己发现错误的。非常感谢！【参考方案4】：
重新塑造它可能需要一段时间，但这大体上是可能的。例如，重新调整您的数据表示，使其看起来像：
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中手动移动树的部分，可以得到：
诚然，自动执行此操作是另一回事。
【讨论】：
【参考方案5】：支持具有两个以上分支的树的版本。需要做一些工作才能转换为 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")
【讨论】：
以上是关于如何在 R 中绘制树（和松鼠）？的主要内容，如果未能解决你的问题，请参考以下文章