ggplot2 でミニ棒グラフ行列を描画する geom_barmatrix を書きました

library(tidyverse)
geom_barmatrix <-function(mapping =NULL, data =NULL,
                           stat ="identity",position ="identity",
                           ...,
                           width =NULL,
                           binwidth =NULL,
                           na.rm =FALSE,
                           show.legend =NA,
                           inherit.aes =TRUE){
  
  layer(
    data = data,
    mapping = mapping,
    stat = stat,
    geom = GeomBarmatrix,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params =list(
      width = width,
      na.rm = na.rm,
      ...
    ))}

GeomBarmatrix <- ggproto("GeomBarmatrix", GeomRect,
                         required_aes = c("x","y","inner_y"),
                         
                         setup_data =function(data, params){
                           data$width <- data$width %||%
                             params$width %||%(resolution(data$x,FALSE)*0.9)
                           transform(data,
                                     ymin = y, ymax = y+0.9*inner_y/max(inner_y)*min(diff(unique(sort(y)))),
                                     xmin = x - width /2, xmax = x + width /2, width =NULL)},
                         
                         draw_panel =function(data, panel_params, coord, width =NULL){
                           GeomRect$draw_panel(data, panel_params, coord)})

geom_barmatrixframe <-function(mapping =NULL, data =NULL,
                                stat ="identity",position ="identity",
                                ...,
                                width =NULL,
                                binwidth =NULL,
                                na.rm =FALSE,
                                show.legend =NA,
                                inherit.aes =TRUE){
  
  layer(
    data = data,
    mapping = mapping,
    stat = stat,
    geom = GeomBarmatrixframe,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params =list(
      width = width,
      na.rm = na.rm,
      ...
    ))}

GeomBarmatrixframe <- ggproto("GeomBarmatrixframe", GeomRect,
                              required_aes = c("x","y"),
                              default_aes = aes(colour ="Black", fill =NA, size =0.5, linetype =1,
                                                alpha =NA),
                              
                              setup_data =function(data, params){
                                data$width <- data$width %||%
                                  params$width %||%(resolution(data$x,FALSE)*0.9)
                                transform(data,
                                          ymin = y, ymax = y+0.9*min(diff(unique(sort(y)))),
                                          xmin = x - width /2, xmax = x + width /2, 
                                          width =NULL)},
                              
                              draw_panel =function(data, panel_params, coord, width =NULL){
                                GeomRect$draw_panel(data, panel_params, coord)})

以下、デモです。

総務省の労働力調査「第12表 年齢階級別就業者数」と「第13表 年齢階級別完全失業者数」を使います。

統計局ホームページ/労働力調査（基本集計） 平成30年（2018年）4月分結果

そのままの形式だと扱いにくかったので加工したファイルを置いておきます。

https://gist.github.com/abikoushi/f565a3bdce8490a82cee22de6577217f

年代、性別、年ごとの就業者数のグラフです。太い棒の高さが就業者数です。

shitsugyo_and_shugyo_shasu <-read.csv("shitsugyo_and_shugyo_shasu.csv")
ggplot(shitsugyo_and_shugyo_shasu,aes(x=age,y=year,inner_y=shugyo))+
  geom_barmatrix()+
  facet_wrap(~sex)+
  theme_bw()

枠がついていたほうが見やすいかなと思って geom_barmatrixframe も書きました。

geom_barmatrixframe を足してやるとこうなります。

（なんかコップに黒い液体が満たされているように見える）

ggplot(shitsugyo_and_shugyo_shasu,aes(x=age,y=year,inner_y=shugyo))+
  geom_barmatrixframe()+
  geom_barmatrix()+
  facet_wrap(~sex)+
  theme_bw(base_family ="Osaka")

棒の色で失業率も表すと4次元棒グラフが出来上がります。

ggplot(shitsugyo_and_shugyo_shasu,aes(x=age,y=year,inner_y=shugyo))+
  geom_barmatrix(aes(fill=shitsugyo/(shugyo+shitsugyo)))+
  geom_barmatrixframe()+
  scale_fill_continuous(labels=scales::percent)+
  facet_wrap(~sex)+
  labs(fill="失業率")+
  theme_bw(base_family="Osaka")

枠とっちゃって x 軸を連続量っぽく見せる手もあります。

ggplot(shitsugyo_and_shugyo_shasu,aes(x=age,y=year,inner_y=shugyo))+
  geom_barmatrix(aes(fill=shitsugyo/(shugyo+shitsugyo)),width =1)+
  scale_fill_continuous(labels=scales::percent)+
  facet_wrap(~sex)+
  labs(fill="失業率")+
  theme_bw(base_family="Osaka")

• 積み上げ棒グラフにも対応したい
• 内側にも小さい y 軸をつけたい

けどどうやればいいかわからない。教えていただけると嬉しいです。