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

这是一种适用于 bezier 的方法来自 Hmisc 的曲线(由 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))