连接两个点中的R曲线（S-ISH曲线）

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 - >2 children - >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

我认为保罗马雷尔有说明网格类似于图文档。这里有一个简单的例子，

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)