brunch

You can make anything
by writing

C.S.Lewis

by 이준 Dec 22. 2020

피파19 플레이어 가치 예측하기

선형회귀모델을 활용해 피파19플레이어 가치 예측하기

Kaggle 데이터를 뒤져보던 중 재밌는 데이터를 발견했다.

그것은 바로! 피파 19 선수 로스터 데이터!

게임을 좋아하기도 하고, 실제로 재밌게 하기도 했기 때문에 오늘은 이 데이터를 가지고 코드리뷰를 해보고자 한다. 

그럼 시작해보자!

데이터는 요 데이터를 활용했다.  data.csv  8.66MB

혹은 직접 캐글 사이트에서 다운도 가능하다. https://www.kaggle.com/karangadiya/fifa19   FIFA 19 complete player dataset  18k+ FIFA 19 players, ~90 attributes extracted from the latest FIFA database  www.kaggle.com


데이터 탐색

우선 데이터의 정보부터 읽어보자. 

data.csv includes lastest edition FIFA 2019 players attributes like

Age, Nationality, Overall, Potential, Club, Value, Wage, Preferred Foot, International Reputation, Weak Foot, Skill Moves, Work Rate, Position, Jersey Number, Joined, Loaned From, Contract Valid Until, Height, Weight, LS, ST, RS, LW, LF, CF, RF, RW, LAM, CAM, RAM, LM, LCM, CM, RCM, RM, LWB, LDM, CDM, RDM, RWB, LB, LCB, CB, RCB, RB, Crossing, Finishing, Heading, Accuracy, ShortPassing, Volleys, Dribbling, Curve, FKAccuracy, LongPassing, BallControl, Acceleration, SprintSpeed, Agility, Reactions, Balance, ShotPower, Jumping, Stamina, Strength, LongShots, Aggression, Interceptions, Positioning, Vision, Penalties, Composure, Marking, StandingTackle, SlidingTackle, GKDiving, GKHandling, GKKicking, GKPositioning, GKReflexes, and Release Clause. 

대략 나이, 국가, 능력치, 잠재력, 소속 클럽, 가치부터 어떤 포지션인지를 비롯해 세부 능력치까지 갖고 있다.


#1  Fifa <-  read.csv("./data/fifa/data.csv", header = T, stringsAsFactors = F) head(Fifa) 

#2  Fifa$ValueLast <- sapply(strsplit(as.character(Fifa$Value), ""), tail, 1) Fifa$WageLast <- sapply(strsplit(as.character(Fifa$Wage), ""), tail, 1) Fifa$Release.Clause.Last <- sapply(strsplit(as.character(Fifa$Release.Clause), ""), tail, 1)


#1 

데이터를 불러왔을 때, '유효하지 않은 멀티바이트 문자열 1입니다.' 라는 에러가 발생한다.

해결방법은 다음과 같다. 

1) 메모장으로 데이터 파일 열기 2)다른이름으로 저장 클릭3) 인코딩 부분이 UTF-8 이런식으로 되어있을텐데 이걸 ANSI로 바꿔준다. 4) 저장옵션을 모든파일로 변경 후 .csv 로 저장 

위의 과정을 거쳐주면 에러없이 데이터를 불러올 수 있다. 


#2

as. character() : 해당값을 문자열로 변환

strsplit() : 문자열을 뒷 조건으로 분리하기

- €110.5M 라는 데이터를 "" 조건으로 분리하면 "€" "1"  "1"  "0"  "."  "5"  "M" 가 된다.

sapply(): 해당열의 문자를, tail()함수 조건으로 가져온다. 여기서는 맨 뒤의 한 글자(1)만 가져온다. 

함수적용 전과 후

가치, 급료, 방출조항금액의 단위를 새로운 열로 만들었다.

#1 extract <- function(x){   regexp <- "[[:digit:]]+"   str_extract(x, regexp) }

#2 temp1 <- sapply(Fifa$Value, extract) Fifa$Value <- as.numeric(temp1) temp2 <- sapply(Fifa$Wage, extract) Fifa$Wage <- as.numeric(temp2) temp3 <- sapply(Fifa$Release.Clause, extract) Fifa$Release.Clause <- as.numeric(temp3)


