[빅분기 실기] 이상치 정제후 AUC 0.6688

 

> ################### 이상치(최대값) 확인 및 변환
>library(dplyr, caret, randomForest,pROC)
> x_train <- read.csv("C:/R/[Dataset] 작업형 제2유형/X_train.csv")
> y_train <- read.csv("C:/R/[Dataset] 작업형 제2유형/Y_train.csv")
> full <- left_join(x_train, y_train, id="cust_id")
Joining, by = "cust_id"
> full$최대구매액 <- full$최대구매액/10000
> full$총구매액 <- full$총구매액/10000
> full$환불금액 <- full$환불금액/10000
> full$환불금액 <- ifelse(is.na(full$환불금액),0,full$환불금액)
> full$주구매상품 <- as.factor(full$주구매상품)
> full$주구매지점 <- as.factor(full$주구매지점)
> full$gender <- as.factor(full$gender)
> round(cor(full[,-c(1,5,6,11)]),2)  
               총구매액 최대구매액 환불금액 내점일수 내점당구매건수 주말방문비율 구매주기
총구매액           1.00       0.70     0.47     0.66           0.09         0.01    -0.21
최대구매액         0.70       1.00     0.43     0.37           0.02         0.02    -0.12
환불금액           0.47       0.43     1.00     0.38           0.00        -0.02    -0.14
내점일수           0.66       0.37     0.38     1.00           0.23        -0.01    -0.29
내점당구매건수     0.09       0.02     0.00     0.23           1.00         0.01    -0.09
주말방문비율       0.01       0.02    -0.02    -0.01           0.01         1.00     0.00
구매주기          -0.21      -0.12    -0.14    -0.29          -0.09         0.00     1.00

 

이상치 처리전 상관계수를 통한 각 변수별 상관관계를 알아보았습니다.

 

> full %>% 
+   filter(총구매액 > quantile(full$총구매액, 0.75) + 1.5*IQR(full$총구매액) |
+                최대구매액 > quantile(full$최대구매액, 0.75) + 1.5*IQR(full$최대구매액) |
+                환불금액 > quantile(full$환불금액, 0.75) + 1.5*IQR(full$환불금액)|
+                내점당구매건수 > quantile(full$내점당구매건수, 0.75) + 1.5*IQR(full$내점당구매건수)|
+                주말방문비율 > quantile(full$주말방문비율, 0.75) + 1.5*IQR(full$주말방문비율)|
+                구매주기 > quantile(full$구매주기, 0.75) + 1.5*IQR(full$구매주기)) %>% 
+   summarise(count=n())
  count
1  1221
> 1221/3500
[1] 0.3488571

 

각 총구매액, 최대구매액, 환불금액, 내점당구매건수, 주말방문비율, 구매주기 변수6개를 이용하여 상위 25%를 구해봤는데 전체의 34.8%정도가 나오네요.. 크게 의미해석은 할 수 없지만 위에 상관계수를 어느정도 확인하는 과정이라고 보시면 됩니다.

 

> full$총구매액 <- ifelse(full$총구매액 > quantile(full$총구매액, 0.75) + 1.5*IQR(full$총구매액),quantile(full$총구매액, 0.75) + 1.5*IQR(full$총구매액),full$총구매액)
> full$최대구매액 <- ifelse(full$최대구매액 > quantile(full$최대구매액, 0.75) + 1.5*IQR(full$최대구매액),quantile(full$최대구매액, 0.75) + 1.5*IQR(full$최대구매액),full$최대구매액)
> full$환불금액 <- ifelse(full$환불금액 > quantile(full$환불금액, 0.75) + 1.5*IQR(full$환불금액),quantile(full$환불금액, 0.75) + 1.5*IQR(full$환불금액),full$환불금액)
> full$내점당구매건수 <- ifelse(full$내점당구매건수 > quantile(full$내점당구매건수, 0.75) + 1.5*IQR(full$내점당구매건수),quantile(full$내점당구매건수, 0.75) + 1.5*IQR(full$내점당구매건수),full$내점당구매건수)
> full$주말방문비율 <- ifelse(full$주말방문비율 > quantile(full$주말방문비율, 0.75) + 1.5*IQR(full$주말방문비율),quantile(full$주말방문비율, 0.75) + 1.5*IQR(full$주말방문비율),full$주말방문비율)
> full$구매주기 <- ifelse(full$구매주기 > quantile(full$구매주기, 0.75) + 1.5*IQR(full$구매주기),quantile(full$구매주기, 0.75) + 1.5*IQR(full$구매주기),full$구매주기)

 

코드의 가독성이 떨어져 간단한 설명을 덧붙이자면 이자료는 이상치가 큰 데이터입니다. 최소값에서는 이상치가 발견되지 않지만 최대값 부근에서는 이상치가 발견이 많이 됩니다. 저는 제 나름대로의 기준인 Q3+1.5*IQR을 넘으면 이상치로 판단하였고 기준을 넘으면 Q3+1.5IQR값으로 대체하여 이상치의 영향을 줄여보려고 시도하였습니다.

 

> round(cor(full[,-c(1,5,6,11)]),2)  
               총구매액 최대구매액 환불금액 내점일수 내점당구매건수 주말방문비율 구매주기
총구매액           1.00       0.81     0.54     0.70           0.20         0.02    -0.26
최대구매액         0.81       1.00     0.48     0.47           0.09         0.02    -0.13
환불금액           0.54       0.48     1.00     0.51           0.09        -0.01    -0.22
내점일수           0.70       0.47     0.51     1.00           0.30        -0.01    -0.32
내점당구매건수     0.20       0.09     0.09     0.30           1.00         0.02    -0.08
주말방문비율       0.02       0.02    -0.01    -0.01           0.02         1.00     0.02
구매주기          -0.26      -0.13    -0.22    -0.32          -0.08         0.02     1.00

 

이상치의 영향을 줄여보니 상관계수가 조금이나마 증가한것을 확인할수 있습니다.

 

> full$총구매액 <- scale(full$총구매액)
> full$최대구매액 <- scale(full$최대구매액)
> full$환불금액 <- scale(full$환불금액)
> full$내점일수 <- scale(full$내점일수)
> full$내점당구매건수 <- scale(full$내점당구매건수)
> full$주말방문비율 <- scale(full$주말방문비율)
> full$구매주기 <- scale(full$구매주기)
> idx <- sample(1:nrow(full), 0.7*nrow(full), replace=F)
> train <- full[idx,]
> test <- full[-idx,]
> rf.model <- randomForest(gender~.,
+                          data=train,
+                          ntree=50,
+                          mtry=sqrt(10),
+                          importance=T)
> pred.rf <- predict(rf.model, test[,-11],type="prob")
> auc(test$gender, pred.rf[,1]) # 남자로 예측할 확률 auc 값 확인
Setting levels: control = 0, case = 1
Setting direction: controls > cases
Area under the curve: 0.6688

 

표준화 후 랜덤포레스트 결과 최종적으로 AUC값이 0.6688이 나왔네요 0.7나오기 더럽게 어렵네요 ... 0.7은 나와야 안전한 합격선이 나올거같은데