在 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)
假设我想生成一种如下所示的树结构:
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)