連接兩個點中的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)