How can I plot a tree (and squirrels) in R?

Question

Here is my tree:

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              


        

Answer 1

I probably over-thought this, but... squirrels.

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]
}

And now we plot.

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')

And for kicks we will simulate a bigger tree (and put some apples on it like in 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)
})