Skip to content

Commit

Permalink
added edge path bundling to readme
Browse files Browse the repository at this point in the history
  • Loading branch information
@schochastics
schochastics committed Oct 30, 2021
1 parent 77af8bb commit af8a195
Show file tree
Hide file tree
Showing 4 changed files with 247 additions and 158 deletions.
200 changes: 121 additions & 79 deletions README.Rmd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -26,12 +26,11 @@ An R package that implements several edge bundling/flow and metro map algorithms
- Force directed edge bundling ([paper](https://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.212.7989&rep=rep1&type=pdf))
- Stub bundling ([paper](https://www.uni-konstanz.de/mmsp/pubsys/publishedFiles/NoBr13.pdf))
- Hammer bundling ([python code](https://datashader.org/_modules/datashader/bundling.html))
- Edge-path bundling ([paper](https://arxiv.org/abs/2108.05467))
- TNSS flow map ([paper](https://www.tandfonline.com/doi/pdf/10.1080/15230406.2018.1437359?casa_token=1_AncPoEZ8QAAAAA:Qdl39_xDlQVCloneMFhI8rGUGgkzo6mkCMLUJThQfDs6-5J8FcmZXW4oTDqWNKQrbhL3hGEWbTY))
- Multicriteria Metro map layout ([paper](https://ieeexplore.ieee.org/document/5406516))

(*part of this package will eventually migrate to ggraph*)

The API is not very opinionated yet and may change in future releases.
(The API is not very opinionated yet and may change in future releases.)

## Installation

Expand Down Expand Up @@ -83,37 +82,50 @@ The result can be visualized as follows.
```{r plot,message=FALSE,fig.align='center'}
library(ggplot2)
ggplot(fbundle)+
geom_path(aes(x,y,group=group,col=as.factor(group)),size = 2,show.legend = FALSE)+
geom_point(data=as.data.frame(xy),aes(V1,V2),size=5)+
ggplot(fbundle) +
geom_path(aes(x, y, group = group, col = as.factor(group)),
size = 2, show.legend = FALSE) +
geom_point(data = as.data.frame(xy), aes(V1, V2), size = 5) +
theme_void()
# simple edge-path bundling example
g <- graph_from_edgelist(matrix(c(1, 2, 1, 6, 1, 4, 2, 3, 3, 4, 4, 5, 5, 6),
ncol = 2, byrow = TRUE), FALSE)
xy <- cbind(c(0, 10, 25, 40, 50, 50), c(0, 15, 25, 15, 0, -10))
res <- edge_bundle_path(g, xy, max_distortion = 2, weight_fac = 2, segments = 50)
ggplot() +
geom_path(data = res, aes(x, y, group = group, col = as.factor(group)),
size = 2, show.legend = FALSE) +
geom_point(data = as.data.frame(xy), aes(V1, V2), size = 5) +
scale_color_manual(values = c("grey66", "firebrick3", "firebrick3", rep("grey66", 4))) +
theme_void()
```

For `edge_bundle_stub()`, you need `geom_bezier()` from the package {{ggforce}}.

```{r bezier,message=FALSE,fig.align='center'}
library(ggforce)
g <- graph.star(10,"undirected")
g <- graph.star(10, "undirected")
xy <- matrix(c(
0,0,
cos(90*pi/180),sin(90*pi/180),
cos(80*pi/180),sin(80*pi/180),
cos(70*pi/180),sin(70*pi/180),
cos(330*pi/180),sin(330*pi/180),
cos(320*pi/180),sin(320*pi/180),
cos(310*pi/180),sin(310*pi/180),
cos(210*pi/180),sin(210*pi/180),
cos(200*pi/180),sin(200*pi/180),
cos(190*pi/180),sin(190*pi/180)
),ncol=2,byrow=TRUE)
sbundle <- edge_bundle_stub(g,xy,beta = 90)
ggplot(sbundle)+
geom_bezier(aes(x,y,group=group),size=2,col="grey66")+
geom_point(data=as.data.frame(xy),aes(V1,V2),size=5)+
0, 0,
cos(90 * pi / 180), sin(90 * pi / 180),
cos(80 * pi / 180), sin(80 * pi / 180),
cos(70 * pi / 180), sin(70 * pi / 180),
cos(330 * pi / 180), sin(330 * pi / 180),
cos(320 * pi / 180), sin(320 * pi / 180),
cos(310 * pi / 180), sin(310 * pi / 180),
cos(210 * pi / 180), sin(210 * pi / 180),
cos(200 * pi / 180), sin(200 * pi / 180),
cos(190 * pi / 180), sin(190 * pi / 180)
), ncol = 2, byrow = TRUE)
sbundle <- edge_bundle_stub(g, xy, beta = 90)
ggplot(sbundle) +
geom_bezier(aes(x, y, group = group), size = 1.5, col = "grey66") +
geom_point(data = as.data.frame(xy), aes(V1, V2), size = 5) +
theme_void()
```
Expand All @@ -122,68 +134,98 @@ The typical edge bundling benchmark uses a dataset on us flights, which is inclu

```{r example-code,eval = FALSE}
g <- us_flights
xy <- cbind(V(g)$longitude,V(g)$latitude)
verts <- data.frame(x=V(g)$longitude,y=V(g)$latitude)
xy <- cbind(V(g)$longitude, V(g)$latitude)
verts <- data.frame(x = V(g)$longitude, y = V(g)$latitude)
fbundle <- edge_bundle_force(g,xy,compatibility_threshold = 0.6)
sbundle <- edge_bundle_stub(g,xy)
hbundle <- edge_bundle_hammer(g,xy,bw = 0.7,decay = 0.5)
pbundle <- edge_bundle_path(g,xy,max_distortion = 12,weight_fac = 2,segments = 50)
fbundle <- edge_bundle_force(g, xy, compatibility_threshold = 0.6)
sbundle <- edge_bundle_stub(g, xy)
hbundle <- edge_bundle_hammer(g, xy, bw = 0.7, decay = 0.5)
pbundle <- edge_bundle_path(g, xy, max_distortion = 12, weight_fac = 2, segments = 50)
states <- map_data("state")
p1 <- ggplot()+
geom_polygon(data=states,aes(long,lat,group=group),col="white",size=0.1,fill=NA)+
geom_path(data = fbundle,aes(x,y,group=group),col="#9d0191",size=0.05)+
geom_path(data = fbundle,aes(x,y,group=group),col="white",size=0.005)+
geom_point(data = verts,aes(x,y),col="#9d0191",size=0.25)+
geom_point(data = verts,aes(x,y),col="white",size=0.25,alpha=0.5)+
geom_point(data=verts[verts$name!="",],aes(x,y), col="white", size=3,alpha=1)+
labs(title="Force Directed Edge Bundling")+
ggraph::theme_graph(background = "black")+
theme(plot.title = element_text(color="white"))
p2 <- ggplot()+
geom_polygon(data=states,aes(long,lat,group=group),col="white",size=0.1,fill=NA)+
geom_path(data = hbundle,aes(x,y,group=group),col="#9d0191",size=0.05)+
geom_path(data = hbundle,aes(x,y,group=group),col="white",size=0.005)+
geom_point(data = verts,aes(x,y),col="#9d0191",size=0.25)+
geom_point(data = verts,aes(x,y),col="white",size=0.25,alpha=0.5)+
geom_point(data=verts[verts$name!="",],aes(x,y), col="white", size=3,alpha=1)+
labs(title="Hammer Edge Bundling")+
ggraph::theme_graph(background = "black")+
theme(plot.title = element_text(color="white"))
alpha_fct <- function(x,b=0.01,p=5,n=20){
(1-b)*(2/(n-1))^p * abs(x-(n-1)/2)^p+b
p1 <- ggplot() +
geom_polygon(data = states, aes(long, lat, group = group),
col = "white", size = 0.1, fill = NA) +
geom_path(data = fbundle, aes(x, y, group = group),
col = "#9d0191", size = 0.05) +
geom_path(data = fbundle, aes(x, y, group = group),
col = "white", size = 0.005) +
geom_point(data = verts, aes(x, y),
col = "#9d0191", size = 0.25) +
geom_point(data = verts, aes(x, y),
col = "white", size = 0.25, alpha = 0.5) +
geom_point(data = verts[verts$name != "", ],
aes(x, y), col = "white", size = 3, alpha = 1) +
labs(title = "Force Directed Edge Bundling") +
ggraph::theme_graph(background = "black") +
theme(plot.title = element_text(color = "white"))
p2 <- ggplot() +
geom_polygon(data = states, aes(long, lat, group = group),
col = "white", size = 0.1, fill = NA) +
geom_path(data = hbundle, aes(x, y, group = group),
col = "#9d0191", size = 0.05) +
geom_path(data = hbundle, aes(x, y, group = group),
col = "white", size = 0.005) +
geom_point(data = verts, aes(x, y),
col = "#9d0191", size = 0.25) +
geom_point(data = verts, aes(x, y),
col = "white", size = 0.25, alpha = 0.5) +
geom_point(data = verts[verts$name != "", ], aes(x, y),
col = "white", size = 3, alpha = 1) +
labs(title = "Hammer Edge Bundling") +
ggraph::theme_graph(background = "black") +
theme(plot.title = element_text(color = "white"))
alpha_fct <- function(x, b = 0.01, p = 5, n = 20) {
(1 - b) * (2 / (n - 1))^p * abs(x - (n - 1) / 2)^p + b
}
p3 <- ggplot()+
geom_polygon(data=states,aes(long,lat,group=group),col="white",size=0.1,fill=NA)+
ggforce::geom_bezier(data = sbundle,aes(x,y,group=group,
alpha=alpha_fct(..index..*20)),n=20,
col="#9d0191",size=0.1,show.legend = FALSE)+
ggforce::geom_bezier(data = sbundle,aes(x,y,group=group,
alpha=alpha_fct(..index..*20)),n=20,
col="white",size=0.01,show.legend = FALSE)+
geom_point(data = verts,aes(x,y),col="#9d0191",size=0.25)+
geom_point(data = verts,aes(x,y),col="white",size=0.25,alpha=0.5)+
geom_point(data=verts[verts$name!="",],aes(x,y), col="white", size=3,alpha=1)+
labs(title="Stub Edge Bundling")+
ggraph::theme_graph(background = "black")+
theme(plot.title = element_text(color="white"))
p4 <- ggplot()+
geom_polygon(data=states,aes(long,lat,group=group),col="white",size=0.1,fill=NA)+
geom_path(data = pbundle,aes(x,y,group=group),col="#9d0191",size=0.05)+
geom_path(data = pbundle,aes(x,y,group=group),col="white",size=0.005)+
geom_point(data = verts,aes(x,y),col="#9d0191",size=0.25)+
geom_point(data = verts,aes(x,y),col="white",size=0.25,alpha=0.5)+
geom_point(data=verts[verts$name!="",],aes(x,y), col="white", size=3,alpha=1)+
labs(title="Edge-Path Bundling")+
ggraph::theme_graph(background = "black")+
theme(plot.title = element_text(color="white"))
p3 <- ggplot() +
geom_polygon(data = states, aes(long, lat, group = group),
col = "white", size = 0.1, fill = NA) +
ggforce::geom_bezier(
data = sbundle, aes(x, y,
group = group,
alpha = alpha_fct(..index.. * 20)
), n = 20,
col = "#9d0191", size = 0.1, show.legend = FALSE
) +
ggforce::geom_bezier(
data = sbundle, aes(x, y,
group = group,
alpha = alpha_fct(..index.. * 20)
), n = 20,
col = "white", size = 0.01, show.legend = FALSE
) +
geom_point(data = verts, aes(x, y),
col = "#9d0191", size = 0.25) +
geom_point(data = verts, aes(x, y),
col = "white", size = 0.25, alpha = 0.5) +
geom_point(data = verts[verts$name != "", ], aes(x, y),
col = "white", size = 3, alpha = 1) +
labs(title = "Stub Edge Bundling") +
ggraph::theme_graph(background = "black") +
theme(plot.title = element_text(color = "white"))
p4 <- ggplot() +
geom_polygon(data = states, aes(long, lat, group = group),
col = "white", size = 0.1, fill = NA) +
geom_path(data = pbundle, aes(x, y, group = group),
col = "#9d0191", size = 0.05) +
geom_path(data = pbundle, aes(x, y, group = group),
col = "white", size = 0.005) +
geom_point(data = verts, aes(x, y),
col = "#9d0191", size = 0.25) +
geom_point(data = verts, aes(x, y),
col = "white", size = 0.25, alpha = 0.5) +
geom_point(data = verts[verts$name != "", ], aes(x, y),
col = "white", size = 3, alpha = 1) +
labs(title = "Edge-Path Bundling") +
ggraph::theme_graph(background = "black") +
theme(plot.title = element_text(color = "white"))
p1
p2
Expand Down
Loading

0 comments on commit af8a195

Please sign in to comment.