R包神器 | ape (九) 基本和高级功能 – 几何及复合图形,自建函数

# oma: 预设外边距的宽度par(oma = rep(2, 4))# [1] 2 2 2 2plot(mytr)# 从内到外4个区域："plot"(默认), "figure", "inner" and "outer"box(lty = 3) # lty - 设置线条样式(Line type)，可取0、1、2、3、4、5、6，分别表示：不划线；实线；虚线；点线；点划线；长划线；点长划线box("figure", col = "blue")# mtext: 将文本写至图形的边距(Margins)# 顺序(顺时针)：下、左、上、右# 预设的外边距宽度不足时，影响此文本的展示for (i in 1:4)    mtext("Outer margin", i, 0.5, outer = TRUE, font = 2, col = "blue")box("outer") # 在整个绘图区的最外层画框for (i in 1:4)    mtext("Inner margin", i, 0.5, outer = FALSE, font = 2, col = "brown")

plot(mytr, no.margin = TRUE)box("plot", lty = 3)

matrix(1:4, 2, 2)#      [,1] [,2]# [1,]    1    3# [2,]    2    4layout(matrix(1:4, 2, 2))par(oma = rep(2, 4))for (i in 1:4) {    par(mar = rep(i, 4))    plot(mytr)    box(lty = 3)    box("figure", col = "blue")}for (i in 1:4)    mtext("Outer margin", i, 0.5, outer = TRUE, font = 2, col = "blue")box("outer")

layout(matrix(c(1, 2, 1, 3), 2, 2))for (i in 1:3) plot(rtree(5))

(pp <- get("last_plot.phylo", envir = .PlotPhyloEnv))# $type# [1] "phylogram"# $use.edge.length# [1] TRUE# $node.pos# [1] 1# $node.depth# [1] 1# $show.tip.label# [1] TRUE# $show.node.label# [1] FALSE# $font# [1] 3# $cex# [1] 0.83# $adj# [1] 0# $srt# [1] 0# $no.margin# [1] FALSE# $label.offset# [1] 0# $x.lim# [1] 0.000000 2.565094# $y.lim# [1] 1 5# $direction# [1] "rightwards"# $tip.color# [1] "black"# $Ntip# [1] 5# $Nnode# [1] 4# $root.time# NULL# $align.tip.label# [1] FALSE# $edge#      [,1] [,2]# [1,]    6    1# [2,]    6    7# [3,]    7    2# [4,]    7    8# [5,]    8    9# [6,]    9    3# [7,]    9    4# [8,]    8    5# $xx# [1] 0.3416120 0.9779764 1.9980659 2.3773992 1.5240125 0.0000000 0.8540463 1.2019900 1.5262024# $yy# [1] 1.0000 2.0000 3.0000 4.0000 5.0000 2.0625 3.1250 4.2500 3.5000

matrix(1:2, 2)#      [,1]# [1,]    1# [2,]    2## split the device into 2:layout(matrix(1:2, 2))## plot the 1st treeplot(rtree(4))## get the parameters of this first plot:pp <- get("last_plot.phylo", envir = .PlotPhyloEnv)## keep the coordinates of the first tip:x <- pp$xx[1]y <- pp$yy[1]## extremes of the coordinates on both axes:(pu <- par("usr"))# [1] -0.04985097  1.29612512  0.88000000  4.12000000## fraction of the plot region:(x - pu[1]) / (pu[2] - pu[1])# [1] 0.78789(y - pu[3]) / (pu[4] - pu[3])# [1] 0.03703704## get the dimensions of plotting region and margins in inches:pi <- par("pin")mi <- par("mai")## convert the coordinates into inches:xi1 <- (x - pu[1]) / (pu[2] - pu[1]) * pi[1] + mi[2]yi1 <- (y - pu[3]) / (pu[4] - pu[3]) * pi[2] + mi[1]## xi1 and yi1 are the final coordinates of this tip in inches## plot the 2nd tree:plot(rtree(4))## same as above:pp <- get("last_plot.phylo", envir = .PlotPhyloEnv)## ... except we take the coordinates of the root:x <- pp$xx[5]y <- pp$yy[5]pu <- par("usr")pi <- par("pin")mi <- par("mai")xi2 <- (x - pu[1]) / (pu[2] - pu[1]) * pi[1] + mi[2]yi2 <- (y - pu[3]) / (pu[4] - pu[3]) * pi[2] + mi[1]## xi2 and yi2 are the final coordinates of this root in inches## we add the height of this second plot to the 'y' coordinate## of the first tip of the first tree which is above the second## one according to layout()yi1 <- yi1 + par("fin")[2]## => this operation depends on the specific layout of plots## get the dimension of the device in inches:di <- par("din")## reset the layoutlayout(1)## set new = TRUE and the margins to zero:par(new = TRUE, mai = rep(0, 4))## set the scales to be [0,1] on both axes (in user coordinates):plot(NA, type = "n", ann = FALSE, axes = FALSE, xlim = 0:1,     ylim = 0:1, xaxs = "i", yaxs = "i")## graphical elements can now be added:fancyarrows(xi1/di[1], yi1/di[2], xi2/di[1], yi2/di[2], 1,            lwd = 10, col = rgb(1, .5, 0, .5), type = "h")

foo <- function(phy1, phy2, from){    layout(matrix(1:2, 2))    plot(phy1, font = 1)    pp <- get("last_plot.phylo", envir = .PlotPhyloEnv)    from <- which(phy1$tip.label == from)    x <- pp$xx[from]    y <- pp$yy[from]    ## fraction of the plot region:    pu <- par("usr")    ## convert into inches:    pi <- par("pin")    mi <- par("mai")    xi1 <- (x - pu[1]) / (pu[2] - pu[1]) * pi[1] + mi[2]    yi1 <- (y - pu[3]) / (pu[4] - pu[3]) * pi[2] + mi[1]    plot(phy2)    pp <- get("last_plot.phylo", envir = .PlotPhyloEnv)    to <- Ntip(phy2) + 1    x <- pp$xx[to]    y <- pp$yy[to]    ## same as above:    pu <- par("usr")    pi <- par("pin")    mi <- par("mai")    xi2 <- (x - pu[1]) / (pu[2] - pu[1]) * pi[1] + mi[2]    yi2 <- (y - pu[3]) / (pu[4] - pu[3]) * pi[2] + mi[1]    yi1 <- yi1 + par("fin")[2]    di <- par("din")    layout(1)    par(new = TRUE, mai = rep(0, 4))    plot(NA, type = "n", ann = FALSE, axes = FALSE, xlim = 0:1,         ylim = 0:1, xaxs = "i", yaxs = "i")    fancyarrows(xi1/di[1], yi1/di[2], xi2/di[1], yi2/di[2], 1,                lwd = 10, col = rgb(1, .5, 0, .5), type = "h")}

trb <- read.tree(text = "((Primates,Carnivora),Monotremata);")par(xpd = TRUE)foo(trb, mytr, "Carnivora")# foo(trb, mytr, "Primates")

plot(mytr, plot = FALSE)# 继承自 已经绘制的图形(即使不可见) 的内部元素的性质：pp <- get("last_plot.phylo", envir = .PlotPhyloEnv)# 选取tip+node的坐标(逆时针)，定义矩形的4个边(左、下、右、上)：rect(pp$xx[5] - 0.1, pp$yy[1] - 0.1, pp$xx[1] + 2, pp$yy[2] + 0.1,     col = "yellow", border = NA)par(new = TRUE)plot(mytr)