Rの`{ggplot2}`のグラフの軸ラベルを縦書きにしたい（第二弾）、そして改行もしたいと思った（追加要素）

Rの{ggplot2}のグラフの軸ラベルを縦書きにしたい（第二弾）、そして改行もしたいと思った（追加要素）。

できればscale_x_discrete()内でlabels引数に関数等を指定することでいい感じにしたいと思った。投入する前のデータでいじるのではなく、ggplot内で簡単にできるようにしたかった。

いい感じの関数が見つからなかったので作ってGitHubにあげている{infun}にlabel_vertical()として入れてみた。ただ、野良パッケージを使いたくない人のために、関数そのものも後の方に貼っておく。

install.packages("remotes")
remotes::install_github("indenkun/infun")

サンプルデータを作る。値に意味はない。

df <- data.frame(city = c("秋田県\n東北", "東京都\n関東"),
                 value = c(10,12))

そのまま{ggplot2}で棒グラフを書く。

library(ggplot2)
ggplot(data = df) +
  geom_bar(aes(x = city, y = value), stat = "identity")

これを縦書きにして、改行も実現したい。

{infun}のlabel_vertical()を使って擬似的に実現する。

ggplot(data = df) +
  geom_bar(aes(x = city, y = value), stat = "identity") +
  scale_x_discrete(labels = infun::label_vertical(line_feed = "\\n"))

できた。

\nを鍵にして、line_feedに指定することで改行しているようにみえるようにしている。（エスケープシーケンスなのでその前にもう一個\を入れる。）

これは別にエスケープシーケンス以外の文字も改行の鍵にできるので例えばスペースで区切られている場合も実現できる。

df <- data.frame(city = c("東北 秋田県", "関東 東京都"),
                 value = c(10,12))

これをそのまま{ggplot2}で棒グラフを書くと次のようになる。

ggplot(data = df) +
  geom_bar(aes(x = city, y = value), stat = "identity")

これの半角スペースを鍵にして改行を縦書きで実現したいとおもったら、line_feedに半角スペースを指定すると実現できる。

ggplot(data = df) +
  geom_bar(aes(x = city, y = value), stat = "identity") +
  scale_x_discrete(labels = infun::label_vertical(line_feed = " "))

x軸とy軸入れ替えても行ける。

ggplot(data = df) +
  geom_bar(aes(x = value, y = city), stat = "identity") +
  scale_y_discrete(labels = infun::label_vertical(line_feed = " "))

ただし、擬似的な改行なので半角文字や、比等幅フォントを使うとずれるしもはやこのコードでは縦書き実現できないので難しい。

コードを貼り付けておく

label_vertical <- function(replace_list = vertical_list(), line_feed = NULL, blank_space = "    "){
  function(x){
    if(!is.null(replace_list)){
      list_is_formula <- unlist(lapply(replace_list, function(x){"formula" == class(x)}))
      if(all(list_is_formula)){
        for(i in replace_list){
          x <- gsub(i[[2]], i[[3]], x)
        }
      }else if("formula" == class(replace_list)){
        x <- gsub(replace_list[[2]], replace_list[[3]], x)
      }else{
        stop("the replace_list must be in the formula format, in list.")
      }
    }
    if(is.null(line_feed)){
      unlist(lapply(strsplit(split="", x), paste0, collapse = "\n"))
    }else{
      unlist(lapply(x, function(x){
        x <- unname(unlist(sapply(x, strsplit, line_feed)))
        label_text <- character()
        for(i in 1:max(nchar(x))){
          m <- unname(sapply(x, function(x){
            substr(x, i, i)
          }))
          m <- sapply(m, function(x){
            if(x == "") blank_space
            else x
          })
          if(length(label_text) == 0) label_text <- paste0(paste0(rev(m), collapse = ""), "\n")
          else label_text <- paste0(label_text, paste0(paste0(rev(m), collapse = ""), "\n"))
        }
        label_text
      }
      ))
    }
  }
}

vertical_list <- function(){
  list("\u30fc" ~ "\uff5c",
       "-" ~ "\u2758")
}