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(fastDummies)
## Thank you for using fastDummies!
## To acknowledge our work, please cite the package:
## Kaplan, J. & Schlegel, B. (2023). fastDummies: Fast Creation of Dummy (Binary) Columns and Rows from Categorical Variables. Version 1.7.1. URL: https://github.com/jacobkap/fastDummies, https://jacobkap.github.io/fastDummies/.
# ファイルの読み込み
production_missing_category <- read_parquet("https://github.com/ghmagazine/awesomebook_v2/raw/main/data/production_missing_category.parquet")
customer                    <- read_parquet("https://github.com/ghmagazine/awesomebook_v2/raw/main/data/customer.parquet")

11-1 カテゴリ型への変換

RでPythonのカテゴリ型に対応するのは因子型

Q: 性別をカテゴリに適したデータ型に変換

Awesome

customer |>
  mutate(sex_cat = as.factor(sex)) |>
  dplyr::select(sex, sex_cat)
## # A tibble: 500,000 × 2
##    sex   sex_cat
##    <chr> <fct>  
##  1 <NA>  <NA>   
##  2 M     M      
##  3 M     M      
##  4 M     M      
##  5 F     F      
##  6 F     F      
##  7 F     F      
##  8 F     F      
##  9 <NA>  <NA>   
## 10 F     F      
## # ℹ 499,990 more rows

11-2 カテゴリ値の欠損処理

Q:k-NNによるカテゴリ値の補完

Awesome

# （1） 欠損していないデータと欠損しているデータを分割
df_notnull <- production_missing_category |>
  dplyr::filter(!is.na(type))

df_null <- production_missing_category |>
  dplyr::filter(is.na(type))

# （2） k-NNモデルのオブジェクトを作成
knn <- trainControl(method = "none")
cols <- c("length", "thickness")

# （3） 欠損していないデータを用いてk-NNモデルを学習
knn_model <- train(
  type ~ .,
  data = df_notnull |> select(type, all_of(cols)),
  method = "knn",
  trControl = knn,
  tuneGrid = expand.grid(k = 3)
)

# （4） 欠損しているデータを用いて予測値を計算
pred <- predict(
  knn_model,
  df_null |> select(all_of(cols))
  )

# （5） 欠損していないデータと欠損補完したデータを結合
bind_rows(
  df_notnull,
  df_null |>
    mutate(type = pred)
  )
## # A tibble: 1,000 × 4
##    type  length thickness fault_flg
##    <chr>  <dbl>     <dbl> <lgl>    
##  1 E      274.      40.2  FALSE    
##  2 D       86.3     16.9  FALSE    
##  3 E      124.       1.02 FALSE    
##  4 B      176.      16.4  FALSE    
##  5 B      245.      29.1  FALSE    
##  6 B      226.      39.8  FALSE    
##  7 C      332.      16.8  FALSE    
##  8 A      201.      12.2  FALSE    
##  9 E      168.       1.27 FALSE    
## 10 D      218.      33.1  FALSE    
## # ℹ 990 more rows

11-3 カテゴリ値の集約

Q: 年齢カテゴリの集約

Awesome

as.ordered()で順序付き因子型に。

customer |>
  mutate(
    age_cat = if_else(age >= 60, 6, as.integer(age / 10)) |>
      as.ordered()
    ) 
