การสร้างฟีเจอร์ใหม่โดยใช้ความรู้เฉพาะด้าน

Feature Engineering in R

Jorge Zazueta

Research Professor and Head of the Modeling Group at the School of Economics, UASLP

ความสำคัญของความรู้เฉพาะด้าน

ความรู้เฉพาะด้านช่วยให้ระบุและสร้างฟีเจอร์ที่เกี่ยวข้องและมีประโยชน์สำหรับโมเดลหรืองานที่ต้องการได้

Feature engineering คือการสร้างฟีเจอร์ input ใหม่จากฟีเจอร์ที่มีอยู่

ตัวอย่างความรู้เฉพาะด้าน:

การเงิน: ปัจจัยชี้ขาดของการล้มละลาย
การแพทย์: โรคประจำตัวที่เกี่ยวข้องกับการรักษาเฉพาะด้าน
การตลาด: ลักษณะเด่นที่แยกแยะกลุ่มผู้บริโภค

การสร้างตัวแปรจากประสบการณ์เชิงวิชาชีพ

เราต้องการพยากรณ์การยกเลิกการจองโรงแรมจาก feature vector ต่อไปนี้:

features <- 
c("IsCanceled", "LeadTime",
  "arrival_date",
  "StaysInWeekendNights",
  "StaysInWeekNights",
  "PreviousCancellations",
  "PreviousBookingsNotCanceled",
  "ReservedRoomType",
  "AssignedRoomType","BookingChanges",
  "DepositType","CustomerType",
  "ADR","TotalOfSpecialRequests")

ฟีเจอร์จากข้อมูลดิบ

สามารถสร้างฟีเจอร์ที่มีประโยชน์จากarrival_dateได้

วันที่เดินทางมาถึงสามารถแยกย่อยเป็นวันในสัปดาห์ สัปดาห์ เดือน และวันหยุด

แต่วิธีนี้จะยุ่งยากขึ้นเรื่อย ๆ จึงต้องทำให้เป็นอัตโนมัติ!

เฟรมเวิร์ก tidymodels

เราจะใช้ workflow ที่อิงกับ tidymodels ซึ่งเป็นชุดแพ็กเกจสำหรับการสร้างโมเดลและ machine learning ตามหลักการของ tidyverse (1) โดยเน้นที่ feature engineering

tidymodels workflow อย่างง่าย: โหลดข้อมูล ประกาศโมเดล แบ่งข้อมูล ตั้งค่า recipe รวมใน workflow ฟิต workflow และประเมินประสิทธิภาพ

ศึกษาเพิ่มเติมได้ที่ www.tidymodels.org

¹ [หลักการออกแบบของ Tidyverse](https://design.tidyverse.org/unifying-principles.html)

เตรียมข้อมูลสำหรับการวิเคราะห์

เริ่มต้นด้วยการเตรียมข้อมูลให้พร้อม

cancelations <- 
  cancelations %>% 
  mutate(across(where(is_character),as.factor))

set.seed(123)
split <- cancellations %>% 
    initial_split(
    strata = "IsCanceled")
train <- training(split)
test <- testing(split)

ใช้พารามิเตอร์ prop เพื่อปรับสัดส่วนการแบ่งข้อมูล train/test (ค่าเริ่มต้นคือ 3/4)

initial_split(data, prop = 3/4, strata = NULL)

ตรวจสอบว่าชุดข้อมูล train และ test มีสัดส่วนการยกเลิกการจองที่ใกล้เคียงกัน

train %>% 
  select(IsCanceled) %>% table() %>% 
  prop.table()

IsCanceled
        0         1 
0.5826946 0.4173054

test %>% 
  select(IsCanceled) %>% table() %>% 
  prop.table()

IsCanceled
        0         1 
0.5827788 0.4172212

การสร้าง workflow

ประกาศโมเดล

lr_model <- logistic_reg()

สร้าง recipe

lr_recipe <- 
  recipe(IsCanceled ~., data = train) %>%
  update_role(Agent, new_role = "ID" ) %>%
  step_date(arrival_date, 
      features = c("dow", "week", "month")) %>%
  step_holiday(arrival_date, 
      holidays = timeDate::listHolidays("US")) %>%
  step_rm(arrival_date) %>%
  step_dummy(all_nominal_predictors())

พิมพ์ lr_recipe

Recipe
Inputs:

      role #variables
        ID          1
   outcome          1
 predictor         13

Operations:

Date features from arrival_date
Holiday features from arrival_date
Variables removed arrival_date
Dummy variables from all_nominal_predictors()

การสร้าง workflow

รวมโมเดลและ recipe ไว้ในออบเจกต์ workflow

lr_workflow <- 
  workflow()%>%
  add_model(lr_model)%>%
  add_recipe(lr_recipe)

ฟิต workflow

lr_fit <- 
  lr_workflow %>%
  fit(data = train)

การสร้าง workflow

ใช้ tidy(lr_fit) เพื่อสรุปผลโมเดล

# A tibble: 65 × 5
   term                        estimate std.error statistic   p.value
   <chr>                          <dbl>     <dbl>     <dbl>     <dbl>
 1 (Intercept)                 -1.92     0.228        -8.43 3.57e- 17
 2 LeadTime                     0.00414  0.000268     15.4  1.16e- 53
 3 StaysInWeekendNights         0.0860   0.0382        2.25 2.45e-  2
 4 StaysInWeekNights            0.0804   0.0185        4.34 1.40e-  5
 5 PreviousCancellations        2.39     0.147        16.2  2.45e- 59
 6 PreviousBookingsNotCanceled -0.440    0.0450       -9.77 1.45e- 22
 7 BookingChanges              -0.449    0.0463       -9.69 3.18e- 22
 8 ADR                          0.0104   0.000782     13.2  4.85e- 40
 9 TotalOfSpecialRequests      -0.727    0.0316      -23.0  5.29e-117
10 arrival_date_week            0.0245   0.0171        1.43 1.53e-  1
# … with 55 more rows
# ℹ Use `print(n = ...)` to see more rows

การประเมินประสิทธิภาพของโมเดล

ประเมินประสิทธิภาพของโมเดล

lr_aug <- lr_fit %>% augment(test)

bind_rows(
  lr_aug %>% 
  roc_auc(truth = IsCanceled,.pred_0),
  lr_aug %>% 
  accuracy(truth = IsCanceled,.pred_class))

# A tibble: 2 × 3
  .metric  .estimator .estimate
  <chr>    <chr>          <dbl>
1 roc_auc  binary         0.842
2 accuracy binary         0.782

lr_aug %>%
  roc_curve(truth = IsCanceled, .pred_0) %>%
  autoplot()

เส้นโค้ง Receiver Operator Characteristic ของโมเดล

มาฝึกกันเถอะ!

Feature Engineering in R