#1

function(x): 아래와 같은 함수를 정의한다. 

"[[:digit:]]+":  정규식 표현이다. [:digit:] 숫자인 것들을 의미한다.

str_extract():  매칭된 문자열을 추출하는 함수다. 

extract란 변수는 문자열 중에 숫자가 들어간 문자열을 가져오는 함수가 포함된 것이다. 

#2

임의 변수 temp1 에 Value 컬럼에서 숫자가 들어간 문자열을 저장한다.

해당 숫자를 numeric 형태로 저장한다.

나머지의 temp1, temp2, temp3도 같은 원리로 저장한다.


#1 Fifa$Wage <- ifelse(Fifa$WageLast == "M", Fifa$Wage * 1000000, Fifa$Wage * 1000) Fifa$Value <- ifelse(Fifa$ValueLast == "M", Fifa$Value * 1000000, Fifa$Value * 1000) Fifa$Release.Clause <- ifelse(Fifa$Release.Clause.Last == "M", Fifa$Release.Clause * 1000000, Fifa$Release.Clause * 1000) 

#2 Fifa$Contract.Valid.Until <- as.numeric(Fifa$Contract.Valid.Until) Fifa$Remaining.Contract <- Fifa$Contract.Valid.Until - 2019 Fifa$Height.Inch <- str_split(Fifa$Height,"'") 


#1

돈 단위를 통일해준다.

Fifa$WageLast의 값이 M이면 곱하기 1000000을, 그렇지 않으면 1000을 해준다.

마찬가지로 급료, 가치, 방출조항의 단위도 통일한다. 

#2

계약 유효 기간은 숫자형태로 변경해준다.

남은 잔여 기간을 계산해준다.

Height의 변수들에서 ' 을 기준으로 나눠준다.

단위가 사라지고 통일된 변화값과 추가된 잔여 기간, 무게와 키 변수

temp5 <- strsplit(Fifa$Height, "'") 

#1 for (i in 1:length(temp5)){   temp5[[i]] <- as.numeric(temp5[[i]]) }  

#2 for (i in 1:length(temp5)){   temp5[[i]] <- (temp5[[i]][1] * 12 ) + temp5[[i]][2] } 

#3 temp6 <- as.numeric(unlist(temp5)) Fifa$Height <- temp6

temp5에 height 변수에 ' ' '를 기준으로 나눈 값을 저장한다. 

6'7 를 6피트 7인치로 나눠서 계산할 수 있도록 하기위함이다. 


#1

계산을 위해 for문을 활용해 해당 값을 numeric 형태로 바꿔준다. 

#2

현재 키가 피트기준으로 되어있으니, 해당 숫자를 cm 기준으로 바꿔준다.

1피트 = 12cm , 1인치 = 2.54cm 

#3

최종적으로 해당 숫자를 numeric 형태로 바꿔서 Height 변수에 저장한다.


#1 dff <- Fifa[,29:54] #2 def_fun <- function(x){   a <- strsplit(x, '\\+')   for (i in length(a)){     b <- sum(as.numeric(a[[i]]))   }   return (b) } for (i in 1: ncol(dff)){   dff[i] <- apply(dff[i], 1, FUN = def_fun) } 

#3 Fifa[,29:54] <- NULL Fifa <- cbind.data.frame(Fifa, dff)

#1

데이터 중 포지션에 해당하는 열을 저장한다. 

#2

해당 값이 한번 이상 반복된 값을 a에 저장하고 그 a의값을 숫자로 변환한 값의 합을 b에 저장해 b를 반환하는 함수를 만든다.

다시 dff에 저장된 변수값을 위의 함수에 적용해 저장한다. 

#3

Fifa[,29:54] 열을 NULL 값으로 채우고, Fifa 데이터에 해당 값을 열에 추가한다.  

이제 기본적인 데이터 전처리가 끝났다. 


가장 가치있는 팀은 어디일까?

#1 Fifa %>%   group_by(Club)%>%   summarise(Club.Squad.Value = round(sum(Value)/1000000))%>%   arrange(-Club.Squad.Value)%>%   head(10)%>%      

