library(conflicted)
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.5
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ ggplot2   3.5.1     ✔ tibble    3.2.1
## ✔ lubridate 1.9.3     ✔ tidyr     1.3.1
## ✔ purrr     1.0.2
library(arrow)
library(caret)
## 要求されたパッケージ lattice をロード中です
library(rsample)
library(yardstick)
library(withr)
library(doParallel)
## 要求されたパッケージ foreach をロード中です
## 
## 次のパッケージを付け加えます: 'foreach'
## 
## 以下のオブジェクトは 'package:purrr' からマスクされています:
## 
##     accumulate, when
## 
## 要求されたパッケージ iterators をロード中です
## 要求されたパッケージ parallel をロード中です
# ファイルの読み込み
production    <- read_parquet("https://github.com/ghmagazine/awesomebook_v2/raw/main/data/production.parquet")
monthly_index <- read_parquet("https://github.com/ghmagazine/awesomebook_v2/raw/main/data/monthly_index.parquet")
reservation   <- read_parquet("https://github.com/ghmagazine/awesomebook_v2/raw/main/data/reservation.parquet")

この章はtidymodelsパッケージで書くのがモダンかと思いますが、個人的にまだこなれていないと感じる部分もあるのでcaretパッケージとのチャンポンになっています。

8-1 k-分割交差検証のためのデータ分割

Q: k-分割交差検証のためのデータ分割

Awesome

# （1）ホールドアウト検証用のデータ分割
initial_split <- production |>
  mutate(fault_flg = as.factor(fault_flg)) |> #目的変数を因子型にしておく
  initial_split(prop = 0.8) |>
  with_seed(71, code = _) 

train_data <- initial_split |>
  training()

test_data <- initial_split |>
  testing()

# （2）交差検証用のデータ分割方法の定義と分割数分の繰り返し処理
# ランダムフォレストでの例

# detectCores() #コア数確認

cl <- makePSOCKcluster(4)
registerDoParallel(cl)

model_ranger <- train(
  fault_flg ~ ., 
  data = train_data,
  method = "ranger", 
  trControl = trainControl(method = "cv", number = 10)
  ) |>
  with_seed(71, code = _) 

stopCluster(cl)

# 検証データで評価
pred_rf <- model_ranger |>
  predict(newdata = test_data)

accuracy_vec(test_data$fault_flg, pred_rf)
## [1] 0.955

8-2 時間要素を含むデータの交差検証のためのデータ分割

Q: 時間を考慮した交差検証用データの分割

Awesome

# （1）データを時系列順にソート
train_data <- monthly_index |>
  arrange(year_month)

# （2）時系列交差検証にデータ分割
train_data |>
  rolling_origin(
    initial = 24,
    assess = 12,
    cumulative = FALSE,
    skip = 12
    )
## # Rolling origin forecast resampling 
## # A tibble: 7 × 2
##   splits          id    
##   <list>          <chr> 
## 1 <split [24/12]> Slice1
## 2 <split [24/12]> Slice2
## 3 <split [24/12]> Slice3
## 4 <split [24/12]> Slice4
## 5 <split [24/12]> Slice5
## 6 <split [24/12]> Slice6
## 7 <split [24/12]> Slice7

8-3 グループがあるデータの交差検証のためのデータ分割

Q: グループを考慮した交差検証用データの分割

Awesome

reservation |>
  group_vfold_cv(group = "hotel_id", v = 10) |>
  with_seed(71, code = _)
## # Group 10-fold cross-validation 
## # A tibble: 10 × 2
##    splits                   id        
##    <list>                   <chr>     
##  1 <split [1796235/203765]> Resample01
##  2 <split [1792226/207774]> Resample02
##  3 <split [1799799/200201]> Resample03
##  4 <split [1800966/199034]> Resample04
##  5 <split [1799086/200914]> Resample05
##  6 <split [1805595/194405]> Resample06
##  7 <split [1801862/198138]> Resample07
##  8 <split [1810612/189388]> Resample08
##  9 <split [1792544/207456]> Resample09
## 10 <split [1801075/198925]> Resample10

8-4 層化k-分割交差検証のためのデータ分割

Q: 層化k-分割交差検証用データの分割

Awesome

reservation |>
  vfold_cv(v = 10, strata = "status") |>
  with_seed(71, code = _)
## #  10-fold cross-validation using stratification 
## # A tibble: 10 × 2
##    splits                   id    
##    <list>                   <chr> 
##  1 <split [1799999/200001]> Fold01
##  2 <split [1800000/200000]> Fold02
##  3 <split [1800000/200000]> Fold03
##  4 <split [1800000/200000]> Fold04
##  5 <split [1800000/200000]> Fold05
##  6 <split [1800000/200000]> Fold06
##  7 <split [1800000/200000]> Fold07
##  8 <split [1800000/200000]> Fold08
##  9 <split [1800000/200000]> Fold09
## 10 <split [1800001/199999]> Fold10

以上です。

第9章 整形

第7章 結合

Top