Is there any package in cran which could plot a chord layout like this: (this visualization is also called chord diagram)
How to make a chord diagram, step by step. Select the chord diagram template. Upload a CSV or Excel file, or just type in your values to the existing data sheet manually. Set the three required columns for “from” and “to” (e.g. people or countries) and “value” (a number describing the size of the flow).
I wrote the following several years ago, but never really used it: feel free to adapt it to your needs, or even turn it into a full-fledged package.
# Return a line in the Poincare disk, i.e., # a circle arc, perpendicular to the unit circle, through two given points. poincare_segment <- function(u1, u2, v1, v2) { # Check that the points are sufficiently different if( abs(u1-v1) < 1e-6 && abs(u2-v2) < 1e-6 ) return( list(x=c(u1,v1), y=c(u2,v2)) ) # Check that we are in the circle stopifnot( u1^2 + u2^2 - 1 <= 1e-6 ) stopifnot( v1^2 + v2^2 - 1 <= 1e-6 ) # Check it is not a diameter if( abs( u1*v2 - u2*v1 ) < 1e-6 ) return( list(x=c(u1,v1), y=c(u2,v2)) ) # Equation of the line: x^2 + y^2 + ax + by + 1 = 0 (circles orthogonal to the unit circle) a <- ( u2 * (v1^2+v2^2) - v2 * (u1^2+u2^2) + u2 - v2 ) / ( u1*v2 - u2*v1 ) b <- ( u1 * (v1^2+v2^2) - v1 * (u1^2+u2^2) + u1 - v1 ) / ( u2*v1 - u1*v2 ) # Swap 1's and 2's # Center and radius of the circle cx <- -a/2 cy <- -b/2 radius <- sqrt( (a^2+b^2)/4 - 1 ) # Which portion of the circle should we draw? theta1 <- atan2( u2-cy, u1-cx ) theta2 <- atan2( v2-cy, v1-cx ) if( theta2 - theta1 > pi ) theta2 <- theta2 - 2 * pi else if( theta2 - theta1 < - pi ) theta2 <- theta2 + 2 * pi theta <- seq( theta1, theta2, length=100 ) x <- cx + radius * cos( theta ) y <- cy + radius * sin( theta ) list( x=x, y=y ) } # Sample data n <- 10 m <- 7 segment_weight <- abs(rnorm(n)) segment_weight <- segment_weight / sum(segment_weight) d <- matrix(abs(rnorm(n*n)),nr=n, nc=n) diag(d) <- 0 # No loops allowed # The weighted graph comes from two quantitative variables d[1:m,1:m] <- 0 d[(m+1):n,(m+1):n] <- 0 ribbon_weight <- t(d) / apply(d,2,sum) # The sum of each row is 1; use as ribbon_weight[from,to] ribbon_order <- t(apply(d,2,function(...)sample(1:n))) # Each row contains sample(1:n); use as ribbon_order[from,i] segment_colour <- rainbow(n) segment_colour <- brewer.pal(n,"Set3") transparent_segment_colour <- rgb(t(col2rgb(segment_colour)/255),alpha=.5) ribbon_colour <- matrix(rainbow(n*n), nr=n, nc=n) # Not used, actually... ribbon_colour[1:m,(m+1):n] <- transparent_segment_colour[1:m] ribbon_colour[(m+1):n,1:m] <- t(ribbon_colour[1:m,(m+1):n]) # Plot gap <- .01 x <- c( segment_weight[1:m], gap, segment_weight[(m+1):n], gap ) x <- x / sum(x) x <- cumsum(x) segment_start <- c(0,x[1:m-1],x[(m+1):n]) segment_end <- c(x[1:m],x[(m+2):(n+1)]) start1 <- start2 <- end1 <- end2 <- ifelse(is.na(ribbon_weight),NA,NA) x <- 0 for (from in 1:n) { x <- segment_start[from] for (i in 1:n) { to <- ribbon_order[from,i] y <- x + ribbon_weight[from,to] * ( segment_end[from] - segment_start[from] ) if( from < to ) { start1[from,to] <- x start2[from,to] <- y } else if( from > to ) { end1[to,from] <- x end2[to,from] <- y } else { # no loops allowed } x <- y } } par(mar=c(1,1,2,1)) plot( 0,0, xlim=c(-1,1),ylim=c(-1,1), type="n", axes=FALSE, main="Two qualitative variables in polar coordinates", xlab="", ylab="") for(from in 1:n) { for(to in 1:n) { if(from<to) { u <- start1[from,to] v <- start2[from,to] x <- end1 [from,to] y <- end2 [from,to] if(!is.na(u*v*x*y)) { r1 <- poincare_segment( cos(2*pi*v), sin(2*pi*v), cos(2*pi*x), sin(2*pi*x) ) r2 <- poincare_segment( cos(2*pi*y), sin(2*pi*y), cos(2*pi*u), sin(2*pi*u) ) th1 <- 2*pi*seq(u,v,length=20) th2 <- 2*pi*seq(x,y,length=20) polygon( c( cos(th1), r1$x, rev(cos(th2)), r2$x ), c( sin(th1), r1$y, rev(sin(th2)), r2$y ), col=transparent_segment_colour[from], border=NA ) } } } } for(i in 1:n) { theta <- 2*pi*seq(segment_start[i], segment_end[i], length=100) r1 <- 1 r2 <- 1.05 polygon( c( r1*cos(theta), rev(r2*cos(theta)) ), c( r1*sin(theta), rev(r2*sin(theta)) ), col=segment_colour[i], border="black" ) }
The chorddiag package (still in development) provides an interactive D3
implementation
The chorddiag package allows to create interactive chord diagrams using the JavaScript visualization library D3 (http://d3js.org) from within R using the htmlwidgets interfacing framework..
Example
devtools::install_github("mattflor/chorddiag") library(chorddiag) ## example taken from the github site m <- matrix(c(11975, 5871, 8916, 2868, 1951, 10048, 2060, 6171, 8010, 16145, 8090, 8045, 1013, 990, 940, 6907), byrow = TRUE, nrow = 4, ncol = 4) haircolors <- c("black", "blonde", "brown", "red") dimnames(m) <- list(have = haircolors, prefer = haircolors) m # prefer # have black blonde brown red # black 11975 5871 8916 2868 # blonde 1951 10048 2060 6171 # brown 8010 16145 8090 8045 # red 1013 990 940 6907 groupColors <- c("#000000", "#FFDD89", "#957244", "#F26223") chorddiag(m, groupColors = groupColors, groupnamePadding = 40)
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