#2   ggplot(aes(x = as.factor(Club) %>%                fct_reorder(Club.Squad.Value), y = Club.Squad.Value, label = Club.Squad.Value))+   geom_text(hjust = 0.01,inherit.aes = T, position = "identity")+   geom_bar(stat = "identity", fill = "violetred1")+   coord_flip()+   xlab("Club")+   ylab("Squad Value in Million")

#1

클럽별로 우선 group_by 를 진행한다.

summarise()활용해 클럽의 스쿼드 가치는 계산한다. 보기 좋도록 스쿼드 가치는 가치의 합을 1000000으로 나눈값을 반올림해준다.

해당값을 arrange() 함수로 정렬한다. -없이 계산하면 내림차순으로 -를 넣으면 오름차순으로 볼 수 있다. 

#2 

편의상 2개로 나눠 보자면,

이제 해당 데이터를 ggplot를 활용해 그려볼 차례다.

x축은 club을, y축은 각 club의 가치로 놓는다.fct_reorder() 는 범주 순서를 바꿔준다.coord_flip() 는 x축과 y축 구성을 바꿔준다. 

실행하면 위와 같은 그래프를 확인할 수 있다.

레알 마드리드, 바르셀로나, 맨시티 순으로 볼 수 있다. 


가장 높은 급료를 지출하는 팀들

Fifa %>%   group_by(Club)%>%   summarise(Total.Wage = round(sum(Wage)/1000000, digits =2))%>%   arrange(-Total.Wage)%>%   head(10)%>%   ggplot(aes(x = as.factor(Club) %>%                fct_reorder(Total.Wage), y = Total.Wage, label = Total.Wage))+   geom_text(hjust = 0.01,inherit.aes = T, position = "identity")+   geom_bar(stat = "identity", fill = "violetred1")+   coord_flip()+   xlab("Club")+   ylab("Squad Wages in Million")


위와 내용이 같기에, 별도 설명은 덧붙히지 않는다.

레알 마드리드가 가장 많은 급료를 지출하고 있음을 볼 수 있다. 


슈퍼스타를 가장 많이 보유한 팀은?

게임 특성 상 슈퍼스타의 정의는 능력치를 활용해서 알아볼 수 있다. 능력치가 86이상이면 슈퍼스타로 간주했다.


Fifa %>%   mutate(Superstar = ifelse(Overall> 86, "Superstar","Non - Superstar"))%>%   group_by(Club)%>%   filter(Superstar=="Superstar")%>%   summarise(Player.Count = n())%>%   arrange(-Player.Count)%>%   ggplot(aes(x = as.factor(Club) %>%                fct_reorder(Player.Count), y = Player.Count, label = Player.Count))+   geom_text(hjust = 0.01,inherit.aes = T, position = "identity")+   geom_bar(stat = "identity", fill = "palegreen2")+   coord_flip()+   xlab("Club")+   ylab("Number of Superstars")

레알마드리드와 바르셀로나가 투톱으로 가장 많다. 


최고 가치 클럽의 연령 분포는 어떻게 될까?

#1 Most.Valued.Clubs <- Fifa %>%   group_by(Club)%>%   summarise(Club.Squad.Value = round(sum(Value)/1000000))%>%   arrange(-Club.Squad.Value)%>%   head(10) Player.List <- list() 

#2 for (i in 1:nrow(Most.Valued.Clubs)){   temp.data <-  Fifa%>%     filter(Club == Most.Valued.Clubs[[1]][i])       Player.List[[i]] <- temp.data } 

#3 data <- lapply(Player.List, as.data.frame) %>% bind_rows() data$Club <- as.factor(data$Club) ggplot(data, aes(x = Club ,y = Age, fill = Club)) +   geom_violin(trim = F)+   geom_boxplot(width = 0.1)+   theme(axis.text.x = element_text(angle = 90), legend.position = "none")+   ylab("Age distribution amongst Clubs") 

#1

클럽 기준으로 오름차순으로 클럽가치를 그룹핑해서 정렬한다.

list()함수를 Player.List에 저장한다. 

#2

가장 가치있는 클럽의 클럽명과 일치하는 변수를 임시변수에 저장한다. 

#3 

