I would like make a similar graph posted here using our data, however, I received this error message “Detect some gaps are too large”. Do you think because some values are very small as compare to others (e.g.; 1 versus 1812)?. I made a few changes to my data as in matrix 2 by adding a few zeros after a 1 or 2 and it works. Is there any way to work around with this range of data? I would like to plot this beautiful graph using my real data (matrix 1). Any help is much appreciated.
library(circlize)
#matrix 1
#level0 <- c(1, 8, 39, 14, 2)
#level1 <- c(1, 19, 153, 93, 1)
#level2 <- c(2, 19, 274, 46, 13)
#level3 <- c(0, 8, 152, 1812, 465)
#level4 <- c(0, 2, 1, 164, 226)
#matrix 2
#level0 <- c(100,8,39,14,200)
#level1 <- c(100,190, 153,93,100)
#level2 <- c(200,19,274,646,130)
#level3 <- c(200,800,152,1812,465)
#level4 <- c(200,200,100,164,226)
#build matrix 2
a <- list(c(100,8,39,14,200),c(100,19, 153,93,100), c(200,19,274,646,13), c(200,8,152,1812,465),c(200,200,100,164,226))
mat <- do.call(rbind, a)
#mat = matrix(sample(1:100, 25, replace = TRUE), 5, 5)
rownames(mat) = c("level 0", "level 1", "level 2", "level 3", "level 4")
colnames(mat) = c("Level0", "Level1", "Level2", "Level3", "Level4")
rn = rownames(mat)
cn = colnames(mat)
factors = c(rn, rev(cn))
factors = factor(factors, levels = factors)
col_sum = apply(mat, 2, sum)
row_sum = apply(mat, 1, sum)
xlim = cbind(rep(0, 10), c(row_sum, col_sum))
par(mar = c(1, 1, 1, 1))
circos.par(cell.padding = c(0, 0, 0, 0), clock.wise = FALSE, track.margin=c(0,0.1),
gap.degree = 4, start.degree =90)
circos.initialize(factors = factors, xlim = xlim
, sector.width = c(row_sum/sum(row_sum), col_sum/sum(col_sum)))
circos.trackPlotRegion(factors = factors, ylim = c(0, 1), bg.border = NA,
# bg.col = c("red", "orange", "yellow", "green", "blue", rep("grey", 5)), track.height = 0.05,
bg.col = c(c("red", "orange", "yellow", "green", "blue"),
c("blue", "green", "yellow", "orange", "red")), track.height = 0.05,
panel.fun = function(x, y) {
sector.name = get.cell.meta.data("sector.index")
xlim = get.cell.meta.data("xlim")
circos.text(mean(xlim), 3, sector.name, adj = c(0.5, 0))
circos.axis(labels.cex=0.8, direction="outside", labels.away.percentage=0.5)
if(sector.name %in% rn) {
for(i in seq_len(ncol(mat))) {
circos.lines(rep(sum(mat[sector.name, seq_len(i)]), 2), c(0, 1),
col = "white")
}
} else if(sector.name %in% cn) {
for(i in seq_len(nrow(mat))) {
circos.lines(rep(sum(mat[ seq_len(i), sector.name]), 2), c(0, 1),
col = "white")
}
}
})
col = c("#FF000020", "#FFA50020", "#FFFF0020", "#00FF0020", "#0000FF20")
for(i in seq_len(nrow(mat))) {
for(j in seq_len(ncol(mat))) {
circos.link(rn[i], c(sum(mat[i, seq_len(j-1)]), sum(mat[i, seq_len(j)])),
cn[j], c(sum(mat[seq_len(i-1), j]), sum(mat[seq_len(i), j])),
col = col[i], border = "white")
}
}
So I think your df1
object is a little different to my original code. If you set up the matrix m
and df1
as such...
m <- matrix(c(1, 8, 39, 14, 2,
1, 19, 153, 93, 1,
2, 19, 274, 46, 13,
0, 8, 152, 1812, 465,
0, 2, 1, 164, 226), nrow=5, byrow=TRUE)
df1 <- data.frame(order=1:5, region=paste0("level",1:5),
rcol = c("red", "orange", "yellow", "green", "blue"),
lcol = c("#FF000020", "#FFA50020", "#FFFF0020", "#00FF0020", "#0000FF20"),
stringsAsFactors=FALSE)
df1$region <- factor(df1$region, levels=df1$region)
df1$xmin <- 0
df1$xmax <- rowSums(m)+colSums(m)
n <-nrow(df1)
dimnames(m) <- list(orig=df1$region,dest=df1$region)
You get the following objects...
> df1
order region rcol lcol xmin xmax
1 1 level1 red #FF000020 0 68
2 2 level2 orange #FFA50020 0 323
3 3 level3 yellow #FFFF0020 0 973
4 4 level4 green #00FF0020 0 4566
5 5 level5 blue #0000FF20 0 1100
> addmargins(m)
dest
orig level1 level2 level3 level4 level5 Sum
level1 1 8 39 14 2 64
level2 1 19 153 93 1 267
level3 2 19 274 46 13 354
level4 0 8 152 1812 465 2437
level5 0 2 1 164 226 393
Sum 4 56 619 2129 707 3515
I explain in more detail the purpose of df1
in the working paper. Briefly, the df1
object contains information on the lengths of sectors to be plotted (xmin
and xmax
) and the colours for the circle rectangles on the outside rcol
and ribbon link colours lcol
. You could of course have the same lcol
and rcol
,...adapt away until you get a palette/style that you like (perhaps a little less transparency for the lcol
).
You can then go ahead and use very similar code as to what I have in the demo file in the migest package to get a plot (I only changed the circos.axis
axis arguments and the subset of df2
)...
library(circlize)
library(plyr)
par(mar=rep(0,4))
circos.clear()
#basic circos graphic parameters
circos.par(cell.padding=c(0,0,0,0), track.margin=c(0,0.15), start.degree = 90, gap.degree =4)
#sector details
circos.initialize(factors = df1$region, xlim = cbind(df1$xmin, df1$xmax))
#plot sectors
circos.trackPlotRegion(ylim = c(0, 1), factors = df1$region, track.height=0.1,
#panel.fun for each sector
panel.fun = function(x, y) {
#select details of current sector
name = get.cell.meta.data("sector.index")
i = get.cell.meta.data("sector.numeric.index")
xlim = get.cell.meta.data("xlim")
ylim = get.cell.meta.data("ylim")
#plot labels
circos.text(x=mean(xlim), y=2.2, labels=name, facing = "arc", cex=0.8)
#plot main sector
circos.rect(xleft=xlim[1], ybottom=ylim[1], xright=xlim[2], ytop=ylim[2], col = df1$rcol[i], border=df1$rcol[i])
#blank in part of main sector
#circos.rect(xleft=xlim[1], ybottom=ylim[1], xright=xlim[2]-rowSums(m)[i], ytop=ylim[1]+0.3, col = "white", border = "white")
#white line all the way around
#circos.rect(xleft=xlim[1], ybottom=0.3, xright=xlim[2], ytop=0.32, col = "white", border = "white")
#plot axis
circos.axis(labels.cex=0.6, major.at=seq(from=0,to=floor(df1$xmax)[i],by=500),
labels.away.percentage = 0.15)
})
##
##plot links
##
#add sum values to df1, marking the x-position of the first links out (sum1) and in (sum2). Updated for further links in loop below.
df1$sum1 <- colSums(m)
df1$sum2 <- numeric(n)
#create a data.frame of matrix sorted by element size, to allow largest plotted first
df2 <- cbind(as.data.frame(m),orig=rownames(m), stringsAsFactors=FALSE)
df2 <- reshape(df2, idvar="orig", varying=list(1:n), direction="long", timevar="dest", time=rownames(m), v.names = "m")
df2 <- arrange(df2,desc(m))
#loose non zero links
df2 <- subset(df2, m>0)
#plot links
for(k in 1:nrow(df2)){
#i,j reference of flow matrix
i<-match(df2$orig[k],df1$region)
j<-match(df2$dest[k],df1$region)
#plot link
circos.link(sector.index1=df1$region[i], point1=c(df1$sum1[i], df1$sum1[i] + abs(m[i, j])),
sector.index2=df1$region[j], point2=c(df1$sum2[j], df1$sum2[j] + abs(m[i, j])),
col = df1$lcol[i])
#update sum1 and sum2 for use when plotting the next link
df1$sum1[i] = df1$sum1[i] + abs(m[i, j])
df1$sum2[j] = df1$sum2[j] + abs(m[i, j])
}
Which gives a plot like this...
If you want to add some directionality to the plot then uncomment the two lines in panel.fun
which add the white rectangles and boarder line.
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