[R] DACON KBO 타자 OPS 시각화 경진대회 코드 분석 (2/2)

Date: 2022.12.09 Updated: 2022.12.09

카테고리: R

💡 본 대회는 야구 데이터로 불확실성 문제를 해결하기 위해 2019년 타자들의 상반기 성적 예측을 목표로 합니다. 2019년 타자들의 상반기 OPS를 예측하는 모델을 만들어 주세요! 2010년부터 1군 엔트리에 1번 이상 포함 되었던 타자들의 역대 정규시즌, 시범경기 성적 정보를 제공합니다.

이 글은 대회 수상자인 김민수 님의 R코드를 분석한 것입니다.

이전 편(모델링 이전 부분) 보러 가기

4. 모델링, 학습

이제 머신러닝으로 학습을하여 최적의 파라미터를 찾아보자.

모델은 Lasso, RandomForests, XGBoost 를 사용해 그 중 가장 좋은 성능을 보이는 것을 이용할 것이다.

그리고 평가는 wrms로 이뤄지기 떄문에 최종 성능 평가는 wrme 함수를 만들어서 할 것이다.

wrmse = function(v,w,p){
  sum(sqrt(((v-p)^2*w)/sum(w)))
}

OBP_data <- sum_hf_yr_OBP %>% filter(AB>=30)
SLG_data <- sum_hf_yr_SLG %>% filter(AB>=30)

우선 Lasso부터 해보자.

caret 패키지로 기계학습 모델링을 할 수 있다. trainControl()함수는 샘플링 기법을 지정한다. method=’cv’는 교차검증을 의미한다. 부트스트랩이나 반복교차검증 등을 지정할 수도 있다.

my_control <- trainControl(method='cv', number=5)

expand.grid()함수는 파라미터의 값을 목록으로 지정한다. 아래 코드는 lambda값을 0.0001~0.03까지 0.0005간격의 목록으로 설정한 것이다.

train()함수는 모델을 학습시킨다. 이 때 method 파라미터에 어떤 분류/회귀 모델을 사용할지 지정한다. trControl엔 비교 방식을 지정하고, tuneGrid에 파라미터 목록을 지정한다.

lassogrid <- expand.grid(alpha=1, lambda=seq(0.0001, 0.03, by=0.0005))

set.seed(3409)
lasso_mod_OBP <- train(x=as.data.frame(OBP_data)[,5:9],y=OBP_data$OBP, method='glmnet', trControl=my_control, tuneGrid = lassogrid)

set.seed(0625)
lasso_mod_SLG <- train(x=as.data.frame(SLG_data)[,5:9], y=SLG_data$SLG, method='glmnet', trControl=my_control, tuneGrid = lassogrid)

이제 Randomforest의 차례이다.

expand.grid()함수로 ntree(트리개수)나 mtry(변수개수)를 설정할 수 있다.

tuneGrid <- expand.grid(.mtry=c(1:4))

set.seed(0110)
RF_mod_OBP <- train(x=OBP_data[,5:9], y=OBP_data$OBP, method='rf', trControl=my_control, tuneGrid = tuneGrid)
set.seed(0110)
RF_mod_SLG <- train(x=SLG_data[,5:9], y=SLG_data$SLG, method='rf', trControl=my_control, tuneGrid = tuneGrid)

마지막으로 XGboost를 사용해보자. 이는 그래디언트 부스팅 알고리즘을 기반으로 한다.

label_train_OBP <- OBP_data$OBP
dtrain_OBP <- xgb.DMatrix(data=as.matrix(OBP_data[,5:9]), label=label_train_OBP)
label_train_SLG <- SLG_data$SLG
dtrain_SLG <- xgb.DMatrix(data=as.matrix(SLG_data[,5:9]), label=label_train_SLG)

이제 xgb에 들어갈 파라미터를 지정해주고 훈련을 시키자

param <- list(
  objective='reg:linear',
  booster='gbtree',
  eta=0.1, #학습률
  gamma=0, #minimum loss reduction required to make a further partition on a leaf node of the tree
  max_depth=1, #트리의 최대 깊이
  min_child_weight=1, #자녀노드의 합의 weight의 최솟값
  subsample=1,
  colsample_bytree=1
)