lapply 함수를 이용해 list에 저장된 값을 데이터프레임으로 변환한다.

club 열의 값을 factor 값으로 변환하고 저장한다.

ggplot 그래프를 그릴 때, 이번에는 boxplot으로 그린다. 

토트넘은 인상적인 분포를 갖고 있다. 평균 나이가 20대 중반으로 본격적으로 선수들의 능력이 두드러지는 시기이기도 하다.  

파리 생제르망은 선수 연령대가 매우 폭이 넓다. 부폰, 티아구실바 등의 영향일 것이다.

  

등번호가 실제 능력치하고 연관이 있을까?

Fifa %>%   group_by(Jersey.Number) %>%   summarise(Avg.Overall = sum(Overall)/length(Jersey.Number),             Player.Count = sum(Jersey.Number))%>%   arrange(-Avg.Overall)%>%   ggplot(aes(x = Jersey.Number, y = Avg.Overall,col = ifelse(Avg.Overall < 70,"darkgrey", "Red")))+   geom_point(position = "jitter")+   theme(legend.position = "none")+   geom_text_repel(aes(label = ifelse(Avg.Overall > 70, Jersey.Number, "")))

실제 번호에 따라 능력치와 어떤 인과관계를 보이진 않겠지만,

주로 능력치가 높은 선수들이 선호하는 번호를 살펴볼 수 있을 것 같다. 

등번호로 그룹핑해서 평균 능력치를 구한다.

평균 능력치는 등 번호의 개수를 능력의 합을 나눠 구한다.

이를 다시 평균 능력치로 정렬한다. 

79번은 전체 평균을 구성하는 선수가 2명뿐인 이상치이다.

역시 축구는 팀의 에이스를 상징하는 10번임을 알 수 있드시, 10번의 능력치가 가장 높다.  


선수 가치 예측

#1 Fifa_Int <- Fifa[ , map_lgl(Fifa, is.numeric)] mcor<- as.data.frame(cor(Fifa_Int, use = "complete.obs")) 

#2 temp7 <- mcor["Value"] temp8 <- subset(temp7, Value > 0.30) temp9 <- rownames(temp8) 

#3 library(caTools) set.seed(101) sample = sample.split(Fifa, SplitRatio = 0.6) train <- subset(Fifa, sample == TRUE) test <- subset(Fifa, sample == FALSE) fit <- lm(Value ~ Overall + Potential + Wage + International.Reputation + Skill.Moves + Release.Clause, data = train, na.action = na.omit) summary(fit)

#1

map_lgf() : 적용할 함수를 통해 명칭 혹은 위치를 지정해서 리스트 원소를 추출한다.

Fifa 데이터프레임의 데이터를 숫자형인지 아닌지 여부를 반환한다.

위의 값을 Fifa_Int에 저장한다. 

cor() 는 상관관계 분석을 위한 함수다.

Fifa_Int를 상관관계 분석을 실시해 데이터프레임으로 저장한다.

complete.obs는 결측값 처리방식이다. 

#2

mcor의 Value 값만 저장하고, subset() 함수를 이용해 그 중 Value 값이 0.30보다 큰 것을 저장한다.

행 이름을 해당 값으로 정해준다. 

#3

caTool 패키지를 활용해 쉽게 훈련용 데이터와 테스트 데이터를 구할 수 있다. 

예측모델을 만들기 위해 테스트와 훈련 데이터를 나누는 과정이다. 

set.seed() : 난수가 같은 값이 추출되도록 고정시켜준다.

sample.split() : 해당 데이터를 40%, 60% 비율로 나눠준다.

train 과 test 데이터를 넣는다. 

lm() 함수로 선형회귀 모델을 만들어 볼 수 있다. 

종속변수 Value에 미치는 독립변수를 뒤에 넣은 것이다.

그럼 아래와 같은 값을 확인할 수 있다.


