r - 向三角形中心弯曲线（ggplot2）

Question

我有 3 个顶点表示为与三个边相连的图中的点。我想将边缘向三角形（c(.5, .35)）的中心弯曲。如何在 ggplot2 中将图 1 转换为图 2（我假设这个答案也可以推广到基础？尽管顶点保持稳定，但弯曲边缘有一些理想的抖动。我假设这意味着某种线性变换有某种稍微随机的常数。

图 1

图 2（仅用于突出显示所需输出的颜色）

library(ggplot2); library(scales)

## The vertices/points data
  point    x    y
1     A 0.25 0.45
2     B 0.50 0.25
3     C 0.75 0.45

## The edges data
  out.x out.y receiver.x receiver.y
1  0.25  0.45       0.50       0.25
2  0.50  0.25       0.75       0.45
3  0.75  0.45       0.25       0.45
4  0.25  0.45       0.50       0.25
5  0.50  0.25       0.75       0.45
6  0.75  0.45       0.25       0.45

## Edges and vertices/points data in dput form for ease
so <- structure(list(out.x = c(0.25, 0.5, 0.75, 0.25, 0.5, 0.75), out.y = c(0.45, 
    0.25, 0.45, 0.45, 0.25, 0.45), receiver.x = c(0.5, 0.75, 0.25, 
    0.5, 0.75, 0.25), receiver.y = c(0.25, 0.45, 0.45, 0.25, 0.45, 
    0.45)), .Names = c("out.x", "out.y", "receiver.x", "receiver.y"
    ), row.names = c(NA, -6L), class = "data.frame")


the_points <- data.frame(point=factor(LETTERS[1:3]), 
    x = c(.25, .5, .75), 
    y = c(.45, .25, .45)
)

## Plot the base graph minus the edges
root <- ggplot() + 
    geom_point(data=the_points, aes(x=x, y=y), size=12, inherit.aes = FALSE) +
    geom_text(data=the_points, aes(x=x, y=y, label=as.character(point)), 
        inherit.aes = FALSE, color="white") +
    ylim(c(.20, .75)) + xlim(c(.25, .75)) +
    ylab("") + xlab("") 

## Add the edges
root + geom_segment(aes(x= out.x, y= out.y, xend = receiver.x, 
        yend = receiver.y), alpha = .7, size = 3, data = so) 

Answer 1

这是一种处理bezierHmisc 曲线的方法（受http://is-r.tumblr.com/post/38459242505/beautiful-network-diagrams-with-ggplot2 启发）

library(Hmisc)
library(plyr)
# a function to sample a point within a triangle
rtriang <- function(A ,B,C){
  r <- runif(2)
  sqr1 <- sqrt(r[1])
  (1- sqr1)*A +  (1-r[2])*sqr1*B + r[2]*sqr1*C

}


# a function to make a curve between two points (as set up in the example)
make.curve <- function(coords,n=101,A ,B ,C){
  rt  <- rtriang(A,B,C)
  xxs <- unlist(coords[,c(1,3)])
  yys <-unlist(coords[,c(2,4)])
  xx <- append(xxs, rt[1],1)
  yy <- append(yys, rt[2] ,1)
  as.data.frame(bezier(xx,yy, evaluation=n))
}

# A triangle 1 /3 rd size with same centre point
mid <- matrix(colMeans(the_points[,2:3]), ncol=2,nrow=3,byrow=TRUE)
tri <- as.matrix(the_points[,2:3])
rownames(tri) <- rownames(mid) <- LETTERS[1:3]
newT <- mid + (tri-mid)/3

# create a new data set with bezier curves with a midpoint
# somewhere within a triangle 1/3 the size of the original 
newd <- adply(so, 1, make.curve, A = newT['A',],B = newT['B',], C = newT['C',])
newd$id <- rep(seq_len(nrow(so)), each = 101)
# and the plot
root + geom_path(data = newd, aes(colour = factor(id), x=x,y=y))

Answer 2

我认为在igraph这里使用该库可能真的很有帮助，例如：

library(igraph)
# make a data frame for the relationships between
# each of the points, replacing your 'edges' data
pts <- data.frame(a=rep(1:3,2),b=rep(c(2,3,1),2))
# plot using igraph
plot(
  graph.data.frame(pts),
  layout=as.matrix(the_points[c("x","y")]),
  margin=c(-0.3),
  vertex.label=c("A","B","C"),
  vertex.label.color="white",
  vertex.label.family="sans",
  vertex.label.font=2,
  vertex.size=35,
  vertex.color="black",
  edge.arrow.mode="-",
  edge.curved=rep(c(0.5,0.2),3),
  edge.width=5,
  edge.color=1:6
)

导致：