在 R 中用曲线(s-ish 曲线)连接两点

Connecting two points with curved lines (s-ish curve) in R

假设我想生成一种如下所示的树结构:

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.

的情况下创建这样的行,那就太好了

编辑已删除并成为答案

听起来像 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)
)

结果:

我认为 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)

根据@thelatemail 的建议,我决定将我的编辑变成一个答案。我的解决方案基于@thelatemail 的回答。

我写了一个画曲线的小函数,它利用了logistic函数:

#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 --> 2 children -- > 20 grandchildren。一个child有12个大children,另一个child有8个children.

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