lm(formula = Value ~ Overall + Potential + Wage + International.Reputation +      Skill.Moves + Release.Clause, data = train, na.action = na.omit) Residuals:      Min       1Q   Median       3Q      Max  -5866554   -93728     3620   100509 12394540  Coefficients:                            Estimate Std. Error t value Pr(>|t|)     (Intercept)              -6.594e+05  9.448e+04  -6.979 3.16e-12 *** Overall                   1.160e+04  1.349e+03   8.600  < 2e-16 *** Potential                -7.435e+03  1.436e+03  -5.176 2.31e-07 *** Wage                      6.421e+00  5.549e-01  11.571  < 2e-16 *** International.Reputation  4.379e+05  2.184e+04  20.051  < 2e-16 *** Skill.Moves               3.056e+04  9.103e+03   3.358 0.000789 *** Release.Clause            4.848e-01  1.205e-03 402.225  < 2e-16 *** --- Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 Residual standard error: 622300 on 9914 degrees of freedom   (928 observations deleted due to missingness) Multiple R-squared:  0.9882, Adjusted R-squared:  0.9882  F-statistic: 1.379e+05 on 6 and 9914 DF,  p-value: < 2.2e-16


Value 값을 설명하는데 각 값들이 얼마나 영향을 갖고 있는지 계산한 것이다.

Pr(>|t|), 즉 p값을 보았을 때 해당값이 현저히 작으므로 유의하다는 것을 알 수 있다.

유의하다는 것은 Overall, Porential, Wage 등의 독립변수가 가치에 미치는 영향이 높다고 추정된다고 말할 수 있다. 


그 아래 Multiple R-squared 값은 해당  분석이 얼마나 잘 설명하고 있는 지를 이야기하는데, 약 98.8%로 높은 설명력을 갖고 있다고 할 수 있다. 


이제 실제 해당 모델이 얼마나 잘 예측하는 지를 테스트 데이터를 통해 맞춰보자.


#1 test_fit <- predict(fit, newdata = test) test_fit <- round(test_fit,0) test$Predicted.Value <- test_fit 

#2 library(dplyr) temp12 <- test[c("Name","Value","Predicted.Value")] temp12 <- temp12 %>%   mutate(Difference = Value - Predicted.Value ) 

#3 temp12$Accuracy <- ifelse(temp12$Difference > 0.20 * temp12$Value , "No",ifelse(temp12$Difference < -(0.20 * temp12$Value),"No", "Yes")) table(temp12$Accuracy) 

#1

predict()를 이용해 예측된 값이 실측 값과 같은 값을 보이는 지 알 수 있다.

test 데이터가 얼마나 fit한지 계산하고 해당 값을 test_fit에 저장한다.

해당 값은 예측 값 열을 별도로 만들어 저장한다. 

#2

Name, Value, Predicted.Value 값만 가져와 데이터프레임을 만들어 저장한다. 

해당열에 Difference 열을 추가하고 값과 예측값을 뺴준다. 

#3

정확도 확인을 위해 그 차이가 +-가치*0.2를 한 것보다 크면 NO를 아니면 YES로 한다.

이 값을 오차 범위를 20%로 정했다.

그럼 아래와 같은 값을 확인할 수 있다.


temp12 <- temp12 %>% +   mutate(Difference = Value - Predicted.Value ) > temp12$Accuracy <- ifelse(temp12$Difference > 0.20 * temp12$Value , "No",ifelse(temp12$Difference < -(0.20 * temp12$Value),"No", "Yes")) > table(temp12$Accuracy)  


No  Yes  2548 4174 


정확도는 6,722개의 전체 데이터중 4,174개가 오차범위 20% 안에서 일치했으므로, 

62.09% 라고 할 수 있다. 


마무리

적용된 많은 함수를 찾아 고민하다보니 꽤 오랜 시간이 걸렸다.직접 데이터를 그려보고, 예측 모델까지 진행해보았던 것에 만족한다. 


해당 데이터 분석에 사용된 라이브러리는 아래와 같다.

library(ggrepel) library(gghighlight) library(fmsb) library(reshape2) library(colorspace) library(purrr) library(forcats) library(dplyr) library(plotly) library(stringr) library(leaflet) library(ggmap) library(ggplot2) library(caTools)      

매거진의 이전글 시간과 온도에 따른 자전거 대여 수 예측 변화
작품 선택
키워드 선택 0 / 3 0
댓글여부
afliean
브런치는 최신 브라우저에 최적화 되어있습니다. IE chrome safari