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

Date: 2022.12.09 Updated: 2022.12.09

카테고리: R

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

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

1. 데이터준비

install.packages("tidyverse")
library(tidyverse)
install.packages('caret')
library(caret)
install.packages('xgboost')
library(xgboost)
install.packages('knitr')
library(knitr)
install.packages('corrplot')
library(corrplot)

regular_season_batter_day <- read.csv("Regular_Season_Batter_Day_by_Day_b4.csv", fileEncoding = "UTF-8", na.strings=c("","-"),stringsAsFactors = F)
regular_season_batter <- read.csv("Regular_Season_Batter.csv", fileEncoding = "UTF-8", na.strings=c("","-"),stringsAsFactors = F)

2. 결측치, 이상치 대체

complete.cases() 함수는 결측치가 없으면 TRUE, 있으면 FALSE를 반환한다.

결측치가 있는 행을 확인해보자.

View(regular_season_batter[!complete.cases(regular_season_batter),])
View(regular_season_batter_day[!complete.cases(regular_season_batter_day),])

sapply() 함수는 어떤 기능을 반복적인 처리할 시 매우 편리한 함수이다. 예를 들어, 데이터셋에 포함된 결측치를 0으로 대체하는 경우처럼 말이다.

which() 함수는 어떠한 조건을 만족시키는 값의 인덱스를 출력해주는 함수이다.

#숫자형인 열의 인덱스만 뽑아낸다.
num_col_regular <- which(sapply(regular_season_batter, is.numeric))
#숫자형인 열에서 결측치인 행의 값을 0으로 바꾼다.
regular_season_batter[,num_col_regular][is.na(regular_season_batter[,num_col_regular])] <- 0
#day 파일에도 마찬가지의 과정을 거친다.
num_col_regular <- which(sapply(regular_season_batter_day, is.numeric))
regular_season_batter_day[,num_col_regular][is.na(regular_season_batter_day[,num_col_regular])] <- 0

특이하게, 1999,2000시즌 몇 선수들은 안타를 쳤는데도 SLG이 0이거나 출루를 했는데도 OBP가 0인 경우가 있다. 이런 데이터를 지워준다.

#그러한 특이한 데이터의 행번호를 찾는다.
View(regular_season_batter %>%
       rownames_to_column() %>%
       filter((H>0&SLG==0)|((H>0|BB>0|HBP>0)&OBP==0))
       )

regular_season_batter <- regular_season_batter[-c(479,747,1458,1675,1676,1935,1936),]

동명이인이 있는지 확인한다. unique()함수로 batter_id의 단일개수를 알아내고 batter_name의 단일개수를 알아낸 후 두 값이 같은지 본다. 확인결과 동명이인은 없다.

length(unique(regular_season_batter$batter_id))==length(unique(regular_season_batter$batter_name))
length(unique(regular_season_batter_day$batter_id))==length(unique(regular_season_batter_day$batter_name))

이제 규정타석을 정의내리자.

scale_x_continuous()함수의 breaks 옵션은 축 눈금의 위치와 값을 조정한다.

ggplot(regular_season_batter, aes(AB,OPS)) +
  geom_point(alpha=0.1) +
  scale_x_continuous(breaks=seq(min(regular_season_batter$AB), max(regular_season_batter$AB),by=30)) +
  geom_vline(xintercept = 30,
             color='blue', size=1, linetype='dashed') +
  theme(legend.position='none')

위 산점도를 보면 30타석 이상부터는 극단치가 줄어든 것을 확인할 수 있다.

직접 boxplot에 저장된 극단치값을 확인하여보자. out 변수는 극단치 값을 저장하고 있다.

kable() 함수는 함수 안에 표에 표시하기를 원하는 데이터명을 기재하기만 하면, 별도의 제목행 구분 등의 작업 없이도 간단히 표를 그릴 수 있다.

outliers <- boxplot(regular_season_batter$OPS, plot=FALSE)$out
kable(regular_season_batter[regular_season_batter$OPS %in% outliers,] %>%
        arrange(desc(AB)) %>%
        select(c('batter_name','year','AB','OPS')) %>%
        head(10))

#결과
|batter_name | year|  AB|       OPS|
|:-----------|----:|---:|---------:|
|테임즈      | 2015| 472| 1.2936556|
|강정호      | 2014| 418| 1.2001563|
|유재신      | 2018|  33| 1.1920000|
|김원섭      | 2005|  25| 0.1169231|
|이여상      | 2013|  22| 0.0909091|
|문규현      | 2007|  18| 0.1090000|
|김회성      | 2010|  17| 0.1050000|
|정경운      | 2018|  15| 0.1300000|
|정병곤      | 2018|  15| 0.1300000|
|현재윤      | 2014|  15| 1.2291667|

테임즈나 강정호를 제외하면 33타석 이하에서 극단치가 나타나는 것으로 보인다.

이제 과거의 성적을 만들어주는 lag_function()을 정의해보자. 이 함수는 past년 전 기록을 lag1_변수명 으로 추가해주는 함수이다.

paste0()은 각 요소를 공백 없이 이어붙여준다.

assign()은 변수에 값을 할당해준다.

# data_Set: 이용할 데이터 dataset type : tibble
# var_name: lag를 만들 변수 이름  type: character
# past : 몇넌전 lag 만들지결정   type : num
lag_function <- function(data_set, var_name, past) {
  data_set <- as.tibble(data_set)
  for(j in c('AB',var_name)){
    assign(paste0("lag",past),c())
    for(i in 1:nrow(data_Set)){
      q <- data_set[(data_set$batter_name==data_set$batter_name[i])&(data_set$year==data_set$year[i]-past),j]
      q <- as.data.frame(q)
      if(nrows(q)==0){
        assign(paste0("lag",past),c(get(paste0("lag",past)),NA))
      }else{
        assign(paste0("lag",past),unlist(c(get(paste0("lag",past)),unname(q))))
      }
    }
    data_Set[,paste0("lag",past,"_",j)] <- get(paste0("lag",past))
    
  }
  index_delete <- which(data_set[,paste0("lag",past,"_","AB")]<30)
  data_set[,paste0("lag",past,"_",var_name)][index_delete,] <-NA
  data_Set[,pastee0("lag",past,"_","AB")] <- NULL
  return(data_Set)
}

numvars <- names(which(sapply(regular_season_batter, is.numeric)))
#제외할 변수를 dropvars에 넣어준다.
dropvars <- c('batter_id','year','OPS','SLG')
#숫자 변수 중 dropvars가 아닌 것들만 numvars에 넣어준다.
numvars <- numvars[which(!numvars %in% dropvars)]

regular_season <- regular_season_batter[,c(numvars,'year','batter_name')]
regular_season <- regular_season %>% filter(AB>=30)

#lag_function으로 1년 전 기록을 추가해준다
for(i in numvars){
  regular_season <- lag_function(regular_season,i,1)
}
#select로 현재기록을 제외하고 1년 전 기록만 남긴다.
regular_season <- regular_season %>%
  select(-c(numvars[-which(numvars %in% 'OBP')], 'batter_name', 'year'))

#결측치 있는 행은 과감히 삭제한다.
regular_season <- na.omit(regular_season)

3. 변수 간 관계 파악 및 변수 추가

이제 본격적으로 1년전 기록과 현재 OBP 간의 상관관계를 분석해보자. cor()함수를 사용하면 상관관계를 알 수 있다. 아래 결과를 보면 볼넷이 가장 높은 상관관계(0.522)를 기록하고, , 루타수(TB), 타점, 1년전 출루율, 득점이 그 뒤를 잇는 걸 알 수 있다.

cor_num <- cor(regular_season)
#OBP에 대한 값만을 추출하기 위해 아래처럼 코드 작성. . 내림차순으로 정렬한다.
cor_sorted <- as.matrix(sort(cor_num[,'OBP'],decreasing=T))

#결과
OBP      1.00000000
lag1_BB  0.52235664
lag1_TB  0.49232182
lag1_RBI 0.48325952
lag1_OBP 0.47518685
lag1_R   0.47126124
lag1_H   0.46729040
lag1_HR  0.43891406
lag1_X2B 0.43742370
lag1_avg 0.39288288
lag1_GDP 0.34561438
lag1_G   0.32088934
lag1_SO  0.29747768
lag1_HBP 0.28285334
lag1_CS  0.18706980
lag1_SB  0.16206058
lag1_X3B 0.13508503
lag1_E   0.07634018

#상관관계 히트맵을 그려준다.
corrplot.mixed(cor_num[rownames(cor_sorted),rownames(cor_sorted)], tl.col='black', tl.pos='lt', tl.cex=0.7, cl.cex=0.7)

#앞서 만든 변수들을 지워준다.
rm(regular_season, cor_num, cor_sorted)

이제 전반기 OBP를 계산한 후 1,2,3년 전 OBP를 생성할 것이다.

각 선수의 전반기 OBP를 계산할 것인데, Day_by_Day 데이터에는 희생타 정보가 없기 때문에, regular_Season_batter 데이터에서 한 타석당 평균 희생타를 계산한 후 전반기 희생타를 구할 것이다.

#출루율 공식을 역산하여 희생타 변수를 만들기
regular_season_batter <- regular_season_batter %>%
  mutate(SF = round((H+BB+HBP)/OBP-(AB+BB+HBP),0))
#희생타가 결측치라면 0으로 바꿔주기
regular_season_batter$SF[is.nan(regular_season_batter$SF)] <- 0

#한 타석당 평균 희생타 정보를 담은 데이터 만들기
regular_season_batter_SF <- regular_season_batter %>%
  mutate(SF_1 = SF/AB) %>%
  select(batter_name, year, SF_1)

이제 전반기 OBP를 계산하기 위한 타석, 안타, 볼넷, 몸에맞는볼 정보를 가진 데이터를 만들 것이다.

sum_hf_yr_OBP <- regular_season_batter_day %>%
  filter(date<=7.18) %>%
  group_by(batter_name, year) %>%
  summarise(AB=sum(AB), H= sum(H), BB=sum(BB), HBP=sum(HBP))

그러고 앞서 만든 희생타 정보 데이터(regular_season_batter_SF)와 sum_hf_yr_OBP를 합쳐준다.

sum_hf_yr_OBP <- left_join(sum_hf_yr_OBP, regular_season_batter_SF, by=c('batter_name','year'))
#SF_1 변수는 타석당 희생타 정보이므로 이를 타석 수로 곱해줘서 희생타 총 개수로 만들어준다.
sum_hf_yr_OBP <- sum_hf_yr_OBP %>%
  mutate(SF=round(SF_1*AB,0)) %>%
  select(-SF_1)

이제 최종적으로 전반기 OBP를 계산해주자. 결측치는 역시 0으로 만든다.

sum_hf_yr_OBP <- sum_hf_yr_OBP %>%
  mutate(OBP=(H+BB+HBP)/(AB+BB+HBP+SF))

sum_hf_yr_OBP$OBP[is.nan(sum_hf_yr_OBP$OBP)] <-0

#필요 없는 변수와 객체는 이제 삭제하자
sum_hf_yr_OBP <- sum_hf_yr_OBP %>%
  select(batter_name, year, AB, OBP)

rm(regular_season_batter_SF)

나이 역시도 출루율에 미치는 중요한 요소이다. 나이와 평균 출루율의 관계를 그래프로 알아보자.

#우선 나이 변수를 생성한다.
regular_season_batter <- regular_season_batter %>%
  mutate(age=year-as.numeric(substr(year_born,1,4)))

ggplot(regular_season_batter %>%
         filter(AB>=30) %>%
         group_by(age) %>%
         summarise(mean_OBP=mean(OBP), median_OBP=median(OBP))) +
  geom_line(aes(x=age, y=mean_OBP),color="#00AFBB", size=1.5, show.legend=TRUE)+
  geom_point(aes(x=age, y=mean_OBP),color='#00AFBB', size=5, show.legend=TRUE)

30세 전후로 출루율이 커리어 하이를 보이는 듯하다.

이제 sum_hf_yr_OBP에 나이 변수(age)도 추가해준다.

batter_age <- regular_season_batter %>%
  select(batter_name, year, age)

batter_age$batter_nmae <- as.character((batter_age$batter_name))
sum_hf_yr_OBP <- left_join(sum_hf_yr_OBP, batter_age, by=c('batter_name', 'year'))

앞서 생성한 lag_function으로 1,2,3년 전 OBP를 추가해준다.

sum_hf_yr_OBP <- lag_function(sum_hf_yr_OBP,"OBP",1)
sum_hf_yr_OBP <- lag_function(sum_hf_yr_OBP,"OBP",2)
sum_hf_yr_OBP <- lag_function(sum_hf_yr_OBP,"OBP",3)

그런데 과거 OBP를 추가하다보니 결측치가 발생했다. 이를 처리해주자.

#결측치의 수를 확인해보자
rbind('counts'=colSums(is.na(sum_hf_yr_OBP)),"%"=round(colSums(is.na(sum_hf_yr_OBP))/1386,2))

#결과
       batter_name  year AB OBP age batter_name lag1_OBP lag2_OBP lag3_OBP
counts           0    0  0   0   0           0   569.00   749.00   843.00
%                0    0  0   0   0           0     0.41     0.54     0.61

과거의 OBP 결측치는 ‘각 선수의 OBP의 평균’과 ‘그 해 전체 선수 OBP의 평균’의 평균으로 대체할 것이다.

우선 각 선수별 OBP 평균부터 구하자

player_OBP_mean <- regular_season_batter %>%
  filter(AB>=30) %>%
  group_by(batter_name) %>%
  summarise(AB = sum(AB), H = sum(H), BB = sum(BB), HBP = sum(HBP), SF = sum(SF)) %>% 
  mutate(mean_OBP = (H+BB+HBP)/(AB +BB+HBP+SF)) %>% 
  select(batter_name, mean_OBP)

player_OBP_mean$batter_name <- as.character(player_OBP_mean$batter_name)

그리고 시즌별 OBP 평균을 구하자

season_OBP_mean <- regular_season_batter %>%
  filter(AB>=30) %>%
  group_by(year) %>%
  summarise(AB = sum(AB),H = sum(H), BB = sum(BB), HBP = sum(HBP), SF = sum(SF))

season_OBP_mean <- season_OBP_mean %>%
  mutate(mean_OBP = (H+BB+HBP)/(AB +BB+HBP+SF)) %>% select(year, mean_OBP)

이제 선수별 OBP 평균은 sum_hf_yr_OBP에 새로운 변수로 넣어준다. 이 때 OBP평균이 결측치인 행들은 없애버린다.

sum_hf_yr_OBP <- left_join(sum_hf_yr_OBP, player_OBP_mean, by='batter_name')
sum_hf_yr_OBP <- sum_hf_yr_OBP[-which(is.na(sum_hf_yr_OBP$mean_OBP)),]

결측치를 채워넣는 함수를 선언하자.

lag_na_fill <- function(data_set, var_name, past, season_var_mean_data){
  for(i in 1:nrow(data_set)){
    if(is.na(data_set[[paste0("lag",past,"_",var_name)]][i])){
      data_set[[paste0("lag",past,"_",var_name)]][i] <- (data_set[[paste0("mean",'_',var_name)]][i] +
                                                           season_var_mean_data[[paste0('mean','_',var_name)]][season_var_mean_data[['year']] %in% (data_set[['year']][i]-past)])/2
    }
  }
  return (data_set)
}

#선언한 함수로 1,2,3년 전 결측치를 채워준다.
sum_hf_yr_OBP <- lag_na_fill(sum_hf_yr_OBP, 'OBP', 1, season_OBP_mean)
sum_hf_yr_OBP <- lag_na_fill(sum_hf_yr_OBP, 'OBP', 2, season_OBP_mean)
sum_hf_yr_OBP <- lag_na_fill(sum_hf_yr_OBP, 'OBP', 3, season_OBP_mean)

이제는 SLG(장타율)을 계산할 차례이다. OBP에서 했던 과정을 똑같이 거치면 된다.

numvars <- names(which(sapply(regular_season_batter, is.numeric)))
dropvars <- c('batter_id', 'year', 'OPS', 'OBP')
numvars <- numvars[which(!numvars %in% dropvars)]

regular_season <- regular_season_batter[,c(numvars,'year','batter_name')]
regular_season <- regular_season %>%
  filter(AB>=30)

for(i in numvars){
  regular_season <- lag_function(regular_season, i, 1)
}
regular_season <- regular_season %>%
  select(-c(numvars[-which(numvars %in% 'SLG')],'batter_name','year'))
regular_season <- na.omit(regular_season)

cor_num <- cor(regular_season)
cor_sorted <- as.matrix(sort(cor_num[,'SLG'], decreasing=T))
corrplot.mixed(cor_num[rownames(cor_sorted),rownames(cor_sorted)], tl.col = "black", tl.pos = "lt", tl.cex = 0.7, cl.cex = 0.7)

장타율과 각 기록간의 상관관계를 히트맵으로 나타내면 아래와 같다.

이제 사용한 객체를 지워준다.

rm(regular_season, cor_num, cor_sorted)

장타율 역시도 전반기 데이터를 만들어준다.

sum_hf_yr_SLG <- regular_season_batter_day %>%
  filter(date<=7.18) %>%
  group_by(batter_name, year) %>%
  summarise(AB=sum(AB), H=sum(H), X2B=sum(X2B), X3B=sum(X3B), HR=sum(HR))

#SLG 변수를 추가해준다.
sum_hf_yr_SLG <- sum_hf_yr_SLG %>%
  mutate(SLG = (H-(X2B+X3B+HR) + X2B*2 + X3B*3 + HR*4)/AB)

#결측치는 0으로 바꾼다.
sum_hf_yr_SLG$SLG[is.nan(sum_hf_yr_SLG$SLG)] <- 0

#필요한 열만 추출한다.
sum_hf_yr_SLG <- sum_hf_yr_SLG %>%
  select(batter_name, year, AB, SLG)

앞서 나이 정보를 담은 batter_age 테이블을 만들었었다. 이를 SLG테이블과 결합한다.

sum_hf_yr_SLG <- left_join(sum_hf_yr_SLG, batter_age, by=c('batter_name', 'year'))

1,2,3년 전 SLG를 추가해준다.

sum_hf_yr_SLG <- lag_function(sum_hf_yr_SLG, 'SLG', 1)
sum_hf_yr_SLG <- lag_function(sum_hf_yr_SLG, 'SLG', 2)
sum_hf_yr_SLG <- lag_function(sum_hf_yr_SLG, 'SLG', 3)

이제 각 선수별 SLG 평균과 시즌별 SLG 평균을 구해준다.

#각 선수별 SLG 평균
player_SLG_mean <- regular_season_batter %>%
  filter(AB>=30) %>%
  group_by(batter_name) %>%
  summarise(AB=sum(AB), H=sum(H), X2B=sum(X2B), X3B=sum(X3B), HR=sum(HR)) %>%
  mutate(mean_SLG = ((H-X2B-X3B-HR)+ X2B*2 + X3B*3 + HR*4)/AB) %>%
  select(batter_name, mean_SLG)

player_SLG_mean$batter_name <- as.character(player_SLG_mean$batter_name)

#시즌별 SLG 평균
season_SLG_mean <- regular_season_batter %>%
  filter(AB>=30) %>%
  group_by(year) %>%
  summarise(AB=sum(AB), H=sum(H), X2B=sum(X2B), X3B=sum(X3B), HR=sum(HR)) %>%
  mutate(mean_SLG = ((H-X2B-X3B-HR)+ X2B*2 + X3B*3 + HR*4)/AB) %>%
  select(year, mean_SLG)

sum_hf_yr_SLG 테이블에 선수별 SLG평균을 추가할 것이다.

sum_hf_yr_SLG <- left_join(sum_hf_yr_SLG, player_SLG_mean, by='batter_name')

#평균 SLG가 없는 행은 지워버린다.
sum_hf_yr_SLG <- sum_hf_yr_SLG[-which(is.na(sum_hf_yr_SLG$mean_SLG)),]

#1,2,3년 전 결측치를 매꿔준다.
sum_hf_yr_SLG <- lag_na_fill(sum_hf_yr_SLG, 'SLG', 1, season_SLG_mean)
sum_hf_yr_SLG <- lag_na_fill(sum_hf_yr_SLG, 'SLG', 2, season_SLG_mean)
sum_hf_yr_SLG <- lag_na_fill(sum_hf_yr_SLG, 'SLG', 3, season_SLG_mean)

모델링 파트는 다음 글에서 이어집니다.

Twitter Facebook LinkedIn

Hee Jun Kim🍀

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

1. 데이터준비

2. 결측치, 이상치 대체

3. 변수 간 관계 파악 및 변수 추가

공유하기

참고

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

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

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

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