mecobalamin’s diary

人間万事塞翁が馬

https://help.hatenablog.com/entry/developer-option

Rでboxplotとbeeswarmを重ねて表示、その2

Rを使ってboxplotとbeeswarmを重ねて表示する
一度記事を書いているので今回はその2
mecobalamin.hatenablog.com

時系列データを曜日でまとめてbeeswarmでプロットする
こんなグラフができる



boxplot.png

元のデータはこれと同じフォーマット
mecobalamin.hatenablog.com
点の数が増えている
boxplotとbeeswarmもpythonで書きたかったが
重ねて書く方法がわからなかったので
まずはRで描いてみる

ポイントは

  • Deteから曜日を抽出する
  • 曜日ごとにカラーコードを割り当てる

コードの流れはこんな感じ

  1. Dateをstrからdateに変換する
  2. 曜日の抽出
  3. 曜日にカラーパレットを割り当てる
  4. 曜日の数字を単語に置き換える

1. Dateをstrからdateに変換する
時系列のデータは1列目に日付が入っている
読み込んだときはstrなのでdateに変換する
この時、時間の起点を指定する

d$Date <- as.Date(d$Date, origin="1899-12-30")

1899なのは理由があるらしい
エクセルの日付(シリアル値)を、Rで使えるように変換する - Rプログラミングの小ネタ
エクセルの日時変数をRで扱う - Qiita
How to determine the correct argument for origin in as.Date, R - Stack Overflow


2. 曜日の抽出
as.POSIXltを使って曜日を抽出する

d$weekday <- as.POSIXlt(d$Date)$wday + 1

曜日は数字として得られる

3. 曜日にカラーパレットを割り当てる
8色つかってからパレットを作成して
そこから7色のカラーコードを取り出す
brewer.palで指定できる色数はdisplay.brewer.all()で表示されるパレットの色数で決まる
Pairedの場合は12まで指定できる

func_color_palette <- colorRampPalette(rev(RColorBrewer::brewer.pal(8,  "Paired")))
color_palette <- func_color_palette(7)

曜日の数字を使って曜日にカラーコードを割り当てる
データごとに対応するカラーコードの列を作る
今回は3つデータの列があるのでカラーコードも3列作る

d <- d[order(d$weekday), ]
d$color1 <- color_palette[d$weekday]
d$color2 <- d$color1
d$color3 <- d$color1

4. 曜日の数字を単語に置き換える
weekdayの列を数字から単語に置き換える
ぐぐったらいくつかのサイトで似たような方法が出てきた
例えばこちらのサイト。
https://www.it-swarm-ja.tech/ja/r/%E6%9B%9C%E6%97%A5%E3%82%92%E6%8E%A2%E3%81%99/942412834/
この書き方をしたことなかったが
シンプルな書き方でいい感じ

d$weekday <- c("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday")[d$weekday]

グラフを書くだけならRが楽かな
pythonに置き換えられたらいいのだが。

ライブラリの読み込みを明示していないが
以下の2行ではライブラリを使っている
RColorBrewerとbeeswarmのインストールが必要

RColorBrewer::brewer.pal()
beeswarm::beeswarm()

コードの全文

options(encoding = "UTF-8")
rm(list = ls(all = True))

setwd("C:\\path\\to\\textfile")
options(digits = 4, width = 100)
bp_file_name <- "test.txt"
func_color_palette <- colorRampPalette(rev(RColorBrewer::brewer.pal(8,  "Paired")))
color_palette <- func_color_palette(7)

d <- read.table(test, header = T, sep=",")
d$Date <- as.Date(d$Date, origin="1899-12-30")

d$weekday <- as.POSIXlt(d$Date)$wday + 1
d <- d[order(d$weekday), ]
d$color1 <- color_palette[d$weekday]
d$color2 <- d$color1
d$color3 <- d$color1

d$weekday <- c("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday")[d$weekday]

pngname = sprintf("boxplot.png")
png(pngname, width = 600, height = 800)
par(mar = c(5, 5, 4, 5))
boxplot(d[2:4],
        ylab = "intensity (a. u.)",
        cex.lab = 1.5,
        outline = FALSE,
        methods = "hex"
      )

beeswarm::beeswarm(d[2:4],
         pwcol = d[7:9],
         add = TRUE,
         cex = 1.5,
         pch = 20)

points(apply(d[,2:4], 2, mean), col = "red", pch = 3, lwd = 2, cex = 3)

legend("bottomleft",
        legend = unique(d$weekday),
        pch = rep(20, length(unique(d$weekday))),
        col = unique(d$color1)
      )
dev.off()
warnings()

*** 23 October 2021追記 ***
存在するオブジェクトを削除するコマンドを2行目で実行している

rm(list = ls(all =TRUE))

これは
R初心者のためのABC | A.ジュール, E.イエノウ, E.ミースターズ |本 | 通販 | Amazon
のp. 25に記述あり
*** 追記ここまで ***