I have 3 vertices represented as points in a plot connected with three edges. I'd like to bend the the edges towards the center of the triangle (c(.5, .35)
). How can I turn graph 1 into graph 2 in ggplot2 (I assume this answer would be generalizable to base as well? There is some desirable jitter in the curved edges though the vertices remain stable. I assume this would mean some sort of linear transformation that has some sort of slightly randomized constant.
Graph 1
Graph 2 (color only used to highlight desired output)
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)
Here is an approach working on bezier
curves from Hmisc (motivated by 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))
I think using the igraph
library could be really helpful here, e.g:
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
)
Resulting in:
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With