PIB - 20191205: GNU R - ggplot2 - 複数系列の棒・円グラフに引き出し線による凡例を付ける

承前

問題

複数系列ある場合、aes() の中での計算がグループ化出来ないため適切な位置に凡例を付ける事が出来なかった。

解決方法

必要な位置情報を事前計算して data frame 内に放り込んで、それを参照することにした。
以下の関数が肝。
add_geom_stackinfo = function(df, x, y, fill, vjust=0.5) {
  df=data.frame(df,cs=0,sum=0,ratio=0,percent=0,position_stack=0,position_fill=0)
  for(i in unique(df[,x])) {
    idx = (df[,x]==i)
    df[idx,]$sum = total = sum(df[idx,y])
    df[idx,]$cs = rev(cumsum(rev(df[idx,y])))
    df[idx,]$percent = 100 * (df[idx,]$ratio = df[idx,y] / total)
    df[idx,]$position_fill = (
      df[idx,]$position_stack = df[idx,]$cs - df[idx,y] * vjust
    ) / total
  }
  df
}

サンプルデータ 

a=c("A1","A2","A3","A4","A5","MA","NA");a=factor(a)
set.seed(0)
df = rbind(
  data.frame(a = a, n = 0,y=2018),
  data.frame(a = a[runif(10, min = 1, max = length(a)) %>% as.integer()], n=1,y=2018),
  data.frame(a = a[runif(20, min = 1, max = length(a)) %>% as.integer()], n=1,y=2019))
df
df = aggregate(df$n, by = list(y= df$y, a = df$a), FUN = sum); names(df)[3] = "n"
df = add_geom_stackinfo(df, "y", "n", "a")
df

> a=c("A1","A2","A3","A4","A5","MA","NA");a=factor(a)
> set.seed(0)
> df = rbind(
+     data.frame(a = a, n = 0,y=2018),
+     data.frame(a = a[runif(10, min = 1, max = length(a)) %>% as.integer()], n=1,y=2018),
+     data.frame(a = a[runif(20, min = 1, max = length(a)) %>% as.integer()], n=1,y=2019))
> df
    a n    y
1  A1 0 2018
2  A2 0 2018
3  A3 0 2018
4  A4 0 2018
5  A5 0 2018
6  MA 0 2018
7  NA 0 2018
8  MA 1 2018
9  A2 1 2018
10 A3 1 2018
11 A4 1 2018
12 MA 1 2018
13 A2 1 2018
14 MA 1 2018
15 MA 1 2018
16 A4 1 2018
17 A4 1 2018
18 A1 1 2019
19 A2 1 2019
20 A2 1 2019
21 A5 1 2019
22 A3 1 2019
23 A5 1 2019
24 A3 1 2019
25 A5 1 2019
26 MA 1 2019
27 A3 1 2019
28 A5 1 2019
29 MA 1 2019
30 A2 1 2019
31 A4 1 2019
32 A1 1 2019
33 A2 1 2019
34 A3 1 2019
35 A1 1 2019
36 A3 1 2019
37 MA 1 2019
> df = aggregate(df$n, by = list(y= df$y, a = df$a), FUN = sum); names(df)[3] = "n"
> df = add_geom_stackinfo(df, "y", "n", "a")
> df
      y  a n cs sum ratio percent position_stack position_fill
1  2018 A1 0 10  10  0.00       0           10.0         1.000
2  2019 A1 3 20  20  0.15      15           18.5         0.925
3  2018 A2 2 10  10  0.20      20            9.0         0.900
4  2019 A2 4 17  20  0.20      20           15.0         0.750
5  2018 A3 1  8  10  0.10      10            7.5         0.750
6  2019 A3 5 13  20  0.25      25           10.5         0.525
7  2018 A4 3  7  10  0.30      30            5.5         0.550
8  2019 A4 1  8  20  0.05       5            7.5         0.375
9  2018 A5 0  4  10  0.00       0            4.0         0.400
10 2019 A5 4  7  20  0.20      20            5.0         0.250
11 2018 MA 4  4  10  0.40      40            2.0         0.200
12 2019 MA 3  3  20  0.15      15            1.5         0.075
13 2018 NA 0  0  10  0.00       0            0.0         0.000

カラーテーブル 

mycolor = rev(c(
    "#ffa0a0",
    "#ffe0a0",
    "#ffffe0",
    "#c0ffc0",
    "#a0ffff",
    "#a0e0ff",
    "#a0c0ff",
    "#c0c0ff",
    "#e0c0ff",
    "#ffc0ff",
    "#e0e0e0"))

積み上げ棒グラフ 

ggplot(df) +
    aes(x=y, y=n, fill=a) +
    geom_col(colour="black",position="stack") +
    geom_label_repel(aes(y=ifelse(0<n,position_stack,NA),label=ifelse(0<n,sprintf("%s:%2d\n%4.1f%%",a,n,percent),"")),nudge_x=0.6,na.rm=T,show.legend=F) +
    #coord_polar(theta="y") +
    scale_fill_manual(values=rev(mycolor)) +
    theme(panel.background=NULL,axis.title=element_blank(),axis.text=element_blank(),rect=element_blank(),line=element_blank())

ggplot(df) +
    aes(x=y, y=n, fill=a) +
    geom_col(colour="black",position="fill") +
    geom_label_repel(aes(y=ifelse(0<n,position_fill,NA),label=ifelse(0<n,sprintf("%s:%2d\n%4.1f%%",a,n,percent),"")),nudge_x=0.6,na.rm=T,show.legend=F) +
    #coord_polar(theta="y") +
    scale_fill_manual(values=rev(mycolor)) +
    theme(panel.background=NULL,axis.title=element_blank(),axis.text=element_blank(),rect=element_blank(),line=element_blank())

円グラフ 

ggplot(df) +
    aes(x=y, y=n, fill=a) +
    geom_col(colour="black",position="stack") +
    geom_label_repel(aes(y=ifelse(0<n,position_stack,NA),label=ifelse(0<n,sprintf("%s:%2d\n%4.1f%%",a,n,percent),"")),nudge_x=0.6,na.rm=T,show.legend=F) +
    coord_polar(theta="y") +
    scale_fill_manual(values=rev(mycolor)) +
    theme(panel.background=NULL,axis.title=element_blank(),axis.text=element_blank(),rect=element_blank(),line=element_blank())

ggplot(df) +
    aes(x=y, y=n, fill=a) +
    geom_col(colour="black",position="fill") +
    geom_label_repel(aes(y=ifelse(0<n,position_fill,NA),label=ifelse(0<n,sprintf("%s:%2d\n%4.1f%%",a,n,percent),"")),nudge_x=0.6,na.rm=T,show.legend=F) +
    coord_polar(theta="y") +
    scale_fill_manual(values=rev(mycolor)) +
    theme(panel.background=NULL,axis.title=element_blank(),axis.text=element_blank(),rect=element_blank(),line=element_blank())

関連