はじめに
とりあえず我流でやってみる黒魔術シリーズです。もっといい方法があれば教えてください。
この記事では、カレンダーを作成します。Rでカレンダーを作るのであれば(私はよく知りませんが)calendRパッケージを調べてみるのがいいと思います。
【他の内容】
【目次】
ggplot2でカレンダーを作成したい
ggplot2パッケージを利用してカレンダーを作成する。
利用するパッケージを読み込む。
# 利用パッケージ library(tidyverse) library(lubridate) library(zipangu)
この記事では基本的に、パッケージ名::関数名()の記法を使うので、パッケージを読み込む必要はない。ただし、作図コードについてはパッケージ名を省略するため、ggplot2を読み込む必要がある。
また、magrittrパッケージのパイプ演算子%>%ではなく、ネイティブパイプ演算子|>を使う。%>%に置き換えても処理できるが、その場合はmagrittrを読み込む必要がある。
インデックスの確認
まずは、カレンダーの作図に用いるインデックス(日ごとのセル(マス)のプロット位置)を確認する。
行と列のインデックスを作成する。
# インデックスを作成 index_df <- tibble::tibble( week_idx = rep(1:6, each = 7), # 行インデックス dow_idx = rep(1:7, times = 6), # 列インデックス cell_idx = 1:(7*6) # セルインデックス ) index_df
## # A tibble: 42 × 3 ## week_idx dow_idx cell_idx ## <int> <int> <int> ## 1 1 1 1 ## 2 1 2 2 ## 3 1 3 3 ## 4 1 4 4 ## 5 1 5 5 ## 6 1 6 6 ## 7 1 7 7 ## 8 2 1 8 ## 9 2 2 9 ## 10 2 3 10 ## # … with 32 more rows
行インデックス(縦方向のプロット位置)として、第6週までを表す1から6の整数を作成して、week_idx列とする。
列インデックス(横方向のプロット位置)として、曜日を表す1から7の整数を作成して、dow_idx列とする。
セルインデックスとして、1から7 * 6の整数を作成して、cell_idx列とする。
グラフでインデックスを確認する。
# インデックスを作図 ggplot() + geom_tile(data = index_df, mapping = aes(x = dow_idx, y = week_idx), color = "black", alpha = 0) + # セル geom_text(data = index_df, mapping = aes(x = dow_idx, y = week_idx, label = cell_idx), size = 5) + # セルインデックスラベル scale_x_continuous(breaks = 1:max(index_df[["dow_idx"]])) + # 行インデックス scale_y_reverse(breaks = 1:max(index_df[["week_idx"]])) + # 列インデックス coord_fixed(ratio = 1) + # アスペクト比 theme(panel.grid.minor = element_blank()) + # 図の体裁 labs(title = "セルインデックス (cell_idx)", x = "曜日インデックス (dow_idx)", y = "週インデックス (week_idx)")
6×7個の日付セルでカレンダーを表現できる。各セルの交点は、曜日番号±0.5、週番号±0.5である。
交点を作らない(セル間を空ける)場合は、geom_tile()のwidth引数で横サイズ、height引数で縦サイズを調整できる。
セルインデックスは、横縦の順に割り当てておき、行インデックス(第何週か)の計算に用いる。
ひと月のカレンダー
1か月のカレンダーを作成する。
基本形
作成するカレンダーの年・月と、週の始まりの曜日を指定する。
# 年を指定 year <- 2024 # 月を指定 month <- 2 # 週初めの曜日を指定:(月: 1, ..., 日: 7) dow_start_idx <- 1 # 土曜・日曜の曜日インデックスを設定 dow_sat_idx <- ifelse(dow_start_idx == 7, yes = 7, no = 7 - dow_start_idx) dow_sun_idx <- 8 - dow_start_idx dow_sat_idx; dow_sun_idx
## [1] 6 ## [1] 7
年をyear、月をmonthとして整数を指定する。
週始めの曜日をdow_start_idxとして1から7の整数で指定する。wday()のweek_start引数に指定する値で、1なら月曜、2なら火曜・・・が週始めになる。デフォルトは7で日曜始まりである。
週始めの曜日を1として曜日番号(インデックス)が割り当てられる。土曜日と日曜日に関して、番号を計算してそれぞれdow_***_idxとしておく。
日付データを作成する。
# ひと月の暦データを作成 date_df <- tibble::tibble( # 1日間隔の日付を作成 date = seq( from = paste0(year, "-", month, "-01") |> lubridate::as_date(), # 初日 to = paste0(year, "-", month, "-01") |> lubridate::as_date() |> lubridate::rollforward(), # 末日 by = "day" ), ) |> dplyr::mutate( day = lubridate::day(date), # 日にちラベル # 作図用の値を作成 dow_idx = lubridate::wday(date, week_start = dow_start_idx), # 曜日番号(列インデックス) dow_label = lubridate::wday(date, week_start = dow_start_idx, label = TRUE), # 曜日ラベル cell_idx = day + head(dow_idx, n = 1) - 1, # セルインデックス week_idx = (cell_idx - 1) %/% 7 + 1 # 週番号(行インデックス) ) date_df
## # A tibble: 29 × 6 ## date day dow_idx dow_label cell_idx week_idx ## <date> <int> <dbl> <ord> <dbl> <dbl> ## 1 2024-02-01 1 4 木 4 1 ## 2 2024-02-02 2 5 金 5 1 ## 3 2024-02-03 3 6 土 6 1 ## 4 2024-02-04 4 7 日 7 1 ## 5 2024-02-05 5 1 月 8 2 ## 6 2024-02-06 6 2 火 9 2 ## 7 2024-02-07 7 3 水 10 2 ## 8 2024-02-08 8 4 木 11 2 ## 9 2024-02-09 9 5 金 12 2 ## 10 2024-02-10 10 6 土 13 2 ## # … with 19 more rows
指定した月の初日から最終日までの日付をseq(by = "day")で作成して、データフレームに格納する。月初の日付を表す文字列yyyy-mm-01を作成して、as_date()で日付型に変換して用いる。さらに、rollforward()で月末の日付が得られる。
日付ごとに、day()で日にち列、wday()で曜日番号列を作成する。また確認用に、wday()のlabel引数をTRUEにして、曜日ラベル列を作成する。
「月初の曜日番号-1」に各日付の「日にち」を加えるとセル番号が得られる。
「セル番号-1」を「7で割った余り」に「1」を加えると週番号が得られる。商余は%/%で計算できる。
1か月分のカレンダーの原型を作成する。
# 横軸ラベルを作成 dow_label_vec <- lubridate::wday(1:7, week_start = dow_start_idx, label = TRUE) |> # 日本語名 sort() #dow_label_vec <- lubridate::wday(1:7, week_start = dow_start_idx, label = TRUE, abbr = TRUE, locale = "en_US") |> # 英語名の省略形 # sort() # ひと月のカレンダーを作図:(原型) ggplot() + geom_tile(data = date_df, mapping = aes(x = dow_idx, y = week_idx), fill = "white", color = "black") + # 日付セル geom_text(data = date_df, mapping = aes(x = dow_idx, y = week_idx, label = day), size = 10) + # 日付ラベル scale_x_continuous(breaks = 1:7, labels = dow_label_vec) + # 曜日軸 scale_y_reverse(breaks = 1:6) + # 週軸 coord_fixed(ratio = 1) + # アスペクト比 theme(panel.grid.minor = element_blank()) + # 図の体裁 labs(title = paste0(year, "年", month, "月のカレンダー"), x = "曜日", y = "週")
日ごとのセルをgeom_tile()、日付ラベルなどをgeom_text()で描画する。
scale_x_continuous()で横軸ラベルに曜日を表示して、scale_y_reverse()で縦軸を昇順にする。
wday()のlabel = TRUEに加えて、abbr引数で曜日名の省略形、locale引数で曜日名の言語を指定できる。
月曜始まりのカレンダーで月初の曜日が木曜日(曜日番号が4)の場合は、各日にちに3を足した値がセルインデックス(各セルインデックスを3移動すると日にち)に対応するのが分かる。
続いて、祝日とカレンダーの体裁を設定する。
装飾
祝日データを取得する。
# 祝日情報を取得 holiday_vec <- zipangu::jholiday(year = year, lang = "jp") |> unlist() |> lubridate::as_date() holiday_vec
## 元日 成人の日 建国記念の日 天皇誕生日 春分の日 昭和の日 ## "2024-01-01" "2024-01-08" "2024-02-11" "2024-02-23" "2024-03-20" "2024-04-29" ## 憲法記念日 みどりの日 こどもの日 海の日 山の日 敬老の日 ## "2024-05-03" "2024-05-04" "2024-05-05" "2024-07-15" "2024-08-11" "2024-09-16" ## 秋分の日 スポーツの日 文化の日 勤労感謝の日 ## "2024-09-22" "2024-10-14" "2024-11-03" "2024-11-23"
zipanguパッケージのjholiday()を使って日本の祝日情報を取得する。各祝日の日付がリストで出力されるので、unlist()でベクトルに変換する。その際に、日付がシリアル値になるので、as_date()で日付型に変換する。要素名が祝日名になる。要素名はnames()で取り出せる。
祝日データを格納する。
# 祝日の暦データを作成 tmp_holiday_df <- tibble::tibble( date = holiday_vec, # 祝日の日付 holiday_label = names(holiday_vec), # 祝日ラベル dow_idx = lubridate::wday(date, week_start = dow_start_idx) # 振替休日の作成用 ) |> dplyr::filter(lubridate::month(date) == month) # 指定した月の祝日を抽出 tmp_holiday_df
## # A tibble: 2 × 3 ## date holiday_label dow_idx ## <date> <chr> <dbl> ## 1 2024-02-11 建国記念の日 7 ## 2 2024-02-23 天皇誕生日 5
各祝日の日付と名前をデータフレームに格納して、指定した月のデータのみを取り出す。
振替休日の作成に用いる曜日番号も格納しておく。
祝日データに振替休日データを追加する。
# 振替休日の暦データを作成 holiday_df <- tmp_holiday_df |> dplyr::filter(dow_idx == dow_sun_idx) |> # 日曜日の祝日を抽出 dplyr::mutate( date = dplyr::case_when( holiday_label == "憲法記念日" ~ date + lubridate::days(3), holiday_label == "みどりの日" ~ date + lubridate::days(2), TRUE ~ date + lubridate::days(1) ), # 日にち holiday_label = "振替休日", # 祝日名 dow_idx = lubridate::wday(date, week_start = dow_start_idx) # 祝日データの結合用 ) |> dplyr::bind_rows(tmp_holiday_df) |> # 祝日の暦データを結合 dplyr::select(date, holiday_label, holiday_label) |> # 日付データの結合用 dplyr::arrange(date) holiday_df
## # A tibble: 3 × 2 ## date holiday_label ## <date> <chr> ## 1 2024-02-11 建国記念の日 ## 2 2024-02-12 振替休日 ## 3 2024-02-23 天皇誕生日
祝日データから、祝日が日曜日の場合は取り出して、翌日の値に書き換える。ただし、憲法記念日とみどりの日の場合は、翌日も休日であるため、それぞれ3日後と2日後の値に書き換える。(翌月の日付になる場合は取り除く必要があるが、日本の場合は無いので省略。)
祝日データをbind_rows()で結合して、日付データと重複する(date列以外の)列を取り除く。
日付データに休日データを追加する。
# 装飾用の暦データを作成 calendar_df <- date_df |> dplyr::left_join(holiday_df, by = "date") |> # 祝日データを結合 dplyr::mutate( date_type = dplyr::case_when( !is.na(holiday_label) ~ "holiday", dow_idx == dow_sun_idx ~ "holiday", dow_idx == dow_sat_idx ~ "weekend", TRUE ~ "weekday" ) # 日付カテゴリ ) calendar_df
## # A tibble: 29 × 8 ## date day dow_idx dow_label cell_idx week_idx holiday_label date_type ## <date> <int> <dbl> <ord> <dbl> <dbl> <chr> <chr> ## 1 2024-02-01 1 4 木 4 1 <NA> weekday ## 2 2024-02-02 2 5 金 5 1 <NA> weekday ## 3 2024-02-03 3 6 土 6 1 <NA> weekend ## 4 2024-02-04 4 7 日 7 1 <NA> holiday ## 5 2024-02-05 5 1 月 8 2 <NA> weekday ## 6 2024-02-06 6 2 火 9 2 <NA> weekday ## 7 2024-02-07 7 3 水 10 2 <NA> weekday ## 8 2024-02-08 8 4 木 11 2 <NA> weekday ## 9 2024-02-09 9 5 金 12 2 <NA> weekday ## 10 2024-02-10 10 6 土 13 2 <NA> weekend ## # … with 19 more rows
日付データに祝日データをleft_join()で結合する。
作図時の色付け設定用に、日付カテゴリ列を作成する。この例では、平日・日曜日と祝日・(祝日以外の)土曜日の3つに分類する値を設定する。分類用の値は文字列でなくとも何でもよい。
セルを塗りつぶして休日を示すカレンダーを作成する。
# ひと月のカレンダーを作図:(休日のセル色を変更) calendar_fill <- ggplot() + # geom_tile(data = calendar_df, # mapping = aes(x = dow_idx, y = week_idx), # fill = "white", color = "black") + # 平日セル geom_tile(data = calendar_df, mapping = aes(x = dow_idx, y = week_idx, fill = date_type), color = "black", alpha = 0.1) + # 休日セル geom_text(data = calendar_df, mapping = aes(x = dow_idx-0.4, y = week_idx-0.4, label = day), size = 10, hjust = 0, vjust = 1) + # 日付ラベル geom_text(data = calendar_df, mapping = aes(x = dow_idx+0.45, y = week_idx-0.4, label = holiday_label), size = 5, hjust = 1, vjust = 1, na.rm = TRUE) + # 祝日ラベル scale_x_continuous(breaks = 1:7, labels = NULL, sec.axis = dup_axis(trans = ~., labels = dow_label_vec)) + # 曜日軸 scale_y_reverse(breaks = 1:6) + # 週軸 scale_fill_manual(breaks = c("weekday", "holiday", "weekend"), values = c("white", "red", "blue")) + # 休日用の塗りつぶし色 coord_fixed(ratio = 1, expand = FALSE) + # 描画領域 theme( axis.title = element_blank(), # 軸ラベル axis.text.x = element_text(size = 30), # 横軸目盛ラベル axis.text.y = element_blank(), # 縦軸目盛ラベル axis.ticks = element_blank(), # 軸目盛指示線 panel.grid.major = element_blank(), # 主グリッド線 panel.grid.minor = element_blank(), # 副グリッド線 panel.border = element_rect(fill = NA), # グラフ領域の枠線 panel.background = element_blank(), # グラフ領域の背景 plot.title = element_text(size = 25, face = "bold"), # タイトル plot.subtitle = element_text(size = 50, face = "bold", hjust = 0.5), # サブタイトル legend.position = "none" # 凡例の位置 ) + # 図の体裁 labs(title = paste0(year, "年"), subtitle = paste0(month, "月"), x = "曜日", y = "週") calendar_fill
geom_tile()のfill引数で、日付カテゴリ(date_type列の値)ごとにセルの色を塗りつぶして色分けする。カテゴリごとの色はscale_fill_manual()で設定できる。breaks引数にfill引数に指定された値(date_type列の値)、values引数に割り当てる色を指定する。
theme()のpanel.background引数で背景色を白にしない場合は、別のgeom_tile()を使って全ての日付のセルを白にしておく必要がある。
scale_x_continuous()で、横軸目盛ラベルとして曜日を表示する。labels引数にNULLを指定して第1軸(下側)のラベルを非表示にして、sec.axis引数にdup_axis()を使ってlabel引数に文字列を指定して第2軸(上側)のラベルを表示する。
日付の文字色を変更して休日を示すカレンダーを作成する。
# ひと月のカレンダーを作図:(休日のラベル色を変更) calendar_color <- ggplot() + geom_tile(data = calendar_df, mapping = aes(x = dow_idx, y = week_idx), fill = "white", color = "black") + # 日付セル geom_text(data = calendar_df, mapping = aes(x = dow_idx-0.4, y = week_idx-0.4, label = day, color = date_type), size = 10, hjust = 0, vjust = 1) + # 日付ラベル geom_text(data = calendar_df, mapping = aes(x = dow_idx+0.45, y = week_idx-0.4, label = holiday_label), size = 5, color = "red", hjust = 1, vjust = 1, na.rm = TRUE) + # 祝日ラベル scale_x_continuous(breaks = 1:7, labels = NULL, sec.axis = dup_axis(trans = ~., labels = dow_label_vec)) + # 曜日軸 scale_y_reverse(breaks = 1:6) + # 週軸 scale_color_manual(breaks = c("weekday", "holiday", "weekend"), values = c("black", "red", "blue")) + # 休日用文字色 coord_fixed(ratio = 1, expand = FALSE) + # 描画領域 theme( axis.title = element_blank(), # 軸ラベル axis.text.x = element_text(size = 30), # 横軸目盛ラベル axis.text.y = element_blank(), # 縦軸目盛ラベル axis.ticks = element_blank(), # 軸目盛指示線 panel.grid.major = element_blank(), # 主グリッド線 panel.grid.minor = element_blank(), # 副グリッド線 panel.border = element_rect(fill = NA), # グラフ領域の枠線 #panel.background = element_blank(), # グラフ領域の背景 plot.title = element_text(size = 25, face = "bold"), # タイトル plot.subtitle = element_text(size = 50, face = "bold", hjust = 0.5), # サブタイトル legend.position = "none" # 凡例の位置 ) + # 図の体裁 labs(title = paste0(year, "年"), subtitle = paste0(month, "月"), x = "曜日", y = "週") calendar_color
geom_text()のcolor引数で、日付カテゴリ(date_type列の値)ごとに日にちラベルの文字色を変更して色分けする。カテゴリごとの色はscale_txet_manual()で設定できる。
以上で、カレンダーを作成できた。次は利用例として、カレンダー上に予定を表示する。
利用例
スケジュールを指定する。
# 予定日の暦データを作成 schedule_df <- tibble::tibble( date = c("2", "19", "22") |> # 日にちを指定 (\(.){paste0(year, "-", month, "-", .)})() |> # 日付を作成 lubridate::as_date(), symbol = c("⚾", "🍈", "🎷") # 予定ラベルを指定 ) |> dplyr::left_join( calendar_df |> dplyr::select(date, dow_idx, week_idx), by = "date" ) # 作図用の値を結合 schedule_df
## # A tibble: 3 × 4 ## date symbol dow_idx week_idx ## <date> <chr> <dbl> <dbl> ## 1 2024-02-02 "⚾" 5 1 ## 2 2024-02-19 "\U0001f348" 1 4 ## 3 2024-02-22 "\U0001f3b7" 4 4
日付と文字列をデータフレームに格納する。
calendar_dfの曜日番号と週番号をleft_join()で日付に応じて割り当てる。
スケジュールを表示したカレンダーを作成する。
# スケジュールを重ねたカレンダーを作成 calendar_fill + geom_text(data = schedule_df, mapping = aes(x = dow_idx, y = week_idx, label = symbol), size = 15) # 予定ラベル
作成したグラフ上にgeom_text()で予定ラベルを描画する。
ひと年のカレンダー
次は、1年のカレンダーを作成する。
基本形
作成するカレンダーの年と、週の始まりの曜日を指定する。
# 年を指定 year <- 2023 # 週初めの曜日を指定:(月: 1, ..., 日: 7) dow_start_idx <- 7 # 土曜・日曜の曜日インデックスを設定 dow_sat_idx <- ifelse(dow_start_idx == 7, yes = 7, no = 7 - dow_start_idx) dow_sun_idx <- 8 - dow_start_idx dow_sat_idx; dow_sun_idx
## [1] 7 ## [1] 1
年をyearとして整数を指定する。
「ひと月のカレンダー」のときのコードで週始めの曜日を指定する。
日付データを作成する。
# ひと年の暦データを作成 date_df <- tibble::tibble( # 1日間隔の日付を作成 date = seq( from = paste0(year, "-1-1") |> lubridate::as_date(), # 正月 to = paste0(year, "-12-31") |> lubridate::as_date(), # 大晦日 by = "day" ) ) |> dplyr::mutate( year = lubridate::year(date), # 年ラベル month = lubridate::month(date), # 月ラベル day = lubridate::day(date), # 日ラベル # 作図用の値を作成 dow_idx = lubridate::wday(date, week_start = dow_start_idx), # 曜日番号(列インデックス) dow_label = lubridate::wday(date, week_start = dow_start_idx, label = TRUE) # 曜日ラベル ) |> dplyr::group_by(year, month) |> # インデックスの作成用 dplyr::mutate( cell_idx = day + head(dow_idx, n = 1) - 1, # セルインデックス week_idx = (cell_idx - 1) %/% 7 + 1 # 週番号(行インデックス) ) |> dplyr::ungroup() date_df
## # A tibble: 365 × 8 ## date year month day dow_idx dow_label cell_idx week_idx ## <date> <dbl> <dbl> <int> <dbl> <ord> <dbl> <dbl> ## 1 2023-01-01 2023 1 1 1 日 1 1 ## 2 2023-01-02 2023 1 2 2 月 2 1 ## 3 2023-01-03 2023 1 3 3 火 3 1 ## 4 2023-01-04 2023 1 4 4 水 4 1 ## 5 2023-01-05 2023 1 5 5 木 5 1 ## 6 2023-01-06 2023 1 6 6 金 6 1 ## 7 2023-01-07 2023 1 7 7 土 7 1 ## 8 2023-01-08 2023 1 8 1 日 8 2 ## 9 2023-01-09 2023 1 9 2 月 9 2 ## 10 2023-01-10 2023 1 10 3 火 10 2 ## # … with 355 more rows
指定した年の正月から大晦日までの日付を作成して、データフレームに格納する。
日付ごとに、year()で年列、month()で月列、day()で日にち列を作成する。
「ひと月のカレンダー」のときと同様に、曜日番号と週番号を作成する。ただし、週番号列は、年列と月列でグループ化して、月ごとに作成する。
1年分(12か月分)のカレンダーの原型を作成する。
# 横軸ラベルを作成 dow_label_vec <- lubridate::wday(1:7, week_start = dow_start_idx, label = TRUE) |> # 日本語名 sort() # dow_label_vec <- lubridate::wday(1:7, week_start = dow_start_idx, label = TRUE, abbr = TRUE, locale = "en_US") |> # 英語名の省略形 # sort() # ひと年のカレンダーを作図:(原型) ggplot() + geom_tile(data = date_df, mapping = aes(x = dow_idx, y = week_idx), fill = "white", color = "black") + # 日付セル geom_text(data = date_df, mapping = aes(x = dow_idx, y = week_idx, label = day), size = 5) + # 日付ラベル scale_x_continuous(breaks = 1:7, labels = dow_label_vec) + # 曜日軸 scale_y_reverse(breaks = 1:6) + # 週軸 facet_wrap(month ~ ., labeller = "label_both") + # 月ごとに分割 coord_fixed(ratio = 1) + # アスペクト比 theme(panel.grid.minor = element_blank()) + # 図の体裁 labs(title = paste0(year, "年のカレンダー"), x = "曜日", y = "週")
facet_wrap()にmonth列を指定して、月ごとに分割して描画する。
続いて、祝日とカレンダーの体裁を設定する。
装飾
祝日データを作成する。
# 祝日情報を取得 holiday_vec <- zipangu::jholiday(year = year, lang = "jp") |> unlist() |> lubridate::as_date() # 祝日の暦データを作成 tmp_holiday_df <- tibble::tibble( date = holiday_vec, # 祝日の日付 holiday_label = names(holiday_vec), # 祝日ラベル dow_idx = lubridate::wday(date, week_start = dow_start_idx) # 振替休日の作成用 ) # 祝日ラベルの文字数を指定 threshold <- 5 # 振替休日の暦データを作成 holiday_df <- tmp_holiday_df |> dplyr::filter(dow_idx == dow_sun_idx) |> # 日曜日の祝日を抽出 dplyr::mutate( date = dplyr::case_when( holiday_label == "憲法記念日" ~ date + lubridate::days(3), holiday_label == "みどりの日" ~ date + lubridate::days(2), TRUE ~ date + lubridate::days(1) ), # 日にち holiday_label = "振替休日", # 祝日名 dow_idx = lubridate::wday(date, week_start = dow_start_idx) # 祝日データの結合用 ) |> dplyr::bind_rows(tmp_holiday_df) |> # 祝日の暦データを結合 dplyr::mutate( label_size = dplyr::if_else( condition = nchar(holiday_label) <= threshold, true = "normal", false = "small" ) # ラベルサイズカテゴリ:(日付ラベルと祝日ラベルが重なる対策) ) |> dplyr::select(date, holiday_label, label_size) |> # 日付データの結合用 dplyr::arrange(date) holiday_df
## # A tibble: 17 × 3 ## date holiday_label label_size ## <date> <chr> <chr> ## 1 2023-01-01 元日 normal ## 2 2023-01-02 振替休日 normal ## 3 2023-01-09 成人の日 normal ## 4 2023-02-11 建国記念の日 small ## 5 2023-02-23 天皇誕生日 normal ## 6 2023-03-21 春分の日 normal ## 7 2023-04-29 昭和の日 normal ## 8 2023-05-03 憲法記念日 normal ## 9 2023-05-04 みどりの日 normal ## 10 2023-05-05 こどもの日 normal ## 11 2023-07-17 海の日 normal ## 12 2023-08-11 山の日 normal ## 13 2023-09-18 敬老の日 normal ## 14 2023-09-23 秋分の日 normal ## 15 2023-10-09 スポーツの日 small ## 16 2023-11-03 文化の日 normal ## 17 2023-11-23 勤労感謝の日 small
「ひと月のカレンダー」のときと同様にして、祝日の日付と名前をデータフレームに格納する。また、振替休日のデータフレームを作成する。
グラフサイズなどによっては、祝日名が日付ラベルに重なって表示される。
そこで、文字数の閾値をthresholdとして、祝日名の文字数によってラベルサイズカテゴリを設定する。
日付データに休日データを追加する。
# 装飾用の暦データを作成 calendar_df <- date_df |> dplyr::left_join(holiday_df, by = "date") |> # 祝日データを結合 dplyr::mutate( date_type = dplyr::case_when( !is.na(holiday_label) ~ "holiday", dow_idx == dow_sun_idx ~ "holiday", dow_idx == dow_sat_idx ~ "weekend", TRUE ~ "weekday" ) # 日付カテゴリ ) calendar_df
## # A tibble: 365 × 11 ## date year month day dow_idx dow_label cell_idx week_idx ## <date> <dbl> <dbl> <int> <dbl> <ord> <dbl> <dbl> ## 1 2023-01-01 2023 1 1 1 日 1 1 ## 2 2023-01-02 2023 1 2 2 月 2 1 ## 3 2023-01-03 2023 1 3 3 火 3 1 ## 4 2023-01-04 2023 1 4 4 水 4 1 ## 5 2023-01-05 2023 1 5 5 木 5 1 ## 6 2023-01-06 2023 1 6 6 金 6 1 ## 7 2023-01-07 2023 1 7 7 土 7 1 ## 8 2023-01-08 2023 1 8 1 日 8 2 ## 9 2023-01-09 2023 1 9 2 月 9 2 ## 10 2023-01-10 2023 1 10 3 火 10 2 ## # … with 355 more rows, and 3 more variables: holiday_label <chr>, ## # label_size <chr>, date_type <chr>
「ひと月のカレンダー」のときのコードで処理する。
ファセットラベルの設定用の関数を作成する。
# ラベル用の関数を作成 str_month <- function(string) { paste0(string, "月") # 月の日本語名を出力 # paste0("2000-", string, "-1") |> # 指定した月の適当な日付を作成 # as.Date() |> # 日付型に変換 # lubridate::month(label = TRUE, abbr = FALSE, locale = "en_US") |> # 月の英語名に変換 # as.character() # 文字列型に変換して出力 } str_month(5)
## [1] "5月"
月を示す整数の文字列を受け取り、n月の形(または英語名)にして返す関数を定義する。
または、月名列を用意してグラフの分割に使うと、月名がファセットラベルに表示される。
セルを塗りつぶして休日を示すカレンダーを作成する。
# ひと年のカレンダーを作図:(休日のセル色を変更) calendar_fill <- ggplot() + # geom_tile(data = calendar_df, # mapping = aes(x = dow_idx, y = week_idx), # fill = "white", color = "black") + # 平日セル geom_tile(data = calendar_df, mapping = aes(x = dow_idx, y = week_idx, fill = date_type), color = "black", alpha = 0.1) + # 休日セル geom_text(data = calendar_df, mapping = aes(x = dow_idx-0.4, y = week_idx-0.4, label = day), size = 10, hjust = 0, vjust = 1) + # 日付ラベル geom_text(data = calendar_df, mapping = aes(x = dow_idx+0.45, y = week_idx-0.4, label = holiday_label, size = label_size), hjust = 1, vjust = 1, na.rm = TRUE) + # 祝日ラベル scale_x_continuous(breaks = 1:7, labels = NULL, sec.axis = dup_axis(trans = ~., labels = dow_label_vec)) + # 曜日軸 scale_y_reverse(breaks = 1:6) + # 週軸 scale_fill_manual(breaks = c("weekday", "holiday", "weekend"), values = c("white", "red", "blue")) + # 休日用塗りつぶし色 scale_size_manual(breaks = c("normal", "small"), values = c(4, 3)) + # (日付ラベルと祝日ラベルが重なる対策) facet_wrap(month ~ ., nrow = 3, ncol = 4, labeller = labeller(month = str_month), scales = "free_x") + # 年・月ごとに分割 coord_cartesian(expand = FALSE) + # 描画領域 theme( axis.title = element_blank(), # 軸ラベル axis.text.x = element_text(size = 30), # 横軸目盛ラベル axis.text.y = element_blank(), # 縦軸目盛ラベル axis.ticks = element_blank(), # 軸目盛指示線 panel.grid.major = element_blank(), # 主グリッド線 panel.grid.minor = element_blank(), # 副グリッド線 panel.border = element_rect(fill = NA), # グラフ領域の枠線 panel.background = element_blank(), # グラフ領域の背景 plot.title = element_text(size = 50, face = "bold", hjust = 0.5), # タイトル strip.text = element_text(size = 50, face = "bold"), # ファセットラベルの文字 strip.background = element_blank(), # ファセットラベル領域の背景 strip.placement = "outside", # ファセットラベルの位置 legend.position = "none" # 凡例の位置 ) + # 図の体裁 labs(title = paste0(year, "年"), x = "曜日", y = "週") calendar_fill
facet_wrap()のlabeller引数にlabeller()を使ってファセットラベルを設定できる。
日付の文字色を変更して休日を示すカレンダーを作成する。
# ひと年のカレンダーを作図:(休日のラベル色を変更) calendar_color <- ggplot() + geom_tile(data = calendar_df, mapping = aes(x = dow_idx, y = week_idx), fill = "white", color = "black") + # 日付セル geom_text(data = calendar_df, mapping = aes(x = dow_idx-0.4, y = week_idx-0.4, label = day, color = date_type), size = 10, hjust = 0, vjust = 1) + # 日付ラベル geom_text(data = calendar_df, mapping = aes(x = dow_idx+0.45, y = week_idx-0.4, label = holiday_label, size = label_size), color = "red", hjust = 1, vjust = 1, na.rm = TRUE) + # 祝日ラベル scale_x_continuous(breaks = 1:7, labels = NULL, sec.axis = dup_axis(trans = ~., labels = dow_label_vec)) + # 曜日軸 scale_y_reverse(breaks = 1:6) + # 週軸 scale_color_manual(breaks = c("weekday", "holiday", "weekend"), values = c("black", "red", "blue")) + # 休日用文字色 scale_size_manual(breaks = c("normal", "small"), values = c(4, 3)) + # (日付ラベルと祝日ラベルが重なる対策) facet_wrap(month ~ ., nrow = 3, ncol = 4, labeller = labeller(month = str_month), scales = "free_x") + # 年・月ごとに分割 coord_cartesian(expand = FALSE) + # 描画領域 theme( axis.title = element_blank(), # 軸ラベル axis.text.x = element_text(size = 30), # 横軸目盛ラベル axis.text.y = element_blank(), # 縦軸目盛ラベル axis.ticks = element_blank(), # 軸目盛指示線 panel.grid.major = element_blank(), # 主グリッド線 panel.grid.minor = element_blank(), # 副グリッド線 panel.border = element_rect(fill = NA), # グラフ領域の枠線 #panel.background = element_blank(), # グラフ領域の背景 plot.title = element_text(size = 50, face = "bold", hjust = 0.5), # タイトル strip.text = element_text(size = 50, face = "bold"), # ファセットラベルの文字 strip.background = element_blank(), # ファセットラベル領域の背景 strip.placement = "outside", # ファセットラベルの位置 legend.position = "none" # 凡例の位置 ) + # 図の体裁 labs(title = paste0(year, "年"), x = "曜日", y = "週") calendar_color
これまでと同様にして作図する。
英語表記(また週始めを土曜日)にした場合は次のようになる。
jholiday()のlang引数に"en"を指定すると、英語の祝日名(*** Day)が出力される。が、文字数が増えて描画が面倒だったのでここでは省略する。半角スペースを改行に置き換えるといい感じになる気がする。
以上で、カレンダーを作成できた。次は利用例として、カレンダー上に予定を表示する。
利用例
誕生日データを作成する。
・コード(クリックで展開)
ハロプロデータを読み込む。
# フォルダパスを指定 dir_path <- "data/HP_DB-main/" # 加入・卒業日一覧を読み込み join_df <- readr::read_csv( file = paste0(dir_path, "join.csv"), col_types = readr::cols( memberID = "i", groupID = "i", joinDate = readr::col_date(format = "%Y/%m/%d"), gradDate = readr::col_date(format = "%Y/%m/%d") ) ) |> dplyr::arrange(joinDate, memberID, groupID) # メンバー一覧を読み込み member_df <- readr::read_csv( file = paste0(dir_path, "member.csv"), col_types = readr::cols( memberID = "i", memberName = "c", HPjoinDate = readr::col_date(format = "%Y/%m/%d"), debutDate = readr::col_date(format = "%Y/%m/%d"), HPgradDate = readr::col_date(format = "%Y/%m/%d"), memberKana = "c", birthDate = readr::col_date(format = "%Y/%m/%d") ) ) |> dplyr::select(memberID, memberName, birthDate) |> dplyr::distinct() |> dplyr::arrange(memberID) join_df; member_df
## # A tibble: 517 × 4 ## memberID groupID joinDate gradDate ## <int> <int> <date> <date> ## 1 1 1 1997-09-14 2001-04-15 ## 2 2 1 1997-09-14 2000-01-07 ## 3 3 1 1997-09-14 2005-01-30 ## 4 4 1 1997-09-14 2004-01-25 ## 5 5 1 1997-09-14 1999-04-18 ## 6 7 1 1998-05-03 2003-05-05 ## 7 8 1 1998-05-03 2005-04-14 ## 8 9 1 1998-05-03 2000-05-21 ## 9 2 2 1998-10-18 2000-01-07 ## 10 3 2 1998-10-18 2002-09-23 ## # … with 507 more rows ## # A tibble: 274 × 3 ## memberID memberName birthDate ## <int> <chr> <date> ## 1 1 中澤裕子 1973-06-19 ## 2 2 石黒彩 1978-05-12 ## 3 3 飯田圭織 1981-08-08 ## 4 4 安倍なつみ 1981-08-10 ## 5 5 福田明日香 1984-12-17 ## 6 6 平家みちよ 1979-04-06 ## 7 7 保田圭 1980-12-06 ## 8 8 矢口真里 1983-01-20 ## 9 9 市井紗耶香 1983-12-31 ## 10 10 信田美帆 1972-05-18 ## # … with 264 more rows
グループ加入情報をjoin_df、メンバー情報をmember_dfとしてそれぞれ読み込む。詳しくは「ハロプロの歴史を可視化しようシリーズ：記事一覧 - からっぽのしょこ」の記事を参照のこと。
誕生日データを作成する。
# グループを指定 group_id <- 1 # 予定の暦データを作成 schedule_df <- join_df |> dplyr::filter(groupID == group_id) |> # 指定グループの加入情報を抽出 dplyr::left_join(member_df, by = "memberID") |> # 誕生日情報を結合 dplyr::mutate( month = lubridate::month(birthDate), # 誕生月 day = lubridate::day(birthDate), # 誕生日(日にち) date = paste0(year, "-", as.character(month), "-", as.character(day)) |> lubridate::as_date(), # 指定した年の誕生日 symbol = "🎂" # 記号を指定 ) |> dplyr::select(date, symbol, memberName, month) |> dplyr::left_join( calendar_df |> dplyr::select(date, dow_idx, week_idx), by = "date" ) |> # 作図用の値を結合 dplyr::arrange(date) schedule_df
## # A tibble: 45 × 6 ## date symbol memberName month dow_idx week_idx ## <date> <chr> <chr> <dbl> <dbl> <dbl> ## 1 2023-01-07 "\U0001f382" 石田亜佑美 1 7 1 ## 2 2023-01-11 "\U0001f382" ジュンジュン 1 4 2 ## 3 2023-01-12 "\U0001f382" 光井愛佳 1 5 2 ## 4 2023-01-19 "\U0001f382" 石川梨華 1 5 3 ## 5 2023-01-20 "\U0001f382" 矢口真里 1 6 3 ## 6 2023-02-02 "\U0001f382" 牧野真莉愛 2 5 1 ## 7 2023-02-07 "\U0001f382" 加護亜依 2 3 2 ## 8 2023-02-15 "\U0001f382" 尾形春水 2 4 3 ## 9 2023-02-19 "\U0001f382" 森戸知沙希 2 1 4 ## 10 2023-02-22 "\U0001f382" 横山玲奈 2 4 4 ## # … with 35 more rows
グループIDを指定して、join_dfから所属メンバーのIDを抽出する。メンバーIDに応じて、member_dfから誕生日情報(生年月日)を結合する。
指定した年の誕生日(月日)を作成して、calendar_dfから対応する曜日番号と週番号を結合する。
スケジュールを表示したカレンダーを作成する。
# スケジュールを重ねたカレンダーを作成 calendar_fill + geom_text(data = schedule_df, mapping = aes(x = dow_idx, y = week_idx, label = symbol), size = 15) + # 予定マーク geom_text(data = schedule_df, mapping = aes(x = dow_idx, y = week_idx+0.45, label = memberName), size = 5, vjust = 0) # 予定ラベル
「ひと月のカレンダー」のときと同様に、予定を表すマークとラベルを描画する。
任意の期間のカレンダー
最後は、期間を指定して(1日から始まらない場合の)カレンダーを作成する。
基本形
作成するカレンダーの期間と、週の始まりの曜日を指定する。
# 開始日を指定 date_from <- "2021-05-05" |> lubridate::as_date() # 終了日を指定 date_to <- "2023-05-04" |> lubridate::as_date() # 週初めの曜日を指定:(月: 1, ..., 日: 7) dow_start_idx <- 7 # 土曜・日曜の曜日インデックスを設定 dow_sat_idx <- ifelse(dow_start_idx == 7, yes = 7, no = 7 - dow_start_idx) dow_sun_idx <- 8 - dow_start_idx dow_sat_idx; dow_sun_idx
## [1] 7 ## [1] 1
期間の開始日をdate_from、終了日をdate_toとして日付型の値を指定する。
「ひと月のカレンダー」のときのコードで週始めの曜日を指定する。
日付データを作成する。
# 任意期間の暦データを作成 date_df <- tibble::tibble( # 1日間隔の日付を作成 date = seq( from = date_from |> lubridate::floor_date(unit = "month"), # 開始日の月の初日 to = date_to, # 終了日 by = "day" ) ) |> dplyr::mutate( year = lubridate::year(date), # 年ラベル month = lubridate::month(date), # 月ラベル day = lubridate::day(date), # 日ラベル # 作図用の値を作成 dow_idx = lubridate::wday(date, week_start = dow_start_idx), # 曜日番号(列インデックス) dow_label = lubridate::wday(date, week_start = dow_start_idx, label = TRUE) # 曜日ラベル ) |> dplyr::group_by(year, month) |> # インデックスの作成用 dplyr::mutate( cell_idx = dplyr::if_else( condition = date >= date_from, # 指定期間の場合 true = day + head(dow_idx, n = 1) - 1, false = NA_real_ ), # セルインデックス week_idx = dplyr::if_else( condition = date >= date_from, # 指定期間の場合 true = (cell_idx - 1) %/% 7 + 1, false = NA_real_ ) # 週番号(行インデックス) ) |> dplyr::ungroup() |> dplyr::filter(date >= date_from) # 期間外のデータを除去 date_df
## # A tibble: 730 × 8 ## date year month day dow_idx dow_label cell_idx week_idx ## <date> <dbl> <dbl> <int> <dbl> <ord> <dbl> <dbl> ## 1 2021-05-05 2021 5 5 4 水 11 2 ## 2 2021-05-06 2021 5 6 5 木 12 2 ## 3 2021-05-07 2021 5 7 6 金 13 2 ## 4 2021-05-08 2021 5 8 7 土 14 2 ## 5 2021-05-09 2021 5 9 1 日 15 3 ## 6 2021-05-10 2021 5 10 2 月 16 3 ## 7 2021-05-11 2021 5 11 3 火 17 3 ## 8 2021-05-12 2021 5 12 4 水 18 3 ## 9 2021-05-13 2021 5 13 5 木 19 3 ## 10 2021-05-14 2021 5 14 6 金 20 3 ## # … with 720 more rows
開始日の月初から終了日までの日付を作成して、データフレームに格納する。期間前の日付は、週番号の計算に用いる。
「ひと年のカレンダー」のときと同様に、年列・月列と曜日番号列・週番号列を作成する。ただし、開始日以前のデータについては、インデックス(数値型の)欠損値にするか、インデックスの計算後に取り除く。この例では、両方の処理を行っている。
月ごとのカレンダーの原型を作成する。
# 横軸ラベルを作成 dow_label_vec <- lubridate::wday(1:7, week_start = dow_start_idx, label = TRUE) |> # 日本語名 sort() #dow_label_vec <- lubridate::wday(1:7, week_start = dow_start_idx, label = TRUE, abbr = TRUE, locale = "en_US") |> # 英語名の省略形 # sort() # タイトル用の文字列を作成 title_label <- paste0( format(date_from, format = "%Y年%m月%d日"), "から", format(date_to, format = "%Y年%m月%d日"), "までのカレンダー" ) # 任意期間のカレンダーを作図:(原型) ggplot() + geom_tile(data = date_df, mapping = aes(x = dow_idx, y = week_idx), fill = "white", color = "black") + # 日付セル geom_text(data = date_df, mapping = aes(x = dow_idx, y = week_idx, label = day), size = 5) + # 日付ラベル scale_x_continuous(breaks = 1:7, labels = dow_label_vec) + # 曜日軸 scale_y_reverse(breaks = 1:6) + # 週軸 coord_fixed(ratio = 1) + # アスペクト比 facet_wrap(year ~ month, labeller = "label_both") + # 月ごとに分割 #facet_grid(year ~ month, labeller = "label_both", switch = "y") + # 年・月ごとに分割 theme(panel.grid.minor = element_blank()) + # 図の体裁 labs(title = title_label, x = "曜日", y = "週")
facet_wrap()で月ごとに、またはfacet_grid()で年と月ごとに分割して描画する。
続いて、祝日とカレンダーの体裁を設定する。
装飾
祝日データを取得する。
# 祝日情報を取得 holiday_vec <- zipangu::jholiday( year = lubridate::year(date_from):lubridate::year(date_to), lang = "jp" ) |> unlist() |> lubridate::as_date() head(holiday_vec)
## 元日1 元日2 元日3 成人の日1 成人の日2 成人の日3 ## "2021-01-01" "2022-01-01" "2023-01-01" "2021-01-11" "2022-01-10" "2023-01-09"
jholiday()のyear引数に期間内の年を指定する。複数年を指定した場合は、祝日名の後に通し番号が付く。
祝日データを格納する。
# 祝日の暦データを作成 tmp_holiday_df <- tibble::tibble( date = holiday_vec, # 祝日の日付 holiday_label = holiday_vec |> names() |> stringr::str_remove(pattern = "\\d"), # 祝日ラベル dow_idx = lubridate::wday(date, week_start = dow_start_idx) # 振替休日の作成用 ) |> dplyr::filter(dplyr::between(date, left = date_from, right = date_to)) |> # 期間内のデータを抽出 dplyr::arrange(date) tmp_holiday_df
## # A tibble: 32 × 3 ## date holiday_label dow_idx ## <date> <chr> <dbl> ## 1 2021-05-05 こどもの日 4 ## 2 2021-07-22 海の日 5 ## 3 2021-07-23 スポーツの日 6 ## 4 2021-08-08 山の日 1 ## 5 2021-09-20 敬老の日 2 ## 6 2021-09-23 秋分の日 5 ## 7 2021-11-03 文化の日 4 ## 8 2021-11-23 勤労感謝の日 3 ## 9 2022-01-01 元日 7 ## 10 2022-01-10 成人の日 2 ## # … with 22 more rows
str_remove()で通し番号を取り除いて、祝日名を格納する。
指定期間のデータをbetween()で抽出する。
「ひと月のカレンダー」のときのコードで、振替休日を追加して、カレンダーの作図用のデータを作成する。
# 確認
calendar_df
## # A tibble: 730 × 10 ## date year month day dow_idx dow_label cell_idx week_idx ## <date> <dbl> <dbl> <int> <dbl> <ord> <dbl> <dbl> ## 1 2021-05-05 2021 5 5 4 水 11 2 ## 2 2021-05-06 2021 5 6 5 木 12 2 ## 3 2021-05-07 2021 5 7 6 金 13 2 ## 4 2021-05-08 2021 5 8 7 土 14 2 ## 5 2021-05-09 2021 5 9 1 日 15 3 ## 6 2021-05-10 2021 5 10 2 月 16 3 ## 7 2021-05-11 2021 5 11 3 火 17 3 ## 8 2021-05-12 2021 5 12 4 水 18 3 ## 9 2021-05-13 2021 5 13 5 木 19 3 ## 10 2021-05-14 2021 5 14 6 金 20 3 ## # … with 720 more rows, and 2 more variables: holiday_label <chr>, ## # date_type <chr>
ファセットラベルの設定用の関数を作成する。
# ラベル用の関数を作成 str_year <- function(string) { paste0(string, "年") } str_month <- function(string) { paste0(string, "月") } str_year(lubridate::year(date_from)); str_month(lubridate::month(date_from))
## [1] "2021年" ## [1] "5月"
年を受け取りm年を返す関数と、月を受け取りn月を返す関数を定義する。英語名の月を表示する場合は「ひと年のカレンダー」のときの関数を使う。
セルを塗りつぶして休日を示すカレンダーを作成する。
# 任意期間のカレンダーを作図:(休日のラベル色を変更) calendar_fill <- ggplot() + geom_tile(data = calendar_df, mapping = aes(x = dow_idx, y = week_idx), fill = "white", color = "black") + # 平日セル geom_tile(data = calendar_df, mapping = aes(x = dow_idx, y = week_idx, fill = date_type), color = "black", alpha = 0.1) + # 休日セル geom_text(data = calendar_df, mapping = aes(x = dow_idx-0.4, y = week_idx-0.4, label = day), size = 3, hjust = 0, vjust = 1) + # 日付ラベル scale_x_continuous(breaks = 1:7, labels = dow_label_vec) + # 曜日軸 scale_y_reverse(breaks = 1:6) + # 週軸 scale_fill_manual(breaks = c("weekday", "holiday", "weekend"), values = c("white", "red", "blue")) + # 休日用塗りつぶし色 facet_grid(year ~ month, labeller = labeller(year = str_year, month = str_month), switch = "y") + # 年・月ごとに分割 coord_fixed(ratio = 1, expand = FALSE) + # 描画領域 theme( axis.title = element_blank(), # 軸ラベル axis.text.x = element_text(size = 10), # 横軸目盛ラベル axis.text.y = element_blank(), # 縦軸目盛ラベル axis.ticks = element_blank(), # 軸目盛指示線 #panel.grid.major = element_blank(), # 主グリッド線 panel.grid.minor = element_blank(), # 副グリッド線 panel.border = element_rect(fill = NA), # グラフ領域の枠線 #panel.background = element_blank(), # グラフ領域の背景 strip.text = element_text(size = 15, face = "bold"), # ファセットラベルの文字 strip.background = element_blank(), # ファセットラベル領域の背景 strip.placement = "outside", # ファセットラベルの位置 legend.position = "none" # 凡例の位置 ) + # 図の体裁 labs(x = "曜日", y = "週") calendar_fill
これまでと同様にして作図する。
日付の文字色を変更して休日を示すカレンダーを作成する。
# 任意期間のカレンダーを作図:(休日のラベル色を変更) calendar_color <- ggplot() + geom_tile(data = calendar_df, mapping = aes(x = dow_idx, y = week_idx), fill = "white", color = "black") + # 日付セル geom_text(data = calendar_df, mapping = aes(x = dow_idx-0.4, y = week_idx-0.4, label = day, color = date_type), size = 3, hjust = 0, vjust = 1) + # 日付ラベル scale_x_continuous(breaks = 1:7, labels = dow_label_vec) + # 曜日軸 scale_y_reverse(breaks = 1:6) + # 週軸 scale_color_manual(breaks = c("weekday", "holiday", "weekend"), values = c("black", "red", "blue")) + # 休日用文字色 facet_grid(year ~ month, labeller = labeller(year = str_year, month = str_month), switch = "y") + # 年・月ごとに分割 coord_fixed(ratio = 1, expand = FALSE) + # 描画領域 theme( axis.title = element_blank(), # 軸ラベル axis.text.x = element_text(size = 10), # 横軸目盛ラベル axis.text.y = element_blank(), # 縦軸目盛ラベル axis.ticks = element_blank(), # 軸目盛指示線 #panel.grid.major = element_blank(), # 主グリッド線 panel.grid.minor = element_blank(), # 副グリッド線 panel.border = element_rect(fill = NA), # グラフ領域の枠線 #panel.background = element_blank(), # グラフ領域の背景 strip.text = element_text(size = 15, face = "bold"), # ファセットラベルの文字 strip.background = element_blank(), # ファセットラベル領域の背景 strip.placement = "outside", # ファセットラベルの位置 legend.position = "none" # 凡例の位置 ) + # 図の体裁 labs(x = "曜日", y = "週") calendar_color
以上で、カレンダーを作成できた。次は利用例として、カレンダー上にヒートマップを表示する。
利用例
ブログ記事の投稿日データを作成する。
・コード(クリックで展開)
記事URLデータを読み込む。
# ファイルパスを指定 file_path <- "data/url.rds" # URLデータを読み込み url_vec <- readRDS(file = file_path) head(url_vec)
## [1] "https://www.anarchive-beta.com/entry/2018/12/01/164452" ## [2] "https://www.anarchive-beta.com/entry/2018/12/02/233840" ## [3] "https://www.anarchive-beta.com/entry/2018/12/03/234525" ## [4] "https://www.anarchive-beta.com/entry/2018/12/04/234831" ## [5] "https://www.anarchive-beta.com/entry/2018/12/05/234343" ## [6] "https://www.anarchive-beta.com/entry/2018/12/06/235110"
詳しくは「Chapter 6：ブログの投稿数をヒートマップで可視化してみた【R登山本】 - からっぽのしょこ」を参照のこと。
投稿日データを作成する。
# ブログのURLを指定 blog_url <- "https://www.anarchive-beta.com/" # 投稿日を抽出 date_vec <- url_vec |> stringr::str_remove(pattern = paste0(blog_url, "entry/")) |> # 日時を示す文字列を抽出 lubridate::as_datetime(tz = "Asia/Tokyo") |> # タイムゾーンを設定 lubridate::as_date() |> sort() head(date_vec)
## [1] "2018-12-01" "2018-12-02" "2018-12-03" "2018-12-04" "2018-12-05" ## [6] "2018-12-06"
記事URLからベースとなるブログURLなどの文字列を取り除き、投稿時間を示す文字列を作成する。
as_datetime()で日時型に変換してタイムゾーンを設定して、as_date()で日付型に変換する。
カレンダーの期間を設定する。
# 期間を設定 date_from <- min(date_vec) #date_to <- max(date_vec) date_to <- lubridate::today() date_from; date_to
## [1] "2018-12-01" ## [1] "2023-06-02"
最初の投稿日をdate_from、最新の投稿日または現在の日付をdate_toとする。
「基本形」と「装飾」のときのコードで、カレンダーの作図用のデータを作成する。
# 確認
calendar_df
## # A tibble: 1,645 × 10 ## date year month day dow_idx dow_label cell_idx week_idx ## <date> <dbl> <dbl> <int> <dbl> <ord> <dbl> <dbl> ## 1 2018-12-01 2018 12 1 7 土 7 1 ## 2 2018-12-02 2018 12 2 1 日 8 2 ## 3 2018-12-03 2018 12 3 2 月 9 2 ## 4 2018-12-04 2018 12 4 3 火 10 2 ## 5 2018-12-05 2018 12 5 4 水 11 2 ## 6 2018-12-06 2018 12 6 5 木 12 2 ## 7 2018-12-07 2018 12 7 6 金 13 2 ## 8 2018-12-08 2018 12 8 7 土 14 2 ## 9 2018-12-09 2018 12 9 1 日 15 3 ## 10 2018-12-10 2018 12 10 2 月 16 3 ## # … with 1,635 more rows, and 2 more variables: holiday_label <chr>, ## # date_type <chr>
記事の投稿数を集計する。
# 記事投稿数を集計 post_df <- tibble::tibble( date = date_vec ) |> dplyr::count(date, name = "post") |> # 投稿数をカウント |> dplyr::left_join( calendar_df |> dplyr::select(date, year, month, dow_idx, week_idx), by = "date" ) |> # 作図用の値を結合 dplyr::arrange(date) post_df
## # A tibble: 484 × 6 ## date post year month dow_idx week_idx ## <date> <int> <dbl> <dbl> <dbl> <dbl> ## 1 2018-12-01 1 2018 12 7 1 ## 2 2018-12-02 1 2018 12 1 2 ## 3 2018-12-03 1 2018 12 2 2 ## 4 2018-12-04 1 2018 12 3 2 ## 5 2018-12-05 1 2018 12 4 2 ## 6 2018-12-06 1 2018 12 5 2 ## 7 2018-12-08 1 2018 12 7 2 ## 8 2018-12-09 1 2018 12 1 3 ## 9 2018-12-30 1 2018 12 1 6 ## 10 2019-01-10 1 2019 1 5 2 ## # … with 474 more rows
重複する日付をcount()でカウントして投稿数とする。
投稿日に応じて、calendar_dfから曜日番号と週番号を結合する。
記事投稿数のヒートマップを作成する。
# 横軸ラベルを作成 dow_label_vec <- lubridate::wday(1:7, week_start = dow_start_idx, label = TRUE) # 日本語名 # タイトル用の文字列を作成 title_label <- paste0( format(date_from, format = "%Y年%m月%d日"), "から", format(date_to, format = "%Y年%m月%d日"), "のブログ記事投稿数" ) # 投稿数のヒートマップ ggplot() + geom_tile(data = calendar_df, mapping = aes(x = dow_idx, y = week_idx), fill = "white", color = "black") + # 日付セル geom_tile(data = post_df, mapping = aes(x = dow_idx, y = week_idx, fill = post), color = "black") + # 投稿数ヒートマップ geom_text(data = post_df, mapping = aes(x = dow_idx, y = week_idx, label = post), size = 5) + # 投稿数ラベル geom_label(data = calendar_df, mapping = aes(x = dow_idx-0.5, y = week_idx-0.5, label = stringr::str_pad(day, side = "left", width = 2, pad = " "), color = date_type), size = 3.5, hjust = 0, vjust = 1, label.padding = unit(0.1, units = "line"), na.rm = TRUE, show.legend = FALSE) + # 日付ラベル scale_x_continuous(breaks = 1:7, labels = dow_label_vec) + # 曜日軸 scale_y_reverse(breaks = 1:6) + # 週軸 scale_color_manual(breaks = c("weekday", "holiday", "weekend"), values = c("black", "red", "blue")) + # 休日用文字色 scale_fill_gradient2(low = "gray", mid = "white", high = "green") + # 投稿数グラデーション facet_grid(year ~ month, labeller = labeller(year = str_year, month = str_month), switch = "y") + # 年・月ごとに分割 coord_fixed(ratio = 1, expand = FALSE) + # 描画領域 theme( axis.title = element_blank(), # 軸ラベル axis.text.x = element_text(size = 30), # 横軸目盛ラベル axis.text.y = element_blank(), # 縦軸目盛ラベル axis.ticks = element_blank(), # 軸目盛指示線 #panel.grid.major = element_blank(), # 主グリッド線 panel.grid.minor = element_blank(), # 副グリッド線 panel.border = element_rect(fill = NA), # グラフ領域の枠線 #panel.background = element_blank(), # グラフ領域の背景 plot.title = element_text(size = 50, face = "bold", hjust = 0.5), # タイトル plot.subtitle = element_text(size = 30, face = "bold", hjust = 1), # サブタイトル strip.text = element_text(size = 30, face = "bold"), # ファセットラベルの文字 strip.background = element_blank(), # ファセットラベル領域の背景 strip.placement = "outside" # ファセットラベルの位置 ) + # 図の体裁 labs(title = title_label, subtitle = paste0("総記事数:", sum(post_df[["post"]])), fill = "投稿数", x = "曜日", y = "週")
カレンダーのグラフ上に、geom_tile()で投稿数に応じて色付けするヒートマップを描画する。
この記事では、カレンダーを作成した。
参考
zipanguパッケージについてはこの記事を参照してください。祝日の他にも日本語の情報を扱うためのパッケージです。
おわりに
カレンダーだぜ！ggplot2だよ！
カレンダーが必要だったわけではなく、2つの日付間の経過期間を計算したかったのですが、日付計算がややこしい上に計算結果を確認するのも難しく、アレコレ悩んでたらカレンダーを作ることになりました(?)詳しくは次の記事を覗いてみてください。
内容的にはRアドベントカレンダーのネタに使いたかったのですが、あと半年は待てなかったので上げてしまいました。ブログは勢いが大事なので(私の場合)。
最後に、先日公開された新曲を聴きましょう。
新メンバーも加入してハローの未来は明るい！
【次の内容】