#nrounds는 최대반복횟수이다.
set.seed(5694)
xgb_mod_OBP <- xgb.train(data=dtrain_OBP, params=param, nrounds=100)

5. 평가 및 예측

이제 predict하고 evaluate할 때이다.

OBP_data$pr_lasso_OBP <- predict(lasso_mod_OBP, OBP_data[,5:9])
OBP_data$pr_RF_OBP <- predict(RF_mod_OBP, OBP_data[,5:9])
OBP_data$pr_XGB_OBP <- predict(xgb_mod_OBP,dtrain_OBP)

cbind('lasso' = wrmse(OBP_data$OBP, OBP_data$AB, OBP_data$pr_lasso_OBP),
      'RF' = wrmse(OBP_data$OBP, OBP_data$AB, OBP_data$pr_RF_OBP),
      'XGB' = wrmse(OBP_data$OBP, OBP_data$AB, OBP_data$pr_XGB_OBP))
#결과
       lasso       RF       XGB
[1,] 0.9265484 0.4904435 0.9099517

SLG_data$pr_lasso_SLG <- predict(lasso_mod_SLG, SLG_data[,5:9])
SLG_data$pr_RF_SLG <- predict(RF_mod_SLG, SLG_data[,5:9])
SLG_data$pr_XGB_SLG <- predict(xgb_mod_SLG,dtrain_SLG)

cbind('lasso'=wrmse(SLG_data$SLG, SLG_data$AB, SLG_data$pr_lasso_SLG),
      'RF' = wrmse(SLG_data$SLG, SLG_data$AB, SLG_data$pr_RF_SLG),
      'XGB' = wrmse(SLG_data$SLG, SLG_data$AB, SLG_data$pr_XGB_SLG))

#결과
lasso        RF      XGB
[1,] 1.763389 0.9139949 1.727737

랜덤포레스트의 오차가 가장 적으니 성능이 가장 좋다고 볼 수 있다.

이제 어떤 변수가 가장 큰 영향을 줬는지 **feature_importance**를 확인해보자.

변수의 중요도를 시각화해주는 함수가 varImp()이다.

set.seed(1569)
RF_mod_OBP_FI <- train(x=OBP_data[,5:9], y=OBP_data$OBP, method='rf', trControl=my_control, tuneGrid=tuneGrid, importance=T)
RF_mod_SLG_FI <- train(x=SLG_data[,5:9], y=SLG_data$SLG, method='rf', trControl=my_control, tuneGrid=tuneGrid, importance=T)
par(mfrow=c(1,2))
plot(varImp(RF_mod_OBP_FI, scale=FALSE), main='RF_mod_OBP variable Importance')
plot(varImp(RF_mod_SLG_FI, scale=FALSE), main='RF_mod_SLG variable Importance')

<img src=”https://user-images.githubusercontent.com/115082062/206626832-bbf2fe86-8f9d-4db0-932a-a6a83052c133.jpg”

평균 출루율/장타율이 가장 큰 영향을 주었고, 그 다음으로 1년전 성적, 나이, 3년전 성적, 2년전 성적 순으로 영향을 줬다.

제출 파일을 만들 것이다. 제출 파일엔 나이, 1,2,3년 전 성적, 평균 성적을 넣어줄 것이다.

submission <- read.csv('submission.csv', fileEncoding = "UTF-8")

#나이를 만들기 위해 우선 관측년도(2019) 변수를 만든다
submission$year <- 2019

#선수의 출생년도 정보를 담은 테이블을 만든다
regular_season_batter_year_born <- regular_season_batter %>%
  select(batter_id, batter_name, year_born)
regular_season_batter_year_born <- distinct(regular_season_batter_year_born)

submission <- left_join(submission, regular_season_batter_year_born, by=c('batter_id', 'batter_name'))
submission <- submission %>%
  mutate(age= year-as.numeric(substr(year_born,1,4)))

#OBP와 SLG를 따로 만들어주고 나중에 합친다
submission_OBP <- submission
submission_SLG <- submission

