#' Chord diagram for directional origin-destination data
#'
#' Adaption of \code{circlize::chordDiagramFromDataFrame()} with defaults set to allow for more effective visualisation of directional origin-destination data
#'
#' @param x Data frame with origin in first column, destination in second column and bilateral measure in third column
#' @param lab Named vector of labels for plot. If \code{NULL} will use names from \code{d}
#' @param lab_bend1 Named vector of bending labels for plot. Note line breaks do not work with \code{facing = "bending"} in circlize.
#' @param lab_bend2 Named vector of second row of bending labels for plot.
#' @param label_size Font size of label text.
#' @param label_nudge Numeric value to nudge labels towards (negative number) or away (positive number) the sector axis.
#' @param label_squeeze Numeric value to nudge \code{lab_bend1} and \code{lab_bend2} labels apart (negative number) or together (positive number).
#' @param axis_size Font size on axis labels.
#' @param axis_breaks Numeric value for how often to add axis label breaks. Default not activated, uses default from \code{circlize::circos.axis()}
#' @param ... Arguments for \code{circlize::chordDiagramFromDataFrame()}.
#' @param no_labels Logical to indicate if to include plot labels. Set to \code{FALSE} by default.
#' @param no_axis Logical to indicate if to include plot axis. Set to \code{FALSE} by default.
#' @param zero_margin Set margins of the plotting graphics device to zero. Set to \code{TRUE} by default.
#' @param clear_circos_par Logical to run \code{circlize::circos.clear()}. Set to \code{TRUE} by default. Set to \code{FALSE} if you wish to add further to the plot.
#' @param start.degree Argument for \code{circlize::circos.par()}.
#' @param gap.degree Argument for \code{circlize::chordDiagramFromDataFrame()}.
#' @param track.margin Argument for \code{circlize::chordDiagramFromDataFrame()}.
#' @param points.overflow.warning Argument for \code{circlize::chordDiagramFromDataFrame()}.
#'
#' @return Chord diagram based on first three columns of \code{x}. The function tweaks the defaults of \code{circlize::chordDiagramFromDataFrame()} for easier plotting of directional origin-destination data. Users can override these defaults and pass additional tweaks using any of the \code{circlize::chordDiagramFromDataFrame()} arguments.
#'
#' The layout of the plots are designed to specifically work on plotting images into PDF devices with widths and heights of 7 inches (the default dimension when using the \code{pdf} function). See the end of the examples for converting PDF to PNG images in R.
#'
#' Fitting the sector labels on the page is usually the most time consuming task. Use the different label options, including line breaks, \code{label_nudge}, track height in \code{preAllocateTracks} and font sizes in \code{label_size} and \code{axis_size} to find the best fit. If none of the label options produce desirable results, plot your own using \code{circlize::circos.text} having set \code{no_labels = TRUE} and \code{clear_circos_par = FALSE}.
#' @export
#'
#' @examples
#'
#' library(dplyr)
#' library(tidyr)
#' library(tibble)
#' library(countrycode)
#' #' # download Abel and Cohen (2019) estimates
#' f <- url("https://ndownloader.figshare.com/files/38016762") %>%
#' read.csv() %>%
#' as_tibble()
#' f
#'
#' # use dictionary to get region to region flows
#' d <- f %>%
#' mutate(
#' orig = countrycode(sourcevar = orig, custom_dict = dict_ims,
#' origin = "iso3c", destination = "region"),
#' dest = countrycode(sourcevar = dest, custom_dict = dict_ims,
#' origin = "iso3c", destination = "region")
#' ) %>%
#' group_by(year0, orig, dest) %>%
#' summarise_all(sum) %>%
#' ungroup()
#' d
#'
#' # 2015-2020 pseudo-Bayesian estimates for plotting
#' pb <- d %>%
#' filter(year0 == 2015) %>%
#' mutate(flow = da_pb_closed/1e6) %>%
#' select(orig, dest, flow)
#' pb
#'
#' # pdf(file = "chord.pdf")
#' mig_chord(x = pb)
#' # dev.off()
#' # file.show("chord.pdf")
#'
#' # pass arguments to circlize::chordDiagramFromDataFrame
#' # pdf(file = "chord.pdf")
#' mig_chord(x = pb,
#' # order of regions
#' order = unique(pb$orig)[c(1, 3, 2, 6, 4, 5)],
#' # spacing for labels
#' preAllocateTracks = list(track.height = 0.3),
#' # colours
#' grid.col = c("blue", "royalblue", "navyblue", "skyblue", "cadetblue", "darkblue")
#' )
#' # dev.off()
#' # file.show("chord.pdf")
#'
#' # multiple line labels to fit on longer labels
#' r <- pb %>%
#' sum_region() %>%
#' mutate(lab = str_wrap_n(string = region, n = 2)) %>%
#' separate(col = lab, into = c("lab1", "lab2"), sep = "\n", remove = FALSE, fill = "right")
#' r
#'
#' # pdf(file = "chord.pdf")
#' mig_chord(x = pb,
#' lab = r %>%
#' select(region, lab) %>%
#' deframe(),
#' preAllocateTracks = list(track.height = 0.25),
#' label_size = 0.8,
#' axis_size = 0.7
#' )
#' # dev.off()
#' # file.show("chord.pdf")
#'
#' # bending labels
#' # pdf(file = "chord.pdf")
#' mig_chord(x = pb,
#' lab_bend1 = r %>%
#' select(region, lab1) %>%
#' deframe(),
#' lab_bend2 = r %>%
#' select(region, lab2) %>%
#' deframe()
#' )
#' # dev.off()
#' # file.show("chord.pdf")
#'
#'
#' # convert pdf to image file
#' # library(magick)
#' # p <- image_read_pdf("chord.pdf")
#' # image_write(image = p, path = "chord.png")
#' # file.show("chord.png")
mig_chord <- function(
x,
lab = NULL,
lab_bend1 = NULL,
lab_bend2 = NULL,
label_size = 1,
label_nudge = 0,
label_squeeze = 0,
axis_size = 0.8,
axis_breaks = NULL,
...,
no_labels = FALSE,
no_axis = FALSE,
clear_circos_par = TRUE,
zero_margin = TRUE,
start.degree = 90,
gap.degree = 4,
track.margin = c(-0.1, 0.1),
points.overflow.warning = FALSE
){
z <- list(...)
z$df <- x[, 1:3]
if(is.null(z$transparency))
z$transparency = 0.25
if(is.null(z$directional))
z$directional = 1
if(is.null(z$direction.type))
z$direction.type = c("diffHeight", "arrows")
if(is.null(z$link.arr.type))
z$link.arr.type = "big.arrow"
if(is.null(z$diffHeight))
z$diffHeight = -0.05
if(is.null(z$link.sort))
z$link.sort = TRUE
if(is.null(z$link.largest.ontop))
z$link.largest.ontop = TRUE
if(is.null(z$link.largest.ontop))
z$link.largest.ontop = TRUE
keep_axis <- TRUE
if(!is.null(z$annotationTrack))
if(!("axis" %in% z$annotationTrack))
keep_axis <- FALSE
if(no_axis)
keep_axis <- FALSE
if(is.null(z$annotationTrack))
z$annotationTrack = "grid"
# y <- list()
# y[] <- z[!names(z) %in% formalArgs(chordDiagramFromDataFrame)]
# z <- z[names(z) %in% formalArgs(chordDiagramFromDataFrame)]
h <- 0.2
if(!is.null(lab_bend1) | !is.null(lab_bend2))
h <- 0.05
if(is.null(z$preAllocateTracks))
z$preAllocateTracks = list(track.height = h)
if(is.null(z$grid.col)){
region <- col <- NULL
z$grid.col <- x %>%
dplyr::rename(orig = 1,
dest = 2,
flow = 3) %>%
sum_region() %>%
{if(is.null(z$order)) dplyr::mutate(., region = factor(region, levels = union(x[[1]], x[[2]]))) else dplyr::mutate(., region = factor(region, levels = z$order))} %>%
dplyr::arrange(., region) %>%
dplyr::mutate(col = grDevices::colorRampPalette(migest::umbrella)(nrow(.))) %>%
{if(is.null(z$grid.col)) . else dplyr::mutate(., col = z$grid.col)} %>%
dplyr::select(region, col) %>%
tibble::deframe()
# pie(rep(1, length(xx)), col = xx, labels = names(xx))
}
if(!is.null(z$grid.col) & !is.null(z$order)){
z$grid.col <- stats::setNames(object = z$grid.col, nm = z$order)
}
circlize::circos.clear()
circlize::circos.par(
start.degree = start.degree,
track.margin = track.margin,
gap.degree = gap.degree,
points.overflow.warning = points.overflow.warning
)
if(zero_margin)
graphics::par(mar = rep(0, 4))
do.call(what = circlize::chordDiagramFromDataFrame, args = z)
if(keep_axis){
# if(is.null(y$h))
# y$h <- "bottom"
# if(is.null(y$labels.cex))
# y$labels.cex <- axis_size
circlize::circos.trackPlotRegion(
track.index = 1,
bg.border = NA,
panel.fun = function(x, y) {
if(is.null(axis_breaks))
circlize::circos.axis(h = "bottom", labels.cex = axis_size,
labels.niceFacing = FALSE, labels.pos.adjust = FALSE)
# do.call(what = circlize::circos.axis, args = y)
if(!is.null(axis_breaks)){
# if(is.null(y$major.at))
# y$major.at <- seq(from = 0, to = sum(z$df[,3]), by = axis_breaks)
# do.call(what = circlize::circos.axis, args = y)
mm <- sum(z$df[,3])
if(!is.null(z$xmax))
mm <- max(z$xmax)*2
circlize::circos.axis(
h = "bottom", labels.cex = axis_size, labels.niceFacing = FALSE,
labels.pos.adjust = FALSE,
major.at = seq(from = 0, to = mm, by = axis_breaks)
)
}
})
}
if(!no_labels){
circlize::circos.trackPlotRegion(
track.index = 1,
bg.border = NA,
panel.fun = function(x, y) {
xx = circlize::get.cell.meta.data("xlim")
s = circlize::get.cell.meta.data("sector.index")
if(is.null(lab) & is.null(lab_bend1) & is.null(lab_bend2)){
lab <- s
names(lab) <- s
}
if(is.null(lab_bend1) & is.null(lab_bend2)){
yy <- label_nudge + -0.5 + -0.55 * log(z$preAllocateTracks$track.height)
if(!keep_axis)
yy <- yy - 0.3
circlize::circos.text(
x = mean(xx), y = yy, labels = lab[s], cex = label_size,
facing = "clockwise", adj = c(0, 0.5), niceFacing = TRUE)
}
if(!is.null(lab_bend1)){
yy <- 3 + label_nudge
if(is.null(lab_bend2))
yy <- 2 +label_nudge
if(!is.null(lab_bend2))
if(is.na(lab_bend2[s]))
yy <- 2 + label_nudge
circlize::circos.text(
x = mean(xx), y = yy, labels = lab_bend1[s], cex = label_size,
facing = "bending", niceFacing = FALSE)
}
if(!is.null(lab_bend2)){
circlize::circos.text(
x = mean(xx), y = 2 + label_nudge - label_squeeze, labels = lab_bend2[s],
cex = label_size, facing = "bending", niceFacing = FALSE)
}
}
)
}
if(clear_circos_par)
circlize::circos.clear()
}
# figuring out label distances relationship
# x = tibble(track = c(0.05, 0.1, 0.2),
# y = c(1.2, 0.6, 0.4))
# x %>%
# ggplot(aes(x = track, y = y)) +
# geom_point() +
# scale_x_log10()
#
#
# lm(formula = y ~ log(track), data = x)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.