본문 바로가기

Kaggle/House Prices

Ensemble Modeling : Stack Model Example by J.Thompson (with R)

이 레포트는 Kaggle House Price competition을 위한 submission 데이터셋을 만들기 위한 앙상블 모델 접근법을 설명한다. 앙상블 모델링은 다수의 모델을 훈련시킨 다음 캐글에 내기 위한 예측결과를 도출하기 위해 그 훈련모델들의 예측결과들을 묶는 것을 말한다. 설명할 구체적인 앙상블 방법은 model stacking으로 불린다.

밑에 있는 그림은 2단계로 이루어진 high-level model stacking 구조를 보여준다.top-level stage 또는 Level0로 불리는 이 단계는 3개의 모델링 알고리즘으로 구성되어 진다. :  Gradient Boosting (gbm), Extreme Gradient Boosting (xgb) and Random Forest (rngr). 2번째 단계, Level1은 한개의 뉴럴넷모델(nnet)로 이루어진다. Level1의 예측치들이 캐글 submission 데이터셋으로 사용된다.

그림에 있는 Feature Sets은 Level0에 있는 모델들을 위해 생성된 변수들이다.

다음 차트는 Level0 각각의 구성 모델과 전체 stacked model간의 모델성능차이를 보여준것이다.

위 차트로 부터, Level 1 모델이 Level0 최고성능모델보다 1.35% 더 좋은 성능을 냈음을 볼 수 있다.

캐글 커널제약에 맞게, 이 레포트에서는 단순한 stacked model 구조를 썼다. 좀 더 설명하자면 

  • Level0를 3개의 모델로 제한
  • Level 1을 1개의 모델로 제한

stacked model 성능향상은 다음으로 이루어 질 수 있다.

  • Level0와 Level1에 다른 알고리즘들을 추가한다.
  • 모델 하이퍼파라미터를 조절한다.
  • 피쳐엔지니어링으로 피쳐를 추가한다.
  • 모델구조에서 level을 추가한다.

Model stacking에 대해서 더 많은 정보는 다음을 참고해라:

이 레포트의 나머지는 model stacking의 훈련과정을 보여준다. 먼저 모델을 위한  featrue sets을 생성하는 법부터 보인후, caret package를 이용해 Level0모델들을 훈련시키고, 그 다음 Level1모델을 위한 피쳐들을 생성하고 submission 데이터셋을 만드는 것으로 마무리를 지겠다.  

Data Preparation

Retrieve Data

train.raw <- read.csv(file.path(DATA.DIR,"train.csv"),stringsAsFactors = FALSE)

test.raw <- read.csv(file.path(DATA.DIR,"test.csv"), stringsAsFactors = FALSE)

Initial Data Profile

Feature selection은 Boruta의 feature importance 분석에 기초한다.

# boruta feature importance analysis을 통해 얻은 피쳐들이다.
CONFIRMED_ATTR <- c("MSSubClass","MSZoning","LotArea","LotShape","LandContour","Neighborhood",
                    "BldgType","HouseStyle","OverallQual","OverallCond","YearBuilt",
                    "YearRemodAdd","Exterior1st","Exterior2nd","MasVnrArea","ExterQual",
                    "Foundation","BsmtQual","BsmtCond","BsmtFinType1","BsmtFinSF1",
                    "BsmtFinType2","BsmtUnfSF","TotalBsmtSF","HeatingQC","CentralAir",
                    "X1stFlrSF","X2ndFlrSF","GrLivArea","BsmtFullBath","FullBath","HalfBath",
                    "BedroomAbvGr","KitchenAbvGr","KitchenQual","TotRmsAbvGrd","Functional",
                    "Fireplaces","FireplaceQu","GarageType","GarageYrBlt","GarageFinish",
                    "GarageCars","GarageArea","GarageQual","GarageCond","PavedDrive","WoodDeckSF",
                    "OpenPorchSF","Fence")