OBP부터 만들어준다.

submission_OBP <- left_join(submission_OBP, sum_hf_yr_OBP %>%
                              select(batter_name, mean_OBP) %>%
                              distinct(), by='batter_name')

#1,2,3년 전 OBP를 추가해준다
for(i in c(1,2,3)){
  lag_data <- sum_hf_yr_OBP %>% 
    filter(year==2019-i & AB>=30) %>% 
    select(batter_name, OBP)
    colnames(lag_data)[2] <- paste0("lag",i,"_OBP")
    submission_OBP <- left_join(submission_OBP, lag_data, by='batter_name')
}

6. 사후 결측치 보간

테이블을 열어보면 결측치가 꽤 많다. 결측치들이 각각의 이유로 결측되었기 때문에 경우에 맞는 처방을 해줘야한다.

우선 Day_by_Day 데이터에 누락되어 결측치인 선수들의 경우이다.

for( i in c('김주찬','이범호')){
  row_index <- which(submission_OBP$batter_name==i)
  submission_OBP[row_index,]$mean_OBP <- regular_season_batter %>%
    filter(AB>=30 & (batter_name==i)) %>%
    mutate(mean_OBP = sum(AB*OBP)/sum(AB)) %>%
    select(mean_OBP) %>% 
    unique()
  submission_OBP[row_index,]$lag1_OBP <- regular_season_batter %>%
    filter(AB>=30 & (batter_name==i)) %>%
    filter(year==2018) %>%
    select(OBP)
  submission_OBP[row_index,]$lag2_OBP <- regular_season_batter %>%
    filter(AB>=30 & (batter_name==i)) %>%
    filter(year==2017) %>%
    select(OBP)
  submission_OBP[row_index,]$lag3_OBP <- regular_season_batter %>%
    filter(AB>=30 & (batter_name==i)) %>%
    filter(year==2016) %>%
    select(OBP)
}

다음으로 갓 첫 시즌을 치뤄 평균 OBP가 없는 선수들의 경우이다. 이 때 시즌 평균 OBP로 결측치를 매꿔준다.

row_index <- which(submission_OBP$batter_name %in% c('고명성','전민재','김철호','신범수','이병휘'))
for (i in row_index) submission_OBP[i,]$mean_OBP <- season_OBP_mean %>%
  filter(year==2018) %>%
  select(mean_OBP)

샌즈와 전병우는 2018년 후반기 성적만 있어서 결측치가 생긴다.

for(i in c('전병우','샌즈')){
  row_index <- which(submission_OBP$batter_name==i)
  submission_OBP[row_index,]$mean_OBP <- regular_season_batter %>%
    filter(AB>=30 & (batter_name==i)) %>%
    mutate(mean_OBP = sum(AB*OBP)/sum(AB)) %>% select(mean_OBP) %>% unique()
  submission_OBP[row_index,]$lag1_OBP <- regular_season_batter %>%
    filter(AB>=30 & (batter_name==i)) %>%
    filter(year==2018) %>% select(OBP)
}

나머지 결측치들은 은퇴했거나, 1군 기량을 보여주지 못한 선수들이므로 하위 25%성적으로 결측치를 매꿔줄 것이다.

below_25_index <- which(is.na(submission_OBP$mean_OBP))
submission_OBP$mean_OBP[below_25_index] <- quantile(player_OBP_mean$mean_OBP, 0.25)

submission_OBP[which(sapply(submission_OBP,is.list))] <- sapply(submission_OBP[which(sapply(submission_OBP, is.list))], unlist)
for(i in c(1,2,3)) submission_OBP <- lag_na_fill(submission_OBP,"OBP",i,season_OBP_mean)

이제 SLG도 OBP와 동일한 과정을 밟으면 된다. 우선 1,2,3년 전 SLG 성적 열을 만들어준다.

submission_SLG <- left_join(submission_SLG, sum_hf_yr_SLG %>% select(batter_name, mean_SLG) %>% distinct(), by = "batter_name")

