?

gg_sankey

PeRl

好像有好久沒有更新了,一直想自己用ggplot2實現一下sankey圖,就著手做了一下最簡單的.

一般的sankey圖長這樣,左邊一列,右邊一列,中間的條帶是左右兩個狀態之間的轉變.

那么,首先我們就需要構建左右兩邊的bar,在每個柱的中間標注上所占的比例:

library(ggplot2) color_list <- c("#f38181", "#fce38a", "#61c0bf", "#95e1d3") bar_data <- data.frame(x = c(1, 1, 1, 11, 11,11,11),type = c("a", "b", "c", "a", "b", "c","d"),y = c(0.2, 0.3, 0.5, 0.1, 0.5, 0.2, 0.2) ) text_data_create <- function(bar_data){x = bar_data$xtext = bar_data$yy = apply(matrix(names(table(x)), ncol = 1),1,function(x_group){index = which(x == as.numeric(x_group))start = cumsum(text[index])end = c(0, start[1:(length(start)-1)])return((1-(start + end)/2))})text_data = data.frame(x = x,y = unlist(y), text = text) } bar_p <- ggplot(data = bar_data) +geom_bar(position = "fill", stat = "identity", aes(fill = type, x,y), colour = "white", width = 0.8) +geom_text(data = text_data_create(bar_data), aes(x, y, label = text)) +scale_fill_manual(values = color_list)

結果如圖:

接下去就是中間引流線的構建,簡單來說其實就是確定上線和下線,為了美觀,我用 \(X^{3}\)給線加上弧度:

river_data_create <- function(start_y_upper, end_y_upper, start_y_lower, end_y_lower){x = seq((1 + 0.8/2), (11 - 0.8/2), length = 10000)mean_y_upper = (start_y_upper + end_y_upper)/2y_upper = (start_y_upper - mean_y_upper)/(4.6^3)*(-x + 6)^3 + mean_y_uppermean_y_lower = (start_y_lower + end_y_lower)/2y_lower = (start_y_lower - mean_y_lower)/(4.6^3)*(-x + 6)^3 + mean_y_lowerriver_data = data.frame(x,y_upper,y_lower)text_data = data.frame(x = 6,y = (start_y_upper + end_y_lower) / 2,text = as.character(start_y_upper - start_y_lower))return(list(line = river_data, text = text_data)) }

這樣就完成了計算導流線的點坐標,之后就利用 geom_ribbon 往圖層上添加即可.

river_data <- river_data_create(1,0.9,0.9, 0.8) sankey_p <- bar_p + geom_ribbon(data = river_data$line, aes(x, ymin = y_lower, ymax = y_upper), fill = color_list[1], colour = "white", alpha = 0.2) +geom_text(data = river_data$text, aes(x,y,label = text))

river_data <- river_data_create(0.5,0.6, 0.4, 0.5) sanky_p <- sanky_p + geom_ribbon(data = river_data$line, aes(x, ymin = y_lower, ymax = y_upper), fill = color_list[3], colour = "white", alpha = 0.2) +geom_text(data = river_data$text, aes(x,y,label = text))

river_data <- river_data_create(0.2,0.2, 0, 0) sanky_p <- sanky_p + geom_ribbon(data = river_data$line, aes(x, ymin = y_lower, ymax = y_upper), fill = color_list[3], colour = "white", alpha = 0.2) +geom_text(data = river_data$text, aes(x,y,label = text))

最后就是對theme的調整,把一些沒用的線去掉:

雖然現在已經有很多包可以實現 sankey 圖的繪畫, 比如 riverplot, 但是實現一次還是挺有意思的.

最后,祝您

身體健康.

轉載于:https://www.cnblogs.com/wwdPeRl/p/11127051.html

總結

以上是生活随笔為你收集整理的gg_sankey的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。