## # A tibble: 500,000 × 9
##    customer_id name       age sex   address_prefecture address_city address_town
##          <int> <chr>    <int> <chr> <chr>              <chr>        <chr>       
##  1           1 山田 裕…    75 <NA>  岐阜県             岐阜市       鷺山清洲町  
##  2           2 藤井 稔     83 M     大阪府             豊能郡能勢町 地黄        
##  3           3 青木 太…    62 M     佐賀県             佐賀市       本庄町袋    
##  4           4 渡辺 裕…    28 M     福島県             喜多方市     豊川町高堂太
##  5           5 渡辺 明…    62 F     兵庫県             西宮市       津門西口町  
##  6           6 西村 知…    66 F     秋田県             仙北郡美郷町 佐野        
##  7           7 斉藤 七…    34 F     高知県             長岡郡大豊町 日浦        
##  8           8 村上 明…    81 F     北海道             夕張市       南部青葉町  
##  9           9 鈴木 直…    57 <NA>  京都府             京都市左京区 上高野石田町
## 10          10 佐藤 舞     59 F     神奈川県           伊勢原市     下糟屋      
## # ℹ 499,990 more rows
## # ℹ 2 more variables: address_zipcode <chr>, age_cat <ord>

11-4 カテゴリ値の組み合わせ

Q: 性別と年齢のカテゴリの組み合わせ

Awesome

customer |>
  mutate(sex_age_cat = as.factor(paste(coalesce(sex, "unknown"), as.integer(age / 10), sep = "_")))
## # A tibble: 500,000 × 9
##    customer_id name       age sex   address_prefecture address_city address_town
##          <int> <chr>    <int> <chr> <chr>              <chr>        <chr>       
##  1           1 山田 裕…    75 <NA>  岐阜県             岐阜市       鷺山清洲町  
##  2           2 藤井 稔     83 M     大阪府             豊能郡能勢町 地黄        
##  3           3 青木 太…    62 M     佐賀県             佐賀市       本庄町袋    
##  4           4 渡辺 裕…    28 M     福島県             喜多方市     豊川町高堂太
##  5           5 渡辺 明…    62 F     兵庫県             西宮市       津門西口町  
##  6           6 西村 知…    66 F     秋田県             仙北郡美郷町 佐野        
##  7           7 斉藤 七…    34 F     高知県             長岡郡大豊町 日浦        
##  8           8 村上 明…    81 F     北海道             夕張市       南部青葉町  
##  9           9 鈴木 直…    57 <NA>  京都府             京都市左京区 上高野石田町
## 10          10 佐藤 舞     59 F     神奈川県           伊勢原市     下糟屋      
## # ℹ 499,990 more rows
## # ℹ 2 more variables: address_zipcode <chr>, sex_age_cat <fct>

11-5 カテゴリ値の数値化

Q: 性別のone-hotエンコーディング

caretパッケージやtidymodelsパッケージでもいいが、fastDummiesパッケージが便利。

Awesome

customer |>
  mutate(sex = replace_na(sex, "unknown")) |>
  dummy_cols(select_columns = "sex", remove_most_frequent_dummy = TRUE)
## # A tibble: 500,000 × 11
##    customer_id name       age sex   address_prefecture address_city address_town
##          <int> <chr>    <int> <chr> <chr>              <chr>        <chr>       
##  1           1 山田 裕…    75 unkn… 岐阜県             岐阜市       鷺山清洲町  
##  2           2 藤井 稔     83 M     大阪府             豊能郡能勢町 地黄        
##  3           3 青木 太…    62 M     佐賀県             佐賀市       本庄町袋    
##  4           4 渡辺 裕…    28 M     福島県             喜多方市     豊川町高堂太
##  5           5 渡辺 明…    62 F     兵庫県             西宮市       津門西口町  
##  6           6 西村 知…    66 F     秋田県             仙北郡美郷町 佐野        
##  7           7 斉藤 七…    34 F     高知県             長岡郡大豊町 日浦        
##  8           8 村上 明…    81 F     北海道             夕張市       南部青葉町  
##  9           9 鈴木 直…    57 unkn… 京都府             京都市左京区 上高野石田町
## 10          10 佐藤 舞     59 F     神奈川県           伊勢原市     下糟屋      
## # ℹ 499,990 more rows
## # ℹ 4 more variables: address_zipcode <chr>, sex_F <int>, sex_NA <int>,
## #   sex_unknown <int>

以上です。

第12章 日時

第10章 数値

Top