TENTATIVE_ATTR <- c("Alley","LandSlope","Condition1","RoofStyle","MasVnrType","BsmtExposure",
                    "Electrical","EnclosedPorch","SaleCondition")

REJECTED_ATTR <- c("LotFrontage","Street","Utilities","LotConfig","Condition2","RoofMatl",
                   "ExterCond","BsmtFinSF2","Heating","LowQualFinSF","BsmtHalfBath",
                   "X3SsnPorch","ScreenPorch","PoolArea","PoolQC","MiscFeature","MiscVal",
                   "MoSold","YrSold","SaleType")

PREDICTOR_ATTR <- c(CONFIRMED_ATTR,TENTATIVE_ATTR,REJECTED_ATTR)

# 데이터 셋에서 데이터 타입들을 정의한다.
data_types <- sapply(PREDICTOR_ATTR,function(x){class(train.raw[[x]])})
unique_data_types <- unique(data_types)

# 데이터 타입에 따라 피쳐들을 분리한다.
DATA_ATTR_TYPES <- lapply(unique_data_types,function(x){ names(data_types[data_types == x])})
names(DATA_ATTR_TYPES) <- unique_data_types


# 훈련을 위해 Cross-Validation의 fold 수를 정한다.
set.seed(13)
data_folds <- createFolds(train.raw$SalePrice, k=5)

Create Level 0 Model Feature Sets

이 단계에서, 두개의 피쳐셋들이 사용된다. 이 두 피쳐세트 모두 Boruta 분석에서 나온 Confirmed 와 Tentative 변수들을 포함한다. 각 피쳐셋은 사용자정의 R 함수로 생성된다. 이 함수들은 raw 훈련데이터를 피쳐셋으로 바꾼다. 더이상의 피쳐 엔지니어링은 하지 않았다. 결측치들은 다음과 같이 다루었다.

  • 수치형 : -1로 설정.
  • 문자형: “*MISSING*”으로 설정.

보루타 패키지를 실행하기 위해 문자형 변수들은 R factor 변수들로 변환시킨다.

# Feature Set 1 - Boruta 분석에서  Confirmed 과 tentative 변수들
prepL0FeatureSet1 <- function(df) {
    id <- df$Id
    if (class(df$SalePrice) != "NULL") {
        y <- log(df$SalePrice)
    } else {
        y <- NULL
    }
    
    
    predictor_vars <- c(CONFIRMED_ATTR,TENTATIVE_ATTR)
    
    predictors <- df[predictor_vars]
    
    # 수치형 변수의 결측값은 -1로 설정한다.
    num_attr <- intersect(predictor_vars,DATA_ATTR_TYPES$integer)
    for (x in num_attr){
      predictors[[x]][is.na(predictors[[x]])] <- -1
    }

    # 문자형 변수의 결측값은 "*MISSING*" 으로 설정한다.
    char_attr <- intersect(predictor_vars,DATA_ATTR_TYPES$character)
    for (x in char_attr){
      predictors[[x]][is.na(predictors[[x]])] <- "*MISSING*"
      predictors[[x]] <- factor(predictors[[x]])
    }
    
    return(list(id=id,y=y,predictors=predictors))
}

L0FeatureSet1 <- list(train=prepL0FeatureSet1(train.raw),
                    test=prepL0FeatureSet1(test.raw))

# Feature Set 2 (xgboost) - 보루타 패키지로 검증한 변수들.
prepL0FeatureSet2 <- function(df) {
    id <- df$Id
    if (class(df$SalePrice) != "NULL") {
        y <- log(df$SalePrice)
    } else {
        y <- NULL
    }
    
    
    predictor_vars <- c(CONFIRMED_ATTR,TENTATIVE_ATTR)
    
    predictors <- df[predictor_vars]
    
    # 모델링을 위해 수치형 결측값은 -1로 설정.
    num_attr <- intersect(predictor_vars,DATA_ATTR_TYPES$integer)
    for (x in num_attr){
      predictors[[x]][is.na(predictors[[x]])] <- -1
    }

    # 문자형 변수의 결측값은 "*MISSING*" 으로 설정한다.
    char_attr <- intersect(predictor_vars,DATA_ATTR_TYPES$character)
    for (x in char_attr){
      predictors[[x]][is.na(predictors[[x]])] <- "*MISSING*"
      predictors[[x]] <- as.numeric(factor(predictors[[x]]))
    }
    
    return(list(id=id,y=y,predictors=as.matrix(predictors)))
}

L0FeatureSet2 <- list(train=prepL0FeatureSet2(train.raw),
                    test=prepL0FeatureSet2(test.raw))

Level 0 Model Training

Helper Function For Training

# 1 fold의 데이터로 학습시키기
trainOneFold <- function(this_fold,feature_set) {
    # 구체적으로 몇번째 fold 데이터를 예측할건지 정하자.
    cv.data <- list()
    cv.data$predictors <- feature_set$train$predictors[this_fold,]
    cv.data$ID <- feature_set$train$id[this_fold]
    cv.data$y <- feature_set$train$y[this_fold]
    
    # 선택된 fold를 제외한 나머지 fold들은 훈련을 위해 따로 저장한다.
    train.data <- list()
    train.data$predictors <- feature_set$train$predictors[-this_fold,]
    train.data$y <- feature_set$train$y[-this_fold]

    
    set.seed(825)
    fitted_mdl <- do.call(train,
                          c(list(x=train.data$predictors,y=train.data$y),
                        CARET.TRAIN.PARMS,
                        MODEL.SPECIFIC.PARMS,
                        CARET.TRAIN.OTHER.PARMS))
    
    yhat <- predict(fitted_mdl,newdata = cv.data$predictors,type = "raw")
    
    score <- rmse(cv.data$y,yhat)
    
    ans <- list(fitted_mdl=fitted_mdl,
                score=score,
                predictions=data.frame(ID=cv.data$ID,yhat=yhat,y=cv.data$y))
    
    return(ans)
    
}

# one fold에 적합된 한 모델로 부터 예측치를 만든다.
makeOneFoldTestPrediction <- function(this_fold,feature_set) {
    fitted_mdl <- this_fold$fitted_mdl
    
    yhat <- predict(fitted_mdl,newdata = feature_set$test$predictors,type = "raw")
    
    return(yhat)
}

gbm Model

Public Leaderboard Score: 0.12852

# caret 파라미터 설정.
CARET.TRAIN.PARMS <- list(method="gbm")   

CARET.TUNE.GRID <-  expand.grid(n.trees=100, 
                                interaction.depth=10, 
                                shrinkage=0.1,
                                n.minobsinnode=10)

MODEL.SPECIFIC.PARMS <- list(verbose=0) #NULL # 다른 세부 파라미터
# 세부 훈련 파라미터 설정.
CARET.TRAIN.CTRL <- trainControl(method="none",
                                 verboseIter=FALSE,
                                 classProbs=FALSE)

CARET.TRAIN.OTHER.PARMS <- list(trControl=CARET.TRAIN.CTRL,
                           tuneGrid=CARET.TUNE.GRID,
                           metric="RMSE")

# Level 1 을 위한 피쳐들 생성
gbm_set <- llply(data_folds,trainOneFold,L0FeatureSet1)

# 최종모델 적합
gbm_mdl <- do.call(train,
                 c(list(x=L0FeatureSet1$train$predictors,y=L0FeatureSet1$train$y),
                 CARET.TRAIN.PARMS,
                 MODEL.SPECIFIC.PARMS,
                 CARET.TRAIN.OTHER.PARMS))

# CV 오차 추정
cv_y <- do.call(c,lapply(gbm_set,function(x){x$predictions$y}))
cv_yhat <- do.call(c,lapply(gbm_set,function(x){x$predictions$yhat}))
rmse(cv_y,cv_yhat)
## [1] 0.1309466
cat("Average CV rmse:",mean(do.call(c,lapply(gbm_set,function(x){x$score}))))
## Average CV rmse: 0.1304117
# test submission 생성.
# CV로 예측한 예측치들을 평균하여 최종 예측치를 만듬.
# 각 fold에 대해 적합시킨다.

test_gbm_yhat <- predict(gbm_mdl,newdata = L0FeatureSet1$test$predictors,type = "raw")
gbm_submission <- cbind(Id=L0FeatureSet1$test$id,SalePrice=exp(test_gbm_yhat))
write.csv(gbm_submission,file="gbm_sumbission.csv",row.names=FALSE)

xgboost Model

Public Leader Board Score: 0.13696

#caret 훈련 파라미터를 설정.
CARET.TRAIN.PARMS <- list(method="xgbTree")   

CARET.TUNE.GRID <-  expand.grid(nrounds=800, 
                                max_depth=10, 
                                eta=0.03, 
                                gamma=0.1, 
                                colsample_bytree=0.4, 
                                min_child_weight=1)

MODEL.SPECIFIC.PARMS <- list(verbose=0) #NULL # 다른 파라미터 설정

# xgb 모델 파라미터 설정.
CARET.TRAIN.CTRL <- trainControl(method="none",
                                 verboseIter=FALSE,
                                 classProbs=FALSE)

CARET.TRAIN.OTHER.PARMS <- list(trControl=CARET.TRAIN.CTRL,
                           tuneGrid=CARET.TUNE.GRID,
                           metric="RMSE")

# level1 피쳐 생성.
xgb_set <- llply(data_folds,trainOneFold,L0FeatureSet2)

# 최종 stacking 모델 적합.
xgb_mdl <- do.call(train,
                 c(list(x=L0FeatureSet2$train$predictors,y=L0FeatureSet2$train$y),
                 CARET.TRAIN.PARMS,
                 MODEL.SPECIFIC.PARMS,
                 CARET.TRAIN.OTHER.PARMS))

# CV 오차 추정.
cv_y <- do.call(c,lapply(xgb_set,function(x){x$predictions$y}))
cv_yhat <- do.call(c,lapply(xgb_set,function(x){x$predictions$yhat}))
rmse(cv_y,cv_yhat)
## [1] 0.1292102
cat("Average CV rmse:",mean(do.call(c,lapply(xgb_set,function(x){x$score}))))
## Average CV rmse: 0.1284355
# test submission 생성
# Level 0모델틀에 의해 만들어진 예측치들을 평균하여 하나의 예측치를 만듬. 
# 각 fold들은 적합된다.

test_xgb_yhat <- predict(xgb_mdl,newdata = L0FeatureSet2$test$predictors,type = "raw")
xgb_submission <- cbind(Id=L0FeatureSet2$test$id,SalePrice=exp(test_xgb_yhat))

write.csv(xgb_submission,file="xgb_sumbission.csv",row.names=FALSE)

ranger Model

Public Leader Board Score: 0.14703

# caret 파라미터들을 설정.
CARET.TRAIN.PARMS <- list(method="ranger")   

CARET.TUNE.GRID <-  expand.grid(mtry=2*as.integer(sqrt(ncol(L0FeatureSet1$train$predictors))))

MODEL.SPECIFIC.PARMS <- list(verbose=0,num.trees=500) #NULL # 다른 파라미터 설정.

# 모델 파라미터 설정.
CARET.TRAIN.CTRL <- trainControl(method="none",
                                 verboseIter=FALSE,
                                 classProbs=FALSE)

CARET.TRAIN.OTHER.PARMS <- list(trControl=CARET.TRAIN.CTRL,
                           tuneGrid=CARET.TUNE.GRID,
                           metric="RMSE")

#Lelvel 1 피쳐 생성.
rngr_set <- llply(data_folds,trainOneFold,L0FeatureSet1)

# 최종 모델 적합.
rngr_mdl <- do.call(train,
                 c(list(x=L0FeatureSet1$train$predictors,y=L0FeatureSet1$train$y),
                 CARET.TRAIN.PARMS,
                 MODEL.SPECIFIC.PARMS,
                 CARET.TRAIN.OTHER.PARMS))

# CV Error 추정.
cv_y <- do.call(c,lapply(rngr_set,function(x){x$predictions$y}))
cv_yhat <- do.call(c,lapply(rngr_set,function(x){x$predictions$yhat}))
rmse(cv_y,cv_yhat)
## [1] 0.1388838
cat("Average CV rmse:",mean(do.call(c,lapply(rngr_set,function(x){x$score}))))
## Average CV rmse: 0.1376416
# test submission 생성
# Level 0모델틀에 의해 만들어진 예측치들을 평균하여 하나의 예측치를 만듬. 
# 각 fold들은 적합된다.
test_rngr_yhat <- predict(rngr_mdl,newdata = L0FeatureSet1$test$predictors,type = "raw") rngr_submission <- cbind(Id=L0FeatureSet1$test$id,SalePrice=exp(test_rngr_yhat)) write.csv(rngr_submission,file="rngr_sumbission.csv",row.names=FALSE)

Level 1 Model Training

Create predictions For Level 1 Model

gbm_yhat <- do.call(c,lapply(gbm_set,function(x){x$predictions$yhat}))
xgb_yhat <- do.call(c,lapply(xgb_set,function(x){x$predictions$yhat}))
rngr_yhat <- do.call(c,lapply(rngr_set,function(x){x$predictions$yhat}))

# 피쳐 세트 생성.
L1FeatureSet <- list()

L1FeatureSet$train$id <- do.call(c,lapply(gbm_set,function(x){x$predictions$ID}))
L1FeatureSet$train$y <- do.call(c,lapply(gbm_set,function(x){x$predictions$y}))
predictors <- data.frame(gbm_yhat,xgb_yhat,rngr_yhat)
predictors_rank <- t(apply(predictors,1,rank))
colnames(predictors_rank) <- paste0("rank_",names(predictors))
L1FeatureSet$train$predictors <- predictors #cbind(predictors,predictors_rank)

L1FeatureSet$test$id <- gbm_submission[,"Id"]
L1FeatureSet$test$predictors <- data.frame(gbm_yhat=test_gbm_yhat,
                                      xgb_yhat=test_xgb_yhat,
                                      rngr_yhat=test_rngr_yhat)

Neural Net Model

Public Leaderboard Score: 0.12678

# caret 훈련 파라미터 설정.
CARET.TRAIN.PARMS <- list(method="nnet") 

CARET.TUNE.GRID <-  NULL  # NULL provides model specific default tuning parameters

# 모델 파라미터 설정.
CARET.TRAIN.CTRL <- trainControl(method="repeatedcv",
                                 number=5,
                                 repeats=1,
                                 verboseIter=FALSE)

CARET.TRAIN.OTHER.PARMS <- list(trControl=CARET.TRAIN.CTRL,
                            maximize=FALSE,
                           tuneGrid=CARET.TUNE.GRID,
                           tuneLength=7,
                           metric="RMSE")

MODEL.SPECIFIC.PARMS <- list(verbose=FALSE,linout=TRUE,trace=FALSE) #NULL # Other model specific parameters


# 모델 훈련.
set.seed(825)
l1_nnet_mdl <- do.call(train,c(list(x=L1FeatureSet$train$predictors,y=L1FeatureSet$train$y),
                            CARET.TRAIN.PARMS,
                            MODEL.SPECIFIC.PARMS,
                            CARET.TRAIN.OTHER.PARMS))

l1_nnet_mdl
## 뉴럴 네트워크
## 
## 1460 samples
##    3 predictor
## 
## No pre-processing
## Resampling: Cross-Validated (5 fold, repeated 1 times) 
## Summary of sample sizes: 1168, 1169, 1167, 1168, 1168 
## Resampling results across tuning parameters:
## 
##   size  decay         RMSE       Rsquared 
##    1    0.0000000000  0.2907897  0.8865049
##    1    0.0001000000  0.3493635  0.4625030
##    1    0.0003981072  0.2332915  0.9039005
##    1    0.0015848932  0.1818179  0.8926679
##    1    0.0063095734  0.1823770  0.8679632
##    1    0.0251188643  0.1256682  0.9012318
##    1    0.1000000000  0.1269165  0.9002064
##    3    0.0000000000  0.3423933  0.5278129
##    3    0.0001000000  0.2314691  0.6886510
##    3    0.0003981072  0.1823747  0.7697117
##    3    0.0015848932  0.1250508  0.9017599
##    3    0.0063095734  0.1252676  0.9016058
##    3    0.0251188643  0.1256038  0.9010900
##    3    0.1000000000  0.1258190  0.9014646
##    5    0.0000000000  0.2401507  0.8914165
##    5    0.0001000000  0.1831908  0.7368565
##    5    0.0003981072  0.1252295  0.9014586
##    5    0.0015848932  0.1253544  0.9012394
##    5    0.0063095734  0.1825439  0.8866659
##    5    0.0251188643  0.1256318  0.9012892
##    5    0.1000000000  0.1256011  0.9018715
##    7    0.0000000000  0.1250480  0.9017202
##    7    0.0001000000  0.1820054  0.7847464
##    7    0.0003981072  0.1258709  0.9002621
##    7    0.0015848932  0.1252166  0.9015367
##    7    0.0063095734  0.1252267  0.9014704
##    7    0.0251188643  0.1252168  0.9016319
##    7    0.1000000000  0.1257647  0.9017146
##    9    0.0000000000  0.1247938  0.9024059
##    9    0.0001000000  0.1262688  0.9000292
##    9    0.0003981072  0.1298683  0.8937934
##    9    0.0015848932  0.1249049  0.9019602
##    9    0.0063095734  0.1256470  0.9011138
##    9    0.0251188643  0.1251696  0.9018060
##    9    0.1000000000  0.1255311  0.9018838
##   11    0.0000000000  0.1782680  0.8314962
##   11    0.0001000000  0.1274989  0.8975569
##   11    0.0003981072  0.1267063  0.8987689
##   11    0.0015848932  0.1261221  0.9001556
##   11    0.0063095734  0.1251522  0.9014403
##   11    0.0251188643  0.1250577  0.9018394
##   11    0.1000000000  0.1257372  0.9019579
##   13    0.0000000000  0.1254535  0.9012336
##   13    0.0001000000  0.1266526  0.8993364
##   13    0.0003981072  0.1270863  0.8983052
##   13    0.0015848932  0.1257823  0.9004746
##   13    0.0063095734  0.1249307  0.9021185
##   13    0.0251188643  0.1254440  0.9017855
##   13    0.1000000000  0.1255146  0.9017464
## 
## RMSE가 가장 작은 최적의 모델을 선택함. 
## 모델에 사용된 최종 파라미터 값은 size = 9 그리고 decay = 0 이다.
cat("Average CV rmse:",mean(l1_nnet_mdl$resample$RMSE),"\n")
## Average CV rmse: 0.1247938
test_l1_nnet_yhat <- predict(l1_nnet_mdl,newdata = L1FeatureSet$test$predictors,type = "raw")
l1_nnet_submission <- cbind(Id=L1FeatureSet$test$id,SalePrice=exp(test_l1_nnet_yhat))
colnames(l1_nnet_submission) <- c("Id","SalePrice")

write.csv(l1_nnet_submission,file="l1_nnet_submission.csv",row.names=FALSE)