ranger
팩키지 1 2 3ranger
팩키지 명칭은 “RANdom forest GEneRator”에서 나왔다. C++로 작성되어 매우 빠르고 문법도 깔끔하다. 특히, 생존분석(Survival Analysis)를 위해서 별도 작업 없이 … random forest 모형을 구축할 수 있다는 점에서 다른 팩키지 randomForestSRC
와 비교하여 장점이 있다.
> # 0. 팩키지 -----
> library(tidyverse)
> # 1. 데이터 -----
>
> download.file(url="https://cdn2.hubspot.net/hubfs/532045/Discriminant-analysis-churn-dataset.csv?t=1537486781722", destfile = "data/sgi-churn.csv")
>
> churn_dat <- read_csv("data/sgi-churn.csv")
>
> churn_df <- churn_dat %>%
+ mutate(churn = factor(churn, levels=c(0,1), labels = c("No", "Yes")))
>
> churn_df %>%
+ sample_frac(0.01) %>%
+ DT::datatable(options = list(scrollX = TRUE))
생존분석을 위한 랜덤 포레스트 모형을 개발할 경우, survival
팩키지 Surv(account_length, churn)
객체를 생성한 후에 랜덤 포레스트 모형을 적합시킨다.
> library(ranger)
> library(survival)
> library(extrafont)
> loadfonts()
> library(caret)
>
> ## 훈련/시험 데이터 분할 ----
> churn_idx <- createDataPartition(churn_df$churn, p=0.7, list=FALSE)
>
> train_df <- churn_df[churn_idx, ]
> test_df <- churn_df[-churn_idx, ]
>
> ## 랜덤포레스트 적합 ----
> churn_rf <- ranger(Surv(account_length, churn) ~ ., data=train_df,
+ importance = "permutation", write.forest = TRUE)
Growing trees.. Progress: 44%. Estimated remaining time: 39 seconds.
Growing trees.. Progress: 88%. Estimated remaining time: 8 seconds.
고객이탈 관련하여 중요한 변수를 random forest 모형의 Variable Importance를 통해 살펴본다.
> churn_varimp_df <- churn_rf$variable.importance %>% as.data.frame %>%
+ rownames_to_column(var="variable") %>%
+ rename(importance = ".")
>
> churn_varimp_df %>%
+ ggplot(aes(x=fct_reorder(variable, importance), y=importance)) +
+ geom_col(width=0.5) +
+ coord_flip() +
+ labs(x="", y="변수 중요도", title = "생존 랜덤 포레스트 모형 변수 중요도") +
+ theme_minimal(base_family = "NanumGothic")
고객 두명을 뽑아 예측모형에서 예측한 잔존율을 시각적으로 파악한다. 각 고객마다 잔존율을 물고 있어(churn_rf$survival
), 이를 고개별로 바꾸고 고객을 추출하여 잔존율을 시각화한다.
> pred_df <- data.frame(churn_rf$survival) %>%
+ add_rownames(., var ="customer") %>%
+ gather(time, retention, -customer) %>%
+ spread(customer, retention)
>
>
> pred_df %>%
+ gather(customer, retention_prob, -time) %>%
+ mutate(time = str_remove(time, "X") %>% as.integer) %>%
+ filter(customer %in% c("1", "7")) %>%
+ ggplot(aes(x=time, y=retention_prob, group=customer, color=customer)) +
+ geom_point() +
+ geom_line() +
+ labs(x="시간", y="유지율(%)") +
+ scale_y_continuous(labels = scales::percent, limits=c(0,1)) +
+ theme(legend.position = "top")
앞서 분리한 시험데이터로 예측을 하고 이를 특시 시점 (30일)과 전체 기간에 대해서 AUC 값을 구해서 예측모형 성능을 확인한다.
> library(Metrics)
> churn_pred <- predict(churn_rf, test_df)
>
> ## 30일 경과 AUC 성능
> auc(actual=as.integer(test_df$churn)-1, predicted=1 - churn_pred$survival[, which(churn_pred$unique.death.times==30)])
[1] 0.8036864
> ## 전체 시점 AUC 성능
> auc_v <- vector("double", length = length(churn_pred$unique.death.times))
>
> for(i in seq_along(churn_pred$unique.death.times)) {
+ auc_v[i] <- auc(actual=as.integer(test_df$churn)-1, predicted=1 - churn_pred$survival[, which(churn_pred$unique.death.times==i)])
+ }
>
> churn_auc_df <- data.frame(time =churn_pred$unique.death.times, auc = auc_v)
>
> churn_auc_df %>%
+ ggplot(aes(x=time, y=auc)) +
+ geom_point() +
+ geom_line() +
+ labs(x="시간", y="AUC", title = "각 시점별 예측모형 성능(AUC)") +
+ theme_minimal(base_family = "NanumGothic")
climbeR: Calculate Average Minimal Depth of a Maximal Subtree for ‘ranger’ Package Forests↩
Survival Ensembles: Survival Plus Classification for Improved Time-Based Predictions in R↩
Oracle, predicting-customer-churn-with-a-discriminant-analysis↩
stackoverflow, “How to transpose a dataframe in tidyverse?”↩