Skip to content

Instantly share code, notes, and snippets.

@guyabel
Last active May 1, 2018 18:46
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save guyabel/ea5f26b1bb074664ac11e5a1d413d895 to your computer and use it in GitHub Desktop.
Save guyabel/ea5f26b1bb074664ac11e5a1d413d895 to your computer and use it in GitHub Desktop.
GuyAbelUW
## ----setup, include=FALSE------------------------------------------------
library(knitr)
knitr::opts_chunk$set(prompt= TRUE, collapse = TRUE, comment = NA)
knitr::opts_chunk$set(fig.width = 5, fig.height = 5)
knitr::knit_hooks$set(purl = hook_purl)
## ---- message=FALSE------------------------------------------------------
# install.packages("migest")
library(tidyverse)
d0 <- read_csv(system.file("imr", "reg_flow.csv", package = "migest"))
d0
## ------------------------------------------------------------------------
d2010 <- d0 %>%
filter(year0 == 2010) %>%
select(-year0)
d2010
## ------------------------------------------------------------------------
library(circlize)
chordDiagram(x = d2010)
## ------------------------------------------------------------------------
d2010 <- mutate(d2010, flow = flow/1e06)
d2010
## ------------------------------------------------------------------------
chordDiagram(x = d2010, directional = 1)
## ------------------------------------------------------------------------
chordDiagram(x = d2010, directional = 1, direction.type = c("diffHeight", "arrows"))
## ------------------------------------------------------------------------
chordDiagram(x = d2010, directional = 1, direction.type = c("diffHeight", "arrows"),
link.arr.type = "big.arrow")
## ------------------------------------------------------------------------
chordDiagram(x = d2010, directional = 1, direction.type = c("diffHeight", "arrows"),
link.arr.type = "big.arrow", diffHeight = -0.04)
## ------------------------------------------------------------------------
circos.par(track.margin = c(-0.08, 0.08))
chordDiagram(x = d2010, directional = 1, direction.type = c("diffHeight", "arrows"),
link.arr.type = "big.arrow", diffHeight = -0.04)
## ------------------------------------------------------------------------
circos.clear()
circos.par(track.margin = c(-0.08, 0.08), gap.degree = 4)
chordDiagram(x = d2010, directional = 1, direction.type = c("diffHeight", "arrows"),
link.arr.type = "big.arrow", diffHeight = -0.04)
## ------------------------------------------------------------------------
circos.clear()
circos.par(track.margin = c(-0.08, 0.08), gap.degree = 4)
chordDiagram(x = d2010, directional = 1, direction.type = c("diffHeight", "arrows"),
link.arr.type = "big.arrow", diffHeight = -0.04, link.sort = TRUE)
## ------------------------------------------------------------------------
circos.clear()
circos.par(track.margin = c(-0.08, 0.08), gap.degree = 4)
chordDiagram(x = d2010, directional = 1, direction.type = c("diffHeight", "arrows"),
link.arr.type = "big.arrow", diffHeight = -0.04, link.sort = TRUE,
link.largest.ontop = TRUE)
## ------------------------------------------------------------------------
circos.clear()
circos.par(track.margin = c(-0.08, 0.08), gap.degree = 4)
chordDiagram(x = d2010, directional = 1, direction.type = c("diffHeight", "arrows"),
link.arr.type = "big.arrow", diffHeight = -0.04, link.sort = TRUE,
link.largest.ontop = TRUE, transparency = 0.25)
## ------------------------------------------------------------------------
d1 <- read_csv(system.file("vidwp", "reg_plot.csv", package = "migest"))
d1
## ------------------------------------------------------------------------
circos.clear()
circos.par(track.margin = c(-0.08, 0.08), gap.degree = 4)
chordDiagram(x = d2010, directional = 1, direction.type = c("diffHeight", "arrows"),
link.arr.type = "big.arrow", diffHeight = -0.04, link.sort = TRUE,
link.largest.ontop = TRUE, transparency = 0.25,
order = d1$region)
## ------------------------------------------------------------------------
circos.clear()
circos.par(track.margin = c(-0.08, 0.08), gap.degree = 4, start.degree = 90)
chordDiagram(x = d2010, directional = 1, direction.type = c("diffHeight", "arrows"),
link.arr.type = "big.arrow", diffHeight = -0.04, link.sort = TRUE,
link.largest.ontop = TRUE, transparency = 0.25,
order = d1$region)
## ------------------------------------------------------------------------
library(RColorBrewer)
pal0 <- brewer.pal(n = 9, name = "Set1")
pie(x = rep(x = 1, times = 9),
col= pal0,
labels = d1$region)
## ---- fig.width = 7, fig.height = 7--------------------------------------
display.brewer.all()
## ------------------------------------------------------------------------
pie(x = rep(x = 1, times = 9),
col= d1$col1,
labels = d1$region)
## ------------------------------------------------------------------------
circos.clear()
circos.par(track.margin = c(-0.08, 0.08), gap.degree = 4, start.degree = 90)
chordDiagram(x = d2010, directional = 1, direction.type = c("diffHeight", "arrows"),
link.arr.type = "big.arrow", diffHeight = -0.04, link.sort = TRUE,
link.largest.ontop = TRUE, transparency = 0.25,
order = d1$region, grid.col = d1$col1)
## ------------------------------------------------------------------------
circos.clear()
circos.par(track.margin = c(-0.08, 0.08), gap.degree = 4, start.degree = 90)
chordDiagram(x = d2010, directional = 1, direction.type = c("diffHeight", "arrows"),
link.arr.type = "big.arrow", diffHeight = -0.04, link.sort = TRUE,
link.largest.ontop = TRUE, transparency = 0.25,
order = d1$region, grid.col = d1$col1,
annotationTrack = "grid")
## ------------------------------------------------------------------------
circos.clear()
circos.par(track.margin = c(-0.08, 0.08), gap.degree = 4, start.degree = 90)
chordDiagram(x = d2010, directional = 1, direction.type = c("diffHeight", "arrows"),
link.arr.type = "big.arrow", diffHeight = -0.04, link.sort = TRUE,
link.largest.ontop = TRUE, transparency = 0.25,
order = d1$region, grid.col = d1$col1,
annotationTrack = "grid")
circos.track(track.index = 1, panel.fun = function(x, y) {
circos.axis(h = "top", labels.cex = 0.8, labels.niceFacing = FALSE)
})
## ------------------------------------------------------------------------
circos.clear()
circos.par(track.margin = c(-0.08, 0.08), gap.degree = 4, start.degree = 90)
chordDiagram(x = d2010, directional = 1, direction.type = c("diffHeight", "arrows"),
link.arr.type = "big.arrow", diffHeight = -0.04, link.sort = TRUE,
link.largest.ontop = TRUE, transparency = 0.25,
order = d1$region, grid.col = d1$col1,
annotationTrack = "grid")
circos.track(track.index = 1, bg.border = NA, panel.fun = function(x, y) {
circos.axis(h = "top", labels.cex = 0.8, labels.niceFacing = FALSE, labels.pos.adjust = FALSE)
})
## ------------------------------------------------------------------------
circos.clear()
circos.par(track.margin = c(-0.08, 0.08), gap.degree = 4, start.degree = 90)
chordDiagram(x = d2010, directional = 1, direction.type = c("diffHeight", "arrows"),
link.arr.type = "big.arrow", diffHeight = -0.04, link.sort = TRUE,
link.largest.ontop = TRUE, transparency = 0.25,
order = d1$region, grid.col = d1$col1,
annotationTrack = "grid")
circos.track(track.index = 1, bg.border = NA, panel.fun = function(x, y) {
xx = get.cell.meta.data("xlim")
reg_lab = get.cell.meta.data("sector.index")
circos.text(x = mean(xx), y = 3, labels = reg_lab)
circos.axis(h = "top", labels.cex = 0.8, labels.niceFacing = FALSE, labels.pos.adjust = FALSE)
})
## ------------------------------------------------------------------------
circos.clear()
circos.par(track.margin = c(-0.08, 0.08), gap.degree = 4, start.degree = 90, points.overflow.warning = FALSE)
chordDiagram(x = d2010, directional = 1, direction.type = c("diffHeight", "arrows"),
link.arr.type = "big.arrow", diffHeight = -0.04, link.sort = TRUE,
link.largest.ontop = TRUE, transparency = 0.25,
order = d1$region, grid.col = d1$col1,
annotationTrack = "grid")
circos.track(track.index = 1, bg.border = NA, panel.fun = function(x, y) {
xx = get.cell.meta.data("xlim")
reg_lab = get.cell.meta.data("sector.index")
circos.text(x = mean(xx), y = 3, labels = reg_lab, facing = "bending")
circos.axis(h = "top", labels.cex = 0.8, labels.niceFacing = FALSE, labels.pos.adjust = FALSE)
})
## ------------------------------------------------------------------------
d1
circos.clear()
circos.par(track.margin = c(-0.08, 0.08), gap.degree = 4, start.degree = 90, points.overflow.warning = FALSE)
chordDiagram(x = d2010, directional = 1, direction.type = c("diffHeight", "arrows"),
link.arr.type = "big.arrow", diffHeight = -0.04, link.sort = TRUE,
link.largest.ontop = TRUE, transparency = 0.25,
order = d1$region, grid.col = d1$col1,
annotationTrack = "grid")
circos.track(track.index = 1, bg.border = NA, panel.fun = function(x, y) {
xx = get.cell.meta.data("xlim")
reg = get.cell.meta.data("sector.index")
reg_lab1 = d1 %>% filter(region == reg) %>% pull(reg1)
reg_lab2 = d1 %>% filter(region == reg) %>% pull(reg2)
circos.text(x = mean(xx), y = 4, labels = reg_lab1, facing = "bending")
circos.text(x = mean(xx), y = 3, labels = reg_lab2, facing = "bending")
circos.axis(h = "top", labels.niceFacing = FALSE, labels.cex = 0.8)
})
## ------------------------------------------------------------------------
par(mar = rep(0, 4))
circos.clear()
circos.par(track.margin = c(-0.08, 0.08), gap.degree = 4, start.degree = 90, points.overflow.warning = FALSE)
chordDiagram(x = d2010, directional = 1, direction.type = c("diffHeight", "arrows"),
link.arr.type = "big.arrow", diffHeight = -0.04, link.sort = TRUE,
link.largest.ontop = TRUE, transparency = 0.25,
order = d1$region, grid.col = d1$col1,
annotationTrack = "grid")
circos.track(track.index = 1, bg.border = NA, panel.fun = function(x, y) {
xx = get.cell.meta.data("xlim")
reg = get.cell.meta.data("sector.index")
reg_lab1 = d1 %>% filter(region == reg) %>% pull(reg1)
reg_lab2 = d1 %>% filter(region == reg) %>% pull(reg2)
circos.text(x = mean(xx), y = 4, labels = reg_lab1, facing = "bending")
circos.text(x = mean(xx), y = 3, labels = reg_lab2, facing = "bending")
circos.axis(h = "top", labels.cex = 0.8, labels.niceFacing = FALSE, labels.pos.adjust = FALSE)
})
# dev.print(png, file = "cd2010.png", height = 7, width = 7, units = "in", res = 500)
# file.show("cd2010.png")
## ---- eval=FALSE---------------------------------------------------------
# dev.print(png, file = "cd2010.png", height = 6, width = 6, units = "in", res = 500)
# file.show("cd2010.png")
## ------------------------------------------------------------------------
par(mar = rep(0, 4))
circos.clear()
circos.par(track.margin = c(-0.1, 0.1), gap.degree = 6, start.degree = 90, points.overflow.warning = FALSE)
chordDiagram(x = d2010, directional = 1, direction.type = c("diffHeight", "arrows"),
link.arr.type = "big.arrow", diffHeight = -0.04, link.sort = TRUE,
link.largest.ontop = TRUE, transparency = 0.25,
order = d1$region, grid.col = d1$col1,
annotationTrack = "grid")
circos.track(track.index = 1, bg.border = NA, panel.fun = function(x, y) {
xx = get.cell.meta.data("xlim")
reg = get.cell.meta.data("sector.index")
reg_lab1 = d1 %>% filter(region == reg) %>% pull(reg1)
reg_lab2 = d1 %>% filter(region == reg) %>% pull(reg2)
circos.text(x = mean(xx),
y = ifelse(test = is.na(reg_lab2), yes = 3.5, no = 4),
labels = reg_lab1, facing = "bending")
circos.text(x = mean(xx), y = 3, labels = reg_lab2, facing = "bending")
circos.axis(h = "top", labels.cex = 0.8, labels.niceFacing = FALSE, labels.pos.adjust = FALSE)
})
# dev.print(png, file = "cd2010.png", height = 6, width = 6, units = "in", res = 500)3
# file.show("cd2010.png")
## ---- message=FALSE------------------------------------------------------
library(tweenr)
d2 <- d0 %>%
mutate(corridor = paste(orig_reg, dest_reg, sep = " -> ")) %>%
select(corridor, year0, flow) %>%
mutate(ease = "linear") %>%
tween_elements(time = "year0", group = "corridor", ease = "ease", nframes = 100) %>%
tbl_df()
d2
## ---- message=FALSE------------------------------------------------------
d2 <- d2 %>%
separate(col = .group, into = c("orig_reg", "dest_reg"), sep = " -> ") %>%
select(orig_reg, dest_reg, flow, everything()) %>%
mutate(flow = flow/1e06)
d2
## ---- message=FALSE, eval=FALSE------------------------------------------
# # create a directory to store the individual plots
# dir.create("./plot-gif/")
#
# library(circlize)
# for(f in unique(d2$.frame)){
# # open a PNG plotting device
# png(file = paste0("./plot-gif/cd", f, ".png"), height = 6, width = 6,
# units = "in", res = 500)
#
# par(mar = rep(0, 4))
# circos.clear()
# circos.par(track.margin = c(-0.08, 0.08), gap.degree = 6, start.degree = 90, points.overflow.warning = FALSE)
#
# chordDiagram(x = filter(d2, .frame == f),
# directional = 1, direction.type = c("diffHeight", "arrows"),
# link.arr.type = "big.arrow", diffHeight = -0.04, link.sort = TRUE,
# link.largest.ontop = TRUE, transparency = 0.25,
# order = d1$region, grid.col = d1$col1,
# annotationTrack = "grid")
#
# circos.track(track.index = 1, bg.border = NA, panel.fun = function(x, y) {
# xx = get.cell.meta.data("xlim")
# reg = get.cell.meta.data("sector.index")
# reg_lab1 = d1 %>% filter(region == reg) %>% pull(reg1)
# reg_lab2 = d1 %>% filter(region == reg) %>% pull(reg2)
#
# circos.text(x = mean(xx),
# y = ifelse(test = is.na(reg_lab2), yes = 3.5, no = 4),
# labels = reg_lab1, facing = "bending")
# circos.text(x = mean(xx), y = 3, labels = reg_lab2, facing = "bending")
# circos.axis(h = "top", labels.cex = 0.8, labels.niceFacing = FALSE, labels.pos.adjust = FALSE)
# })
#
# # close plotting device
# dev.off()
# }
## ---- message=FALSE, eval=FALSE------------------------------------------
# library(magick)
#
# img <- image_read(path = "./plot-gif/cd0.png")
# for(f in unique(d2$.frame)[-1]){
# img0 <- image_read(path = paste0("./plot-gif/cd",f,".png"))
# img <- c(img, img0)
# message(f)
# }
#
# img1 <- image_scale(image = img, geometry = "720x720")
#
# ani0 <- image_animate(image = img1, fps = 10)
# image_write(image = ani0, path = "./plot-gif/cd.gif")
## ------------------------------------------------------------------------
scale_gap <- function(flow_m, flow_max, gap_at_max = 1, gaps = NULL) {
p <- flow_m / flow_max
if(length(gap_at_max) == 1 & !is.null(gaps)) {
gap_at_max <- rep(gap_at_max, gaps)
}
gap_degree <- (360 - sum(gap_at_max)) * (1 - p)
gap_m <- (gap_degree + sum(gap_at_max))/gaps
return(gap_m)
}
## ------------------------------------------------------------------------
d3 <- d2 %>%
group_by(.frame) %>%
summarise(flow = sum(flow)) %>%
mutate(gaps = scale_gap(flow_m = flow, flow_max = max(.$flow),
gap_at_max = 4, gaps = 9))
d3
## ---- message=FALSE, eval=FALSE------------------------------------------
# circos.par(track.margin = c(-0.08, 0.08), start.degree = 90,
# points.overflow.warning = FALSE, gap.degree = filter(d3, .frame == f)$gaps)
## ---- message=FALSE------------------------------------------------------
library(magrittr)
reg_max <- d0 %>%
group_by(year0, orig_reg) %>%
mutate(tot_out = sum(flow)) %>%
group_by(year0, dest_reg) %>%
mutate(tot_in = sum(flow)) %>%
filter(orig_reg == dest_reg) %>%
mutate(tot = tot_in + tot_out) %>%
mutate(reg = orig_reg) %>%
group_by(reg) %>%
summarise(tot_max = max(tot)/1e06) %$%
'names<-'(tot_max, reg)
reg_max
## ---- message=FALSE, eval=FALSE------------------------------------------
# chordDiagram(x = filter(d2, .frame == f),
# directional = 1, direction.type = c("diffHeight", "arrows"),
# link.arr.type = "big.arrow", diffHeight = -0.04, link.sort = TRUE,
# link.largest.ontop = TRUE, transparency = 0.25,
# order = d1$region, grid.col = d1$col1,
# annotationTrack = "grid",
# xmax = reg_max)
#
---
title: "Chord Diagrams for Bilateral Migration in R"
output:
html_document
---
```{r setup, include=FALSE}
library(knitr)
knitr::opts_chunk$set(prompt= TRUE, collapse = TRUE, comment = NA)
knitr::opts_chunk$set(fig.width = 5, fig.height = 5)
knitr::knit_hooks$set(purl = hook_purl)
```
## Intro
This is a brief guide on my preferences for plotting migration data using the `chordDiagram()`
There is extensive documentation of the `chordDiagram()` function in [Chapters 13-15](https://jokergoo.github.io/circlize_book/book/the-chorddiagram-function.html) of Zuguang Gu's circlize.
The `chordDiagram()` function can take either a `matrix` of `data.frame` object. I prefer the latter as they are much easier to within R.
## Data Prep
Read the data into R. These are region to region flow estimates over time, that are in my `migest` package
```{r, message=FALSE}
# install.packages("migest")
library(tidyverse)
d0 <- read_csv(system.file("imr", "reg_flow.csv", package = "migest"))
d0
```
When using a `chordDiagram` with a `data.frame`, the first three columns should correspond to the origin, destination and flow size. They can take any name, but must be in that order.
```{r}
d2010 <- d0 %>%
filter(year0 == 2010) %>%
select(-year0)
d2010
```
We can plot a single time period using the defaults in `chordDiagram()`
```{r}
library(circlize)
chordDiagram(x = d2010)
```
This is not great. The colours are generated randomly, the labels are awkward, the axes are unreadable, etc, etc...
## Adding Direction
Modify the data so that we are plotting flows in millions
```{r}
d2010 <- mutate(d2010, flow = flow/1e06)
d2010
```
We can add direction to the chords by setting `directional = 1`
```{r}
chordDiagram(x = d2010, directional = 1)
```
We can further enhance the direction by setting `direction.type = c("diffHeight", "arrows")` to give different length chords (shorter at the destination) and using arrows to show the direction
```{r}
chordDiagram(x = d2010, directional = 1, direction.type = c("diffHeight", "arrows"))
```
This is a bit of mess, as the default arrow type is an overlay. We can Use big arrow heads instead by setting `link.arr.type = "big.arrow"`
```{r}
chordDiagram(x = d2010, directional = 1, direction.type = c("diffHeight", "arrows"),
link.arr.type = "big.arrow")
```
I like to further accentuate the arrows by moving the origin chord bases closer to their outer sectors using `diffHeight = -0.04`. The height difference is negative to make the chord shorter at the end (with the arrow head). The `-0.04` value was found by trial and error.
```{r}
chordDiagram(x = d2010, directional = 1, direction.type = c("diffHeight", "arrows"),
link.arr.type = "big.arrow", diffHeight = -0.04)
```
## Spacing
We can make the plot smaller or larger by setting the track margins in `circos.par()` before calling `chordDiagram()` (default is `0.01 0.01`)
```{r}
circos.par(track.margin = c(-0.08, 0.08))
chordDiagram(x = d2010, directional = 1, direction.type = c("diffHeight", "arrows"),
link.arr.type = "big.arrow", diffHeight = -0.04)
```
We can increase the spaces between the sectors using `gap.degree` in `circos.par()`. This can give a bit more space for the sector labels and text (that we will modify later on).
As we are modifying `circos.par()` we need to clear the plotting parameters before we run a new plot using `circos.clear()`
```{r}
circos.clear()
circos.par(track.margin = c(-0.08, 0.08), gap.degree = 4)
chordDiagram(x = d2010, directional = 1, direction.type = c("diffHeight", "arrows"),
link.arr.type = "big.arrow", diffHeight = -0.04)
```
## Arrangment of Chords
We can sort the chords going in and out of each sector by size using `link.sort = TRUE`. This cleans up the plot a little further and allows the reader to detect the largest/smallest flows in or out of a region.
```{r}
circos.clear()
circos.par(track.margin = c(-0.08, 0.08), gap.degree = 4)
chordDiagram(x = d2010, directional = 1, direction.type = c("diffHeight", "arrows"),
link.arr.type = "big.arrow", diffHeight = -0.04, link.sort = TRUE)
```
We can sort the overall order of the chords by size using `link.largest.ontop = TRUE`. By plotting the largest flows last the smaller flows are pushed to the back. Previous plots had dropped the smaller flows by setting an arbitrary cut-off. I did not like this ad-hoc approach. It means the total flows information that can be gathered from the sector axis (once we have tidied them up) are no longer valid and they the give a simpler (less realistic) view of a migration system.
```{r}
circos.clear()
circos.par(track.margin = c(-0.08, 0.08), gap.degree = 4)
chordDiagram(x = d2010, directional = 1, direction.type = c("diffHeight", "arrows"),
link.arr.type = "big.arrow", diffHeight = -0.04, link.sort = TRUE,
link.largest.ontop = TRUE)
```
We can reduce the transparency of the chords to further promote visual impression of the larger flows (default is `transparency = 0.5`)
```{r}
circos.clear()
circos.par(track.margin = c(-0.08, 0.08), gap.degree = 4)
chordDiagram(x = d2010, directional = 1, direction.type = c("diffHeight", "arrows"),
link.arr.type = "big.arrow", diffHeight = -0.04, link.sort = TRUE,
link.largest.ontop = TRUE, transparency = 0.25)
```
In order to modify the order of the regions (sectors) and set the chord colours (later) we can use a second (meta) data frame containing this information.
```{r}
d1 <- read_csv(system.file("vidwp", "reg_plot.csv", package = "migest"))
d1
```
Setting the order can be tricky. I tend to have neighbouring regions next to each other, so that only the longest distant flows are heading through the centre of the plot. There is a never a perfectly satisfactory layout.
We can pass the order of the regions to `chordDiagram()` via the `order` argument, which needs to contain the unique names as in first two columns of the data passed to the `x` argument (`d2010`). The order of the names in the vector dictates the order of the regions in the plot.
```{r}
circos.clear()
circos.par(track.margin = c(-0.08, 0.08), gap.degree = 4)
chordDiagram(x = d2010, directional = 1, direction.type = c("diffHeight", "arrows"),
link.arr.type = "big.arrow", diffHeight = -0.04, link.sort = TRUE,
link.largest.ontop = TRUE, transparency = 0.25,
order = d1$region)
```
We can put the first region (in `d1`) at the top of the plot by setting the `start.degree = 90` in `circos.par()`. I try and put the northern most regions at the top.
```{r}
circos.clear()
circos.par(track.margin = c(-0.08, 0.08), gap.degree = 4, start.degree = 90)
chordDiagram(x = d2010, directional = 1, direction.type = c("diffHeight", "arrows"),
link.arr.type = "big.arrow", diffHeight = -0.04, link.sort = TRUE,
link.largest.ontop = TRUE, transparency = 0.25,
order = d1$region)
```
## Colours
Choosing colours is also difficult. I either use something the RColorBrewer, such as
```{r}
library(RColorBrewer)
pal0 <- brewer.pal(n = 9, name = "Set1")
pie(x = rep(x = 1, times = 9),
col= pal0,
labels = d1$region)
```
where `Set1` is taken from
```{r, fig.width = 7, fig.height = 7}
display.brewer.all()
```
Or hunt around the internet when there are more than five or six regions
```{r}
pie(x = rep(x = 1, times = 9),
col= d1$col1,
labels = d1$region)
```
We can apply the colour scheme to the chord diagram via the `grid.col` argument. This needs to be a vector of colours the same length as the number of sectors (regions). The first colour will be set for the first sector (from the `order` argument) or alphabetically when `order` is not set.
```{r}
circos.clear()
circos.par(track.margin = c(-0.08, 0.08), gap.degree = 4, start.degree = 90)
chordDiagram(x = d2010, directional = 1, direction.type = c("diffHeight", "arrows"),
link.arr.type = "big.arrow", diffHeight = -0.04, link.sort = TRUE,
link.largest.ontop = TRUE, transparency = 0.25,
order = d1$region, grid.col = d1$col1)
```
## Axis
We can subdue the labels and axis (which we will further modify) by telling the `chordDiagram()` to produce only the `"grid"` (the plot), excluding the `"axis"` and `"name"` parts
```{r}
circos.clear()
circos.par(track.margin = c(-0.08, 0.08), gap.degree = 4, start.degree = 90)
chordDiagram(x = d2010, directional = 1, direction.type = c("diffHeight", "arrows"),
link.arr.type = "big.arrow", diffHeight = -0.04, link.sort = TRUE,
link.largest.ontop = TRUE, transparency = 0.25,
order = d1$region, grid.col = d1$col1,
annotationTrack = "grid")
```
We can then add back the axis without the rotating labels (`labels.niceFacing = FALSE` below) and a smaller font size (`labels.cex = 0.8` below) using the `circos.track()` function. The `circos.track()` function requires you say which track you want to modify (`1` is the outermost). It relies on the `panel.fun` argument that acts like a `for` loop, running through each sector and modifying according to the contents within the curly brackets of `function(x, y) {}`. In our case we are first adding our customized axis to the plots, via `circos.axis()`.
```{r}
circos.clear()
circos.par(track.margin = c(-0.08, 0.08), gap.degree = 4, start.degree = 90)
chordDiagram(x = d2010, directional = 1, direction.type = c("diffHeight", "arrows"),
link.arr.type = "big.arrow", diffHeight = -0.04, link.sort = TRUE,
link.largest.ontop = TRUE, transparency = 0.25,
order = d1$region, grid.col = d1$col1,
annotationTrack = "grid")
circos.track(track.index = 1, panel.fun = function(x, y) {
circos.axis(h = "top", labels.cex = 0.8, labels.niceFacing = FALSE)
})
```
More details of `circos.axis()` options in [Section 3.6](https://jokergoo.github.io/circlize_book/book/graphics.html#axes) of Zuguang Gu's circlize
We can lose the default borders on the track by setting `bg.border = NA` and get zero axis labels to appear at zero using `labels.pos.adjust = FALSE`
```{r}
circos.clear()
circos.par(track.margin = c(-0.08, 0.08), gap.degree = 4, start.degree = 90)
chordDiagram(x = d2010, directional = 1, direction.type = c("diffHeight", "arrows"),
link.arr.type = "big.arrow", diffHeight = -0.04, link.sort = TRUE,
link.largest.ontop = TRUE, transparency = 0.25,
order = d1$region, grid.col = d1$col1,
annotationTrack = "grid")
circos.track(track.index = 1, bg.border = NA, panel.fun = function(x, y) {
circos.axis(h = "top", labels.cex = 0.8, labels.niceFacing = FALSE, labels.pos.adjust = FALSE)
})
```
## Labels
We can add in labels using the `circos.text`. This requires a x-y location, where x-axis corresponds to the position along the sector and y-axis corresponds to the distance from the inner most part of the sector (where `y = 0`).
As the text is centred on the mid-point we can give the x location as the midpoint of each sector. This is found by taking the mean of the x limits (0 and however big the sector size is).
We can obtain the range of x using the `get.cell.meta.data()` function. The labels can be obtained from the `get.cell.meta.data("sector.index")`
```{r}
circos.clear()
circos.par(track.margin = c(-0.08, 0.08), gap.degree = 4, start.degree = 90)
chordDiagram(x = d2010, directional = 1, direction.type = c("diffHeight", "arrows"),
link.arr.type = "big.arrow", diffHeight = -0.04, link.sort = TRUE,
link.largest.ontop = TRUE, transparency = 0.25,
order = d1$region, grid.col = d1$col1,
annotationTrack = "grid")
circos.track(track.index = 1, bg.border = NA, panel.fun = function(x, y) {
xx = get.cell.meta.data("xlim")
reg_lab = get.cell.meta.data("sector.index")
circos.text(x = mean(xx), y = 3, labels = reg_lab)
circos.axis(h = "top", labels.cex = 0.8, labels.niceFacing = FALSE, labels.pos.adjust = FALSE)
})
```
When producing the plot with your own labels you might get some warning messages. We can suppress using `points.overflow.warning = FALSE` in `circos.par()`
We can bend the type face with the sector using `facing = "bending"` in `circos.text()`
```{r}
circos.clear()
circos.par(track.margin = c(-0.08, 0.08), gap.degree = 4, start.degree = 90, points.overflow.warning = FALSE)
chordDiagram(x = d2010, directional = 1, direction.type = c("diffHeight", "arrows"),
link.arr.type = "big.arrow", diffHeight = -0.04, link.sort = TRUE,
link.largest.ontop = TRUE, transparency = 0.25,
order = d1$region, grid.col = d1$col1,
annotationTrack = "grid")
circos.track(track.index = 1, bg.border = NA, panel.fun = function(x, y) {
xx = get.cell.meta.data("xlim")
reg_lab = get.cell.meta.data("sector.index")
circos.text(x = mean(xx), y = 3, labels = reg_lab, facing = "bending")
circos.axis(h = "top", labels.cex = 0.8, labels.niceFacing = FALSE, labels.pos.adjust = FALSE)
})
```
As the labels are too long we can split them over two lines using the data in the `reg1` and `reg2` columns of `d1` and use different heights (`y`) for the plots.
```{r}
d1
circos.clear()
circos.par(track.margin = c(-0.08, 0.08), gap.degree = 4, start.degree = 90, points.overflow.warning = FALSE)
chordDiagram(x = d2010, directional = 1, direction.type = c("diffHeight", "arrows"),
link.arr.type = "big.arrow", diffHeight = -0.04, link.sort = TRUE,
link.largest.ontop = TRUE, transparency = 0.25,
order = d1$region, grid.col = d1$col1,
annotationTrack = "grid")
circos.track(track.index = 1, bg.border = NA, panel.fun = function(x, y) {
xx = get.cell.meta.data("xlim")
reg = get.cell.meta.data("sector.index")
reg_lab1 = d1 %>% filter(region == reg) %>% pull(reg1)
reg_lab2 = d1 %>% filter(region == reg) %>% pull(reg2)
circos.text(x = mean(xx), y = 4, labels = reg_lab1, facing = "bending")
circos.text(x = mean(xx), y = 3, labels = reg_lab2, facing = "bending")
circos.axis(h = "top", labels.niceFacing = FALSE, labels.cex = 0.8)
})
```
## Final Output
The text goes into the margins of the plots. We can avoid this by this by setting all four margins to zero.
```{r}
par(mar = rep(0, 4))
circos.clear()
circos.par(track.margin = c(-0.08, 0.08), gap.degree = 4, start.degree = 90, points.overflow.warning = FALSE)
chordDiagram(x = d2010, directional = 1, direction.type = c("diffHeight", "arrows"),
link.arr.type = "big.arrow", diffHeight = -0.04, link.sort = TRUE,
link.largest.ontop = TRUE, transparency = 0.25,
order = d1$region, grid.col = d1$col1,
annotationTrack = "grid")
circos.track(track.index = 1, bg.border = NA, panel.fun = function(x, y) {
xx = get.cell.meta.data("xlim")
reg = get.cell.meta.data("sector.index")
reg_lab1 = d1 %>% filter(region == reg) %>% pull(reg1)
reg_lab2 = d1 %>% filter(region == reg) %>% pull(reg2)
circos.text(x = mean(xx), y = 4, labels = reg_lab1, facing = "bending")
circos.text(x = mean(xx), y = 3, labels = reg_lab2, facing = "bending")
circos.axis(h = "top", labels.cex = 0.8, labels.niceFacing = FALSE, labels.pos.adjust = FALSE)
})
# dev.print(png, file = "cd2010.png", height = 7, width = 7, units = "in", res = 500)
# file.show("cd2010.png")
```
We are almost there. The plot might not look perfect in your R plotting device; however I suggest you do not waste time tweaking text size and positions based on what you see in R - the appearances will change depending on the size of your final file where the plot is outputted.
I have found the easiest way to tweak the final plot is to use `dev.print()` to output the plot to a PNG file (or `dev.copy2pdf()` for a PDF) and then view using `file.show()`.
```{r, eval=FALSE}
dev.print(png, file = "cd2010.png", height = 6, width = 6, units = "in", res = 500)
file.show("cd2010.png")
```
Slight overlap of the labels can be avoided by dropping with a small adjustments such as increasing the `gap.degree` and dropping the level of the single line labels...
```{r}
par(mar = rep(0, 4))
circos.clear()
circos.par(track.margin = c(-0.1, 0.1), gap.degree = 6, start.degree = 90, points.overflow.warning = FALSE)
chordDiagram(x = d2010, directional = 1, direction.type = c("diffHeight", "arrows"),
link.arr.type = "big.arrow", diffHeight = -0.04, link.sort = TRUE,
link.largest.ontop = TRUE, transparency = 0.25,
order = d1$region, grid.col = d1$col1,
annotationTrack = "grid")
circos.track(track.index = 1, bg.border = NA, panel.fun = function(x, y) {
xx = get.cell.meta.data("xlim")
reg = get.cell.meta.data("sector.index")
reg_lab1 = d1 %>% filter(region == reg) %>% pull(reg1)
reg_lab2 = d1 %>% filter(region == reg) %>% pull(reg2)
circos.text(x = mean(xx),
y = ifelse(test = is.na(reg_lab2), yes = 3.5, no = 4),
labels = reg_lab1, facing = "bending")
circos.text(x = mean(xx), y = 3, labels = reg_lab2, facing = "bending")
circos.axis(h = "top", labels.cex = 0.8, labels.niceFacing = FALSE, labels.pos.adjust = FALSE)
})
# dev.print(png, file = "cd2010.png", height = 6, width = 6, units = "in", res = 500)3
# file.show("cd2010.png")
```
## Animations
Animations build upon the code above - running a `for()` loop over different cuts of the data (for different time periods). This provides frames of an eventual GIF file.
The `tweenr` package can be used to build intermediary frames to smooth the transitions between periods by interpolating points between observations for a given number of frames `nframes`. We want to tween the data by migration corridor as such:
```{r, message=FALSE}
library(tweenr)
d2 <- d0 %>%
mutate(corridor = paste(orig_reg, dest_reg, sep = " -> ")) %>%
select(corridor, year0, flow) %>%
mutate(ease = "linear") %>%
tween_elements(time = "year0", group = "corridor", ease = "ease", nframes = 100) %>%
tbl_df()
d2
```
This creates larger data frame `d2`, with 100 observations for each corridor, one for each frame in the animation. In the original data `d0` there are only 11 observations for each corridor, one for each five-year period.
Then some further minor data wrangling is required to ready the data for plotting using the `chordDiagram` function; namely the first three columns in the data must correspond to the origin, destination and flow.
```{r, message=FALSE}
d2 <- d2 %>%
separate(col = .group, into = c("orig_reg", "dest_reg"), sep = " -> ") %>%
select(orig_reg, dest_reg, flow, everything()) %>%
mutate(flow = flow/1e06)
d2
```
## Plots for Each Frame
Now the data is in the correct format, chord diagrams can be produced for each frame of the eventual GIF. To do this, I used a `for` loop to cycle through the tweend data.
```{r, message=FALSE, eval=FALSE}
# create a directory to store the individual plots
dir.create("./plot-gif/")
library(circlize)
for(f in unique(d2$.frame)){
# open a PNG plotting device
png(file = paste0("./plot-gif/cd", f, ".png"), height = 6, width = 6,
units = "in", res = 500)
par(mar = rep(0, 4))
circos.clear()
circos.par(track.margin = c(-0.08, 0.08), gap.degree = 6, start.degree = 90, points.overflow.warning = FALSE)
chordDiagram(x = filter(d2, .frame == f),
directional = 1, direction.type = c("diffHeight", "arrows"),
link.arr.type = "big.arrow", diffHeight = -0.04, link.sort = TRUE,
link.largest.ontop = TRUE, transparency = 0.25,
order = d1$region, grid.col = d1$col1,
annotationTrack = "grid")
circos.track(track.index = 1, bg.border = NA, panel.fun = function(x, y) {
xx = get.cell.meta.data("xlim")
reg = get.cell.meta.data("sector.index")
reg_lab1 = d1 %>% filter(region == reg) %>% pull(reg1)
reg_lab2 = d1 %>% filter(region == reg) %>% pull(reg2)
circos.text(x = mean(xx),
y = ifelse(test = is.na(reg_lab2), yes = 3.5, no = 4),
labels = reg_lab1, facing = "bending")
circos.text(x = mean(xx), y = 3, labels = reg_lab2, facing = "bending")
circos.axis(h = "top", labels.cex = 0.8, labels.niceFacing = FALSE, labels.pos.adjust = FALSE)
})
# close plotting device
dev.off()
}
```
## Creating a GIF
Using the `magick` package a GIF can be created by using the code below to
1. Read in an initial plot and then combine together all other images created above.
2. Scale the combined images.
3. Animate the combined images and save as a `.gif`.
```{r, message=FALSE, eval=FALSE}
library(magick)
img <- image_read(path = "./plot-gif/cd0.png")
for(f in unique(d2$.frame)[-1]){
img0 <- image_read(path = paste0("./plot-gif/cd",f,".png"))
img <- c(img, img0)
message(f)
}
img1 <- image_scale(image = img, geometry = "720x720")
ani0 <- image_animate(image = img1, fps = 10)
image_write(image = ani0, path = "./plot-gif/cd.gif")
```
This gives an output much like this minus the additional details in the corners:
![ ](http://guyabel.com/img/abel-ani10-gf-dist.gif)
## Fixing Scales in Chord Diagrams
Whilst the plot above allows comparisons of the distributions of flows overtime it is more difficult to compare volumes. For such comparisons, Zuguang Gu [suggests](http://zuguang.de/circlize_book/book/advanced-usage-of-chorddiagram.html#compare-two-chord-diagrams) scaling the gaps between the sectors on the outside of the chord diagram. I wrote a little function that can do this for flow data arranged in a tidy format;
```{r}
scale_gap <- function(flow_m, flow_max, gap_at_max = 1, gaps = NULL) {
p <- flow_m / flow_max
if(length(gap_at_max) == 1 & !is.null(gaps)) {
gap_at_max <- rep(gap_at_max, gaps)
}
gap_degree <- (360 - sum(gap_at_max)) * (1 - p)
gap_m <- (gap_degree + sum(gap_at_max))/gaps
return(gap_m)
}
```
where
* `flow_m` is the size of total flows in the matrix for the given year being re-scaled.
* `flow_max` is the maximum size of the flow matrix over all years
* `gap_at_max` is the size in degrees of the gaps in the flow matrix in the year where the flows are at their all time maximum.
* `gaps` is the number of gaps in the chord diagram (i.e. the number of regions).
The function can be used to derive the size of gaps in each frame for a new animated GIF.
```{r}
d3 <- d2 %>%
group_by(.frame) %>%
summarise(flow = sum(flow)) %>%
mutate(gaps = scale_gap(flow_m = flow, flow_max = max(.$flow),
gap_at_max = 4, gaps = 9))
d3
```
The calculations in `d3` can then be plugged into the `for` loop above, where the `circos.par()` function is replaced by
```{r, message=FALSE, eval=FALSE}
circos.par(track.margin = c(-0.08, 0.08), start.degree = 90,
points.overflow.warning = FALSE, gap.degree = filter(d3, .frame == f)$gaps)
```
Once the for loop has produced a new set of images, the same code to produce the GIF file can be run to obtain the animated chord diagrams with changing gaps;
![ ](http://guyabel.com/img/abel-ani10-gf-gap.gif)
Whilst the sector axes are now fixed, I am not convinced that changing the relative gaps is the best way to compare volumes when using animated chord diagrams. The sectors of all regions - bar Northern America - are rotating making it hard follow their changes over time.
Fortunately there is new `xmax` option in `chordDiagram` that can be used to fix the lengths of the x-axis for each sector using a named vector. In the context of producing an animation, the historic maximum migration flows (of combined immigration and emigration flows) in each region can be used, calculated from the original data `d0`
```{r, message=FALSE}
library(magrittr)
reg_max <- d0 %>%
group_by(year0, orig_reg) %>%
mutate(tot_out = sum(flow)) %>%
group_by(year0, dest_reg) %>%
mutate(tot_in = sum(flow)) %>%
filter(orig_reg == dest_reg) %>%
mutate(tot = tot_in + tot_out) %>%
mutate(reg = orig_reg) %>%
group_by(reg) %>%
summarise(tot_max = max(tot)/1e06) %$%
'names<-'(tot_max, reg)
reg_max
```
The `reg_max` object can then be used in the `chordDiagram` function in the `for` loop above, replacing the original call with
```{r, message=FALSE, eval=FALSE}
chordDiagram(x = filter(d2, .frame == f),
directional = 1, direction.type = c("diffHeight", "arrows"),
link.arr.type = "big.arrow", diffHeight = -0.04, link.sort = TRUE,
link.largest.ontop = TRUE, transparency = 0.25,
order = d1$region, grid.col = d1$col1,
annotationTrack = "grid",
xmax = reg_max)
```
Running the complete code - the adapted `for` loop to produce the images and then the `magick` functions to compile the GIF - results in the following animation:
![ ](http://guyabel.com/img/abel-ani10-gf-fix.gif)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment