サンキー・ダイアグラム2

riverplot パッケージ

(参考)環境省『平成25年版環境・循環型社会・生物多様性白書』
我が国の物質フロー平成22年度

1
2
3
4
5
6
7
edges <- data.frame(
N1=c("輸入製品","輸入資源","輸入","国内資源","天然資源等投入量","循環利用量","総物質投入量","含水等","投入総量","投入総量","投入総量","投入総量","投入総量",
"投入総量","廃棄物等の発生","廃棄物等の発生","廃棄物等の発生","廃棄物等の発生"),
N2=c("輸入","輸入","天然資源等投入量","天然資源等投入量","総物質投入量","総物質投入量","投入総量","投入総量","輸出","蓄積純増","エネルギー消費及び工業プロセス排出","食糧消費","施肥","廃棄物等の発生",
"再利用","減量化","自然還元","最終処分"),
Value=c(55,727,783,582,1365,246,1611,267,184,706,317,88,14,567,246,219,83,19),stringsAsFactors = F )
edges

N1 N2 Value
1 輸入製品 輸入 55
2 輸入資源 輸入 727
3 輸入 天然資源等投入量 783
4 国内資源 天然資源等投入量 582
5 天然資源等投入量 総物質投入量 1365
6 循環利用量 総物質投入量 246
7 総物質投入量 投入総量 1611
8 含水等 投入総量 267
9 投入総量 輸出 184
10 投入総量 蓄積純増 706
11 投入総量 エネルギー消費及び工業プロセス排出 317
12 投入総量 食糧消費 88
13 投入総量 施肥 14
14 投入総量 廃棄物等の発生 567
15 廃棄物等の発生 再利用 246
16 廃棄物等の発生 減量化 219
17 廃棄物等の発生 自然還元 83
18 廃棄物等の発生 最終処分 19

1
2
3
4
nodes = data.frame(ID = unique(c(edges$N1, edges$N2)), stringsAsFactors = FALSE)
nodes
nodes$x = c(1,1,2,1,3,1,4,1,5,7,rep(6,5),8,9,9,9)
nodes

ID x
1 輸入製品 1
2 輸入資源 1
3 輸入 2
4 国内資源 1
5 天然資源等投入量 3
6 循環利用量 1
7 総物質投入量 4
8 含水等 1
9 投入総量 5
10 廃棄物等の発生 7
11 輸出 6
12 蓄積純増 6
13 エネルギー消費及び工業プロセス排出 6
14 食糧消費 6
15 施肥 6
16 再利用 8
17 減量化 9
18 自然還元 9
19 最終処分 9

1
2
3
4
5
6
library(riverplot)
rp <- list(nodes = nodes, edges = edges)
class(rp) <- c(class(rp), "riverplot")
#png("rp03.png",width=800,height=800)
plot(rp, plot_area = 0.95,gravity = "top")
#dev.off()

時計回りに90度回転(以下のグラフも同じ)

ラベルを指定

1
2
3
4
5
6
7
8
9
10
11
#ラベルの位置を調整する(全角スペースで調整)ためにnodesのlabelsを指定
nodes$labels = c("輸入製品(55)","輸入資源(727)","輸入(783)","国内資源(582)","天然資源等投入量(1365)","循環利用量(246)",
"総物質投入量(1611)","含水等(267)","","廃棄物等の発生(567)","輸出(184)","蓄積純増(543)","\nエネルギー消費及び \n工業プロセス排出(480)",
"食糧消費(88)","施肥(14)","\n再利用(246)\n=循環利用量","減量化\n(219)","自然還元\n (83) ","最終処分\n (19) ")
nodes
library(riverplot)
rp <- list(nodes = nodes, edges = edges)
class(rp) <- c(class(rp), "riverplot")
#png("rp04.png",width=800,height=800)
plot(rp, plot_area = 0.95,gravity = "top")
#dev.off()

stylesも指定する(1)

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
library(RColorBrewer)
#palette = brewer.pal(12,"Set3")
#透過色を使う
palette = paste(brewer.pal(12,"Set3"),"88",sep="")
palette2=c(palette[1],palette[1],palette[2],palette[2],palette[3],palette[3],palette[4],palette[4],
palette[5],palette[6],palette[7],palette[7],palette[7],palette[7],palette[7],palette[3],palette[8],palette[9],palette[10])
styles = lapply(1:19, function(n) {
list(col = palette2[n])
})
names(styles) = nodes$ID
library(riverplot)
rp <- list(nodes = nodes, edges = edges,styles=styles)
class(rp) <- c(class(rp), "riverplot")
#png("rp05.png",width=800,height=800)
#linux : インストール済みのフォントを確認
#system("fc-list")
#par(family="TakaoPMincho")
plot(rp, plot_area = 0.95,gravity = "top")
#dev.off()

stylesも指定する(2)

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
palette2=c(rep("white",2),"#afeeee88","white","#afeeee88","white","#afeeee88","white","#87cefa","#afeeee88",rep("white",9))
styles = lapply(1:19, function(n) {
list(col = palette2[n])
})
names(styles) = nodes$ID
library(riverplot)
rp <- list(nodes = nodes, edges = edges,styles=styles)
class(rp) <- c(class(rp), "riverplot")
ds <- default.style()
ds[["edgestyle"]] <- "straight"
ds[["col"]] <- "#87cefa"
ds[["edgecol"]] <- "col"
ds[["textcol"]] <- "#696969"
#ds[["nodestyle"]] <- "invisible"
#png("rp06.png",width=800,height=800)
plot(rp, plot_area = 0.95,gravity = "top",default_style= ds)
#dev.off()

stylesも指定する(3)

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
palette2=c(rep("white",2),"#afeeee88","white","#afeeee88","white","#afeeee88","white","#87cefa","#afeeee88",rep("white",9))
styles = lapply(1:19, function(n) {
list(col = palette2[n])
})
names(styles) = nodes$ID
library(riverplot)
rp <- list(nodes = nodes, edges = edges,styles=styles)
class(rp) <- c(class(rp), "riverplot")
ds <- default.style()
ds[["edgestyle"]] <- "straight"
#ds[["col"]] <- "#87cefa"
ds[["edgecol"]] <- "#87cefa"
ds[["textcol"]] <- "#696969"
#ds[["nodestyle"]] <- "invisible"
#png("rp07.png",width=800,height=800)
plot(rp, plot_area = 0.95,gravity = "top",default_style= ds)
#dev.off()

stylesも指定する(4)

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
palette2=c(rep("#0000FF11",2),"#afeeee88","#0000FF11","#afeeee88","#FF00FF11","#afeeee88","#00FFFF11","#87cefa","#FF000011",rep("#FFFF0011",5),"#FF00FF11",rep("#00FF0011",3))
styles = lapply(1:19, function(n) {
list(col = palette2[n])
})
names(styles) = nodes$ID
library(riverplot)
rp <- list(nodes = nodes, edges = edges,styles=styles)
class(rp) <- c(class(rp), "riverplot")
ds <- default.style()
ds[["edgestyle"]] <- "straight"
#ds[["col"]] <- "#87cefa"
#ds[["edgecol"]] <- "#87cefa"
ds[["textcol"]] <- "#696969"
#ds[["nodestyle"]] <- "invisible"
#png("rp08.png",width=800,height=800)
plot(rp, plot_area = 0.95,gravity = "top",default_style= ds)
#dev.off()