for(i in c(1,2,3)){
  lag_data <- sum_hf_yr_SLG %>% filter(year == 2019 - i & AB >= 30) %>% select(batter_name, SLG)
  colnames(lag_data)[2] <- paste0("lag",i,"_SLG")
  submission_SLG <- left_join(submission_SLG, lag_data, by="batter_name")
}

앞서 살펴본 4가지 경우에 따라 결측치를 매꿔준다.

case1_name <-c("김주찬", "이범호")

for(i in case1_name){
  row_index <- which(submission_SLG$batter_name == i)
  
  submission_SLG[row_index,]$mean_SLG <- regular_season_batter %>% filter(AB>=30 & (batter_name ==i)) %>%
    mutate(mean_SLG = sum(AB * SLG)/sum(AB)) %>% select(mean_SLG) %>% unique()
  
  submission_SLG[row_index,]$lag1_SLG <- regular_season_batter %>% filter(AB>=30 & (batter_name ==i)) %>% 
    filter(year == 2018) %>% select(SLG) %>% as.numeric()
  
  submission_SLG[row_index,]$lag2_SLG <- regular_season_batter %>% filter(AB>=30 & (batter_name ==i)) %>% 
    filter(year == 2017) %>% select(SLG) %>% as.numeric()
  
  submission_SLG[row_index,]$lag3_SLG <- regular_season_batter %>% filter(AB>=30 & (batter_name ==i)) %>% 
    filter(year == 2016) %>% select(SLG) %>% as.numeric()
  
}

row_index <- which(submission_SLG$batter_name %in% c("김철호","신범수", "이병휘", "전민재","고명성"))
for(i in row_index) submission_SLG[i,]$mean_SLG <- season_SLG_mean %>% filter(year == 2018) %>% select(mean_SLG)

for(i in c("샌즈", "전병우")){
  row_index <- which(submission_SLG$batter_name == i)
  submission_SLG[row_index,]$mean_SLG <- regular_season_batter %>% filter(AB>=30 & (batter_name == i)) %>%
    mutate(mean_SLG = sum(AB * SLG)/sum(AB)) %>% select(mean_SLG) %>% unique()
  
  submission_SLG[row_index,]$lag1_SLG <- regular_season_batter %>% filter(AB>=30 & (batter_name ==i)) %>% filter(year == 2018) %>% select(SLG)
}

below_25_index <- which(is.na(submission_SLG$mean_SLG))
submission_SLG$mean_SLG[below_25_index] <- quantile(player_SLG_mean$mean_SLG, 0.25)

submission_SLG[which(sapply(submission_SLG, is.list))] <- sapply(submission_SLG[which(sapply(submission_SLG, is.list))], unlist)

for(i in c(1,2,3)) submission_SLG <- lag_na_fill(submission_SLG, "SLG", i, season_SLG_mean)

이제 마지막으로 predict()함수를 이용해 예측을 진행한다.

#예측에 용이하게 열 순서를 바꾸고 행을 정렬한다.
submission_OBP <- submission_OBP %>%
  select(c(1:5,7:9,6)) %>%
  arrange(batter_id)
submission_SLG <- submission_SLG %>%
  select(c(1:5,7:9,6)) %>%
  arrange(batter_id)

predict_OBP <- predict(RF_mod_OBP, submission_OBP[,5:9])
predict_SLG <- predict(RF_mod_SLG, submission_SLG[,5:9])

final_submission <- submission %>% select(batter_id, batter_name)
final_submission$OPS <- predict_OBP+predict_SLG

final_submission$OPS <- final_submission$OPS - 0.035
write.csv(final_submission, "Final_Submission.csv", row.names = FALSE)

Twitter Facebook LinkedIn

Hee Jun Kim🍀

[R] DACON KBO 타자 OPS 시각화 경진대회 코드 분석 (2/2)

4. 모델링, 학습

5. 평가 및 예측

6. 사후 결측치 보간

공유하기

참고

에브리타임 원하는 게시판 본문과 댓글 등 크롤링

깃허브 블로그와 깃허브 커밋 기록 크롤링하기

[NLP] 위키피디아 문서 요약 시스템

[NLP] huggingface 나무위키 데이터셋 전처리