さいしょに
この記事はR言語 Advent Calendar 2023年の19日目の記事です。Advent Calendar に参加するのは初めてですが、最近お仕事でもRをちょくちょく使用するようになったので、これを機に色々アウトプットしていきたいと思います。
モチベーション
xkcdの棒人間をグラフに登場させたいと思ったことはありませんか？私はあります。
検索したところcranにライブラリはありますが、日本語で紹介しているところがなかったようなので、今回まとめておこうとなった次第です。
例
mtcarsのデータセットにて、横軸をwt、縦軸をmpgとしたヘロヘロなグラフを作成してみます。
サンプルコード
#パッケージ管理用のpacmanをインストール
if (!require(pacman)) {install.packages("pacman")}
#必要なライブラリがインストールされていなければインストールしたうえで呼び出し
pacman::p_load(xkcd, tidyverse, Cairo, extrafont)
#サンプルデータとしてmtcarsを使用する
df <- mtcars
df$cyl <- mtcars$cyl |> as.character()
#棒人間のMap作成
mapping <- aes(x, y, scale, ratioxy, angleofspine,
anglerighthumerus, anglelefthumerus,
anglerightradius, angleleftradius,
anglerightleg, angleleftleg, angleofneck)
#棒人間のパラメーター
xrange <- range(mtcars$wt)
yrange <- range(mtcars$mpg)
ratioxy <- diff(xrange)/diff(yrange)
dataman <- data.frame(x = 5, y= 25,
scale = 3,
ratioxy = ratioxy,
angleofspine = -pi/2 ,
anglerighthumerus = -pi/4,
anglelefthumerus = pi + pi/6,
anglerightradius = -pi/2 -pi/6,
angleleftradius = pi/2 + pi/5,
anglerightleg = -pi/2 - pi / 12,
angleleftleg = -pi/2 + pi / 12 ,
angleofneck = -pi/2-pi/10)
#セリフの線
dataline <- data.frame(xbegin = 4.7, ybegin = 25.2, xend = 4.5, yend=27.5)
#作図
set.seed(123) #指定しなくてもよいが、指定しないと手書き風の部分がランダムになる
p <- ggplot(df) +
geom_point(aes(x = wt, y = mpg, colour = cyl)) +
xkcdaxis(xrange,yrange)+
xkcdman(mapping, dataman)+
annotate("text", x= 4.5, y = 30,
label = "Wow\nmtcars!", family="xkcd") +
xkcdline(aes(x = xbegin, y = ybegin, xend = xend, yend =yend),
dataline, xjitteramount = 0.12)+
theme(text = element_text(size = 16, family = "xkcd"))
p
# Cairoデバイスの開始
Cairo(file = "ggplot_output.png", type = "png", family = "xkcd", dpi = 150)
# ggplotオブジェクトの描画
print(p)
# デバイスの閉じる
dev.off()
ハマったところ
フォントについて
下のRStudioでの設定について、Graphicにaggを設定しているとフォントが上書きされてしまう(?)のでこのヘロヘロなフォントがうまく表示できなかったりします。私は日本語を表示させるのにaggを使っておりフォント周り何もわからないのですが、今回のようなグラフを作成したい場合はCairoにしています。
また、ggsave()で保存する場合もフォントが変更されてしまったので、以下のようにCairoでfamilyを指定するような保存しています。これだとちゃんとxkcdで保存されます。
# Cairoデバイスの開始
Cairo(file = "ggplot_output.png", type = "png", family = "xkcd", dpi = 150)
# ggplotオブジェクトの描画
print(p)
# デバイスの閉じる
dev.off()
棒人間の持つ引数について
これが非常に多くありますが、腕の角度や肩の角度をラジアンで指定します。たとえば腕の角度を8時の方向に持っていきたいなと思ったとき、私の場合「9時はpi」「そこから1/6pi動かしたい」と考えていますのでコードもそのようになっています。頭の中で「8時の方向は7/6piでしょ」と一発で変換できる方はこのような回りくどい書き方は不要だと思います。
anglelefthumerus = pi + pi/6 #左上腕を8時方向の角度にする
さいごに
サンプルコード
#パッケージ管理用のpacmanをインストール
if (!require(pacman)) {install.packages("pacman")}
#必要なライブラリがインストールされていなければインストールしたうえで呼び出し
pacman::p_load(xkcd, tidyverse, Cairo, extrafont)
# ハート形のデータフレームを作成(ChatGPTに聞いた)
heart_data <- data.frame(
x = c(seq(-2, 2, by = 0.01), seq(-2, 2, by = 0.01)),
y = c(sqrt(1 - (abs(seq(-2, 2, by = 0.01)) - 1) ^ 2), -3 * sqrt(1 - sqrt(abs(seq(-2, 2, by = 0.01)) / 2)))
)
#棒人間のMap作成
mapping <- aes(x, y, scale, ratioxy, angleofspine,
anglerighthumerus, anglelefthumerus,
anglerightradius, angleleftradius,
anglerightleg, angleleftleg, angleofneck)
#棒人間のパラメーター
xrange <- range(heart_data$x)
yrange <- range(heart_data$y)
ratioxy <- diff(xrange)/diff(yrange)
dataman <- data.frame(x = -2, y= -2.5,
scale = 0.5,
ratioxy = ratioxy,
angleofspine = -pi/2 + pi/24,
anglerighthumerus = -pi/6,
anglelefthumerus = pi + pi/6,
anglerightradius = pi/3,
angleleftradius = pi/2 + pi/5,
anglerightleg = -pi/2 - pi / 12,
angleleftleg = -pi/2 + pi / 12 ,
angleofneck = -pi/2+pi/8)
#セリフの線
dataline <- data.frame(xbegin = -2, ybegin = -2, xend = -2.1, yend = -1.8)
#作図
p <- ggplot(heart_data, aes(x = x, y = y)) +
geom_line(color = "red") +
xkcdman(mapping, dataman)+
coord_cartesian(ylim = c(-4, 2), xlim = c(-2.5, 2.5))+
annotate("text", x= -2.1, y = -1.5, size = 7,
label = "Merry Xmas!", family="xkcd") +
xkcdline(aes(x = xbegin, y = ybegin, xend = xend, yend =yend),
dataline, xjitteramount = 0.12)+
theme(text = element_text(size = 16, family = "xkcd"))
# Cairoデバイスの開始
Cairo(600, 600, file = "merryxmas.png", type = "png", family = "xkcd", dpi = 100)
# ggplotオブジェクトの描画
print(p)
# デバイスの閉じる
dev.off()
参考