Question

假设我想生成一种类似下面的树结构：

plot(0, type="n",xlim=c(0, 5), ylim=c(-3, 8), axes=FALSE, xlab="", ylab="", main="")
points(1, 2.5)
points(3, 5)
points(3, 0)
lines(c(1, 3), c(2.5, 5))
lines(c(1, 3), c(2.5, 0))
text(1, 2.5, adj=1, label="Parent   ")
text(3, 5, adj=0, label="   Child 1")
text(3, 0, adj=0, label="   Child 2")

我想知道R中是否有一种方法可以产生类似于下面不同程度的S曲线的曲线。至关重要的是，如果能够在不诉诸ggplot的情况下创建这样的行，那就太棒了。

删除了编辑并作出答案

Answer 1

按照@ thelatemail的建议，我决定让我的编辑得到答案。我的解决方案基于@ thelatemail的答案。

我写了一个小函数来绘制曲线，它使用了逻辑函数：

#Create the function
curveMaker <- function(x1, y1, x2, y2, ...){
    curve( plogis( x, scale = 0.08, loc = (x1 + x2) /2 ) * (y2-y1) + y1, 
                   x1, x2, add = TRUE, ...)
}

下面是一个工作示例。在这个例子中，我想为3个级别的分类法创建一个图：parent - ＆gt; 2 children - ＆gt; 20 grandchildren。一个孩子有12个孙子，另一个孩子有8个孩子。

#Prepare data:
parent <- c(1, 16)
children <- cbind(2, c(8, 28))
grandchildren <- cbind(3, (1:20)*2-1)
labels <- c("Parent ", paste("Child ", 1:2), paste(" Grandchild", 1:20) )


#Make a blank plot canvas
plot(0, type="n", ann = FALSE, xlim = c( 0.5, 3.5 ), ylim = c( 0.5, 39.5 ), axes = FALSE )

#Plot curves
#Parent and children
invisible( mapply( curveMaker, 
                   x1 = parent[ 1 ], 
                   y1 = parent[ 2 ], 
                   x2 = children[ , 1 ], 
                   y2 = children[ , 2 ], 
                   col = gray( 0.6, alpha = 0.6 ), lwd = 1.5 ) )

#Children and grandchildren
invisible( mapply( curveMaker, 
                   x1 = children[ 1, 1 ], 
                   y1 = children[ 1, 2 ], 
                   x2 = grandchildren[ 1:8 , 1 ], 
                   y2 = grandchildren[ 1:8, 2 ], 
                   col = gray( 0.6, alpha = 0.6 ), lwd = 1.5 ) ) 
invisible( mapply( curveMaker, 
                   x1 = children[ 2, 1 ], 
                   y1 = children[ 2, 2 ], 
                   x2 = grandchildren[ 9:20 , 1 ], 
                   y2 = grandchildren[ 9:20, 2 ], 
                   col = gray( 0.6, alpha = 0.6 ), lwd = 1.5 ) )
#Plot text
text( x = c(parent[1], children[,1], grandchildren[,1]), 
      y = c(parent[2], children[,2], grandchildren[,2]),
      labels = labels,
      pos = rep(c(2, 4), c(3, 20) ) ) 

#Plot points
points( x = c(parent[1], children[,1], grandchildren[,1]),
        y = c(parent[2], children[,2], grandchildren[,2]), 
        pch = 21, bg = "white", col="#3182bd", lwd=2.5, cex=1)

Answer 2

听起来像是一个S形曲线，例如：

f <- function(x,s) s/(1 + exp(-x))
curve(f(x,s=1),xlim=c(-4,4))
curve(f(x,s=0.9),xlim=c(-4,4),add=TRUE)
curve(f(x,s=0.8),xlim=c(-4,4),add=TRUE)
curve(f(x,s=0.7),xlim=c(-4,4),add=TRUE)

结果：

你可以开始适应这种情况，例如：这是一段笨重的代码：

plot(NA,type="n",ann=FALSE,axes=FALSE,xlim=c(-6,6),ylim=c(0,1))
curve(f(x,s=1),xlim=c(-4,4),add=TRUE)
curve(f(x,s=0.8),xlim=c(-4,4),add=TRUE)
curve(f(x,s=0.6),xlim=c(-4,4),add=TRUE)
text(
   c(-4,rep(4,3)),
   c(0,f(c(4),c(1,0.8,0.6))),
   labels=c("Parent","Kid 1","Kid 2","Kid 3"), 
   pos=c(2,4,4,4)
)

结果：

Answer 3

我认为Paul Murrell有一份文件说明网格中的类似图表。这是一个基本的例子，

library(grid)

labelGrob <- function(x,y,label, ...){
  t <- textGrob(x,y,label=label)
  w <- convertWidth(1.5*grobWidth(t), "npc", valueOnly = TRUE)
  h <- convertHeight(1.5*grobHeight(t), "npc", valueOnly = TRUE)
  gTree(cl = "label", west = unit(x-0.5*w, "npc"), 
        east = unit(x+0.5*w, "npc"),
        children=gList(t, roundrectGrob(x=x, y=y, gp=gpar(fill=NA),
                                        width=w, height=h)))

}

xDetails.label <- function(x, theta){
  if(theta == 180) return(x$west[1]) else
    if(theta == 0) return(x$east[1]) else
  xDetails(x$children[[1]], theta) 
}

yDetails.label <- function(x, theta){
  if(theta %in% c("west", "east")) return(x$y) else
  yDetails(x$children[[1]], theta) 
}

lab1 <- labelGrob(0.1, 0.5, "start")
lab2 <- labelGrob(0.6, 0.75, "end")
grid.newpage()
grid.draw(lab1)
grid.draw(lab2)
grid.curve(grobX(lab1, "east"), grobY(lab1, "east"),
           grobX(lab2, "west"), grobY(lab2, "west"), 
           inflect = TRUE, curvature=0.1)

在R中用曲线（s-ish曲线）连接两个点

3 个答案: