ProyectoFundamentos
Alvaro Fortun Sierra
30/11/2020
Basketball Players Stats per Season
Data set: https://www.kaggle.com/jacobbaruch/basketball-players-stats-per-season-49-leagues/discussion/192472
Descripción de variables:
- League: Liga de baloncesto donde juega el jugador
- Season: Temporada
- Stage: Temporada regular o play-offs (Post-season)
- Player: Nombre del Jugador
- Team: Equipo del jugador
- GP: Partidos jugados
- MIN: Minutos jugados
- FGM: Tiros de campo acertados
- FGA: Tiros de campo intentados
- X3PM: Tiros de 3 puntos encestados
- X3PA: Tiros de 3 puntos intentados
- FTM: Tiros libres encestados
- FTA: Tiros libres intentados
- TOV: Pérdidas de balón
- PF: Faltas Personales
- ORB: Rebotes ofensivos
- DRB: Rebotes defensivos
- REB: Rebotes totales
- AST: ASistencias
- BLK: Tapones
- PTS: Puntos
- birth_year: Año de nacimiento
- birth_month: Mes de nacimiento
- birth_date: Fecha de nacimiento
- height: Altura en “pies”
- height_cm: Altura en cm
- weight: Peso en “Pounds”
- weight_kg: Peso en Kg
- nationality: Nacionalidad del Jugador
- high_school: Instituto donde jugó el Jugador
Objetivos del proyecto
- Identificar que variables son las mas significativas para determinar los puntos de un Jugador NBA a partir de un análisis exploratorio y un remodelado de la estructura de los datos. Finalmente, a partir de como sea la relación de las variables con el output se presentará un modelo de regresión con respecto a la variable PTS.
El siguiente conjunto de datos corresponde a las estadísticas de jugadores de baloncesto de 49 ligas de baloncesto desde la temporada 1999 hasta 2020. El objetivo del proyecto es ver cuales son las variables más significativas a tener en cuenta para poder determinar con mayor precisión los puntos que un jugador puede meter a partir de la información que pueden dar otras estadísticas. Actualmente, el baloncesto, difiere mucho entre estilos de juego, por tanto, se van a coger datos de la liga Americana, con el objetivo de simplificar el número de observaciones y ver si hay algún tipo de estadítica que resulte sorprendente. Se llevarán a cabo análisis de las estadísitcas en conjunto pero también de manera específica, para poder ver como afecta de verdad cada parte del juego. Ej: rebotes ofensivos frente a defensivos.
Librerías necesarias:
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(car)## Warning: package 'car' was built under R version 4.0.3## Loading required package: carData## Warning: package 'carData' was built under R version 4.0.3##
## Attaching package: 'car'## The following object is masked from 'package:dplyr':
##
## recodelibrary(corrplot)## Warning: package 'corrplot' was built under R version 4.0.3## corrplot 0.84 loadedlibrary(GGally)## Loading required package: ggplot2## Registered S3 method overwritten by 'GGally':
## method from
## +.gg ggplot2library(ggplot2)
library(gridExtra)##
## Attaching package: 'gridExtra'## The following object is masked from 'package:dplyr':
##
## combineCarga de datos y primera visualización
datos= read.csv("./players_stats_by_season_full_details.csv", sep = ",")
str(datos)## 'data.frame': 53798 obs. of 31 variables:
## $ League : chr "NBA" "NBA" "NBA" "NBA" ...
## $ Season : chr "2019 - 2020" "2019 - 2020" "2019 - 2020" "2019 - 2020" ...
## $ Stage : chr "Regular_Season" "Regular_Season" "Regular_Season" "Regular_Season" ...
## $ Player : chr "James Harden" "Damian Lillard" "Devin Booker" "Giannis Antetokounmpo" ...
## $ Team : chr "HOU" "POR" "PHX" "MIL" ...
## $ GP : int 68 66 70 63 60 61 57 67 69 62 ...
## $ MIN : num 2483 2474 2512 1917 2120 ...
## $ FGM : int 672 624 627 685 546 581 593 643 602 551 ...
## $ FGA : int 1514 1349 1283 1238 1249 1255 1303 1303 1342 1096 ...
## $ X3PM : int 299 270 141 89 205 171 170 148 173 72 ...
## $ X3PA : int 843 674 398 293 568 541 481 425 473 218 ...
## $ FTM : int 692 460 468 398 481 426 386 264 278 444 ...
## $ FTA : int 800 518 509 629 559 562 458 381 322 525 ...
## $ TOV : int 308 194 264 230 289 260 194 261 184 154 ...
## $ PF : int 227 114 213 195 104 153 126 118 172 156 ...
## $ ORB : int 70 33 29 140 32 78 52 65 53 143 ...
## $ DRB : int 376 251 268 716 223 495 190 459 251 435 ...
## $ REB : int 446 284 297 856 255 573 242 524 304 578 ...
## $ AST : int 512 530 456 354 560 538 347 684 294 200 ...
## $ STL : int 125 70 49 61 65 60 71 78 70 91 ...
## $ BLK : int 60 22 18 66 8 14 23 36 14 143 ...
## $ PTS : int 2335 1978 1863 1857 1778 1759 1742 1698 1655 1618 ...
## $ birth_year : int 1989 1990 1996 1994 1998 1999 1993 1984 1996 1993 ...
## $ birth_month: chr "Aug" "Jul" "Oct" "Dec" ...
## $ birth_date : chr "Aug 26, 1989" "Jul 15, 1990" "Oct 30, 1996" "Dec 6, 1994" ...
## $ height : chr "6-5" "6-3" "6-6" "6-11" ...
## $ height_cm : int 196 191 198 211 188 201 191 203 191 208 ...
## $ weight : chr "220" "195" "206" "242" ...
## $ weight_kg : int 100 88 93 110 82 99 94 113 98 115 ...
## $ nationality: chr "United States" "United States" "United States" "Greece / Nigeria" ...
## $ high_school: chr "Artesia High School" "Oakland High School" "Moss Point High School" "" ...En esta primera visualización de los datos vemos que ya hay variables que no van a ser importantes para nuestro output PTS, como por ejemplo, el nombre de los jugadores, el equipo, la temporada…
- Analísis de valores nulos y Obtención de solo aquellos datos que pertenezcan a la NBA:
Nas = any(complete.cases(datos))
if (Nas){
datosLimpios = datos[complete.cases(datos),]
}
numeroNas = length(datos[,1])-length(datosLimpios[,1])
#Obtenemos los datos de la NBA
datosNBA = datosLimpios %>%
filter(datosLimpios$League == "NBA")Análisis de variables para la NBA
Se tiene un total de 31 variables, de las cuales muchas son meramente informativas, pero que no aportan ningún tipo de valor a nuestro output. Variables como la temporada, si es playoff o temporada regular, el año, el nombre de jugador, el equipo y la liga son variables que se pueden eliminar para hacer más sencillo el análisis y el modelado. En primer lugar eliminamos dichas variables:
str(datosLimpios)## 'data.frame': 49073 obs. of 31 variables:
## $ League : chr "NBA" "NBA" "NBA" "NBA" ...
## $ Season : chr "2019 - 2020" "2019 - 2020" "2019 - 2020" "2019 - 2020" ...
## $ Stage : chr "Regular_Season" "Regular_Season" "Regular_Season" "Regular_Season" ...
## $ Player : chr "James Harden" "Damian Lillard" "Devin Booker" "Giannis Antetokounmpo" ...
## $ Team : chr "HOU" "POR" "PHX" "MIL" ...
## $ GP : int 68 66 70 63 60 61 57 67 69 62 ...
## $ MIN : num 2483 2474 2512 1917 2120 ...
## $ FGM : int 672 624 627 685 546 581 593 643 602 551 ...
## $ FGA : int 1514 1349 1283 1238 1249 1255 1303 1303 1342 1096 ...
## $ X3PM : int 299 270 141 89 205 171 170 148 173 72 ...
## $ X3PA : int 843 674 398 293 568 541 481 425 473 218 ...
## $ FTM : int 692 460 468 398 481 426 386 264 278 444 ...
## $ FTA : int 800 518 509 629 559 562 458 381 322 525 ...
## $ TOV : int 308 194 264 230 289 260 194 261 184 154 ...
## $ PF : int 227 114 213 195 104 153 126 118 172 156 ...
## $ ORB : int 70 33 29 140 32 78 52 65 53 143 ...
## $ DRB : int 376 251 268 716 223 495 190 459 251 435 ...
## $ REB : int 446 284 297 856 255 573 242 524 304 578 ...
## $ AST : int 512 530 456 354 560 538 347 684 294 200 ...
## $ STL : int 125 70 49 61 65 60 71 78 70 91 ...
## $ BLK : int 60 22 18 66 8 14 23 36 14 143 ...
## $ PTS : int 2335 1978 1863 1857 1778 1759 1742 1698 1655 1618 ...
## $ birth_year : int 1989 1990 1996 1994 1998 1999 1993 1984 1996 1993 ...
## $ birth_month: chr "Aug" "Jul" "Oct" "Dec" ...
## $ birth_date : chr "Aug 26, 1989" "Jul 15, 1990" "Oct 30, 1996" "Dec 6, 1994" ...
## $ height : chr "6-5" "6-3" "6-6" "6-11" ...
## $ height_cm : int 196 191 198 211 188 201 191 203 191 208 ...
## $ weight : chr "220" "195" "206" "242" ...
## $ weight_kg : int 100 88 93 110 82 99 94 113 98 115 ...
## $ nationality: chr "United States" "United States" "United States" "Greece / Nigeria" ...
## $ high_school: chr "Artesia High School" "Oakland High School" "Moss Point High School" "" ...datosNBA = datosNBA %>%
select(GP,MIN,FGM,FGA,X3PM,X3PA,FTM,
FTA,TOV,PF,ORB,DRB,REB,AST,
STL,BLK,PTS,birth_year,height_cm,weight_kg,
nationality)Una vez hemos hecho una primera limpieza de datos, vamos a ver cómo es la estructura otra vez de esos datos y estebecemos cuales de ellos tienen que calmbiar el formato. En este caso la mayoría de variables son numéricas, no obstente, variables como la nacionalidad deben ponerse como factores.
datosNBA$nationality <- as.factor(datosNBA$nationality)
str(datosNBA)## 'data.frame': 7490 obs. of 21 variables:
## $ GP : int 68 66 70 63 60 61 57 67 69 62 ...
## $ MIN : num 2483 2474 2512 1917 2120 ...
## $ FGM : int 672 624 627 685 546 581 593 643 602 551 ...
## $ FGA : int 1514 1349 1283 1238 1249 1255 1303 1303 1342 1096 ...
## $ X3PM : int 299 270 141 89 205 171 170 148 173 72 ...
## $ X3PA : int 843 674 398 293 568 541 481 425 473 218 ...
## $ FTM : int 692 460 468 398 481 426 386 264 278 444 ...
## $ FTA : int 800 518 509 629 559 562 458 381 322 525 ...
## $ TOV : int 308 194 264 230 289 260 194 261 184 154 ...
## $ PF : int 227 114 213 195 104 153 126 118 172 156 ...
## $ ORB : int 70 33 29 140 32 78 52 65 53 143 ...
## $ DRB : int 376 251 268 716 223 495 190 459 251 435 ...
## $ REB : int 446 284 297 856 255 573 242 524 304 578 ...
## $ AST : int 512 530 456 354 560 538 347 684 294 200 ...
## $ STL : int 125 70 49 61 65 60 71 78 70 91 ...
## $ BLK : int 60 22 18 66 8 14 23 36 14 143 ...
## $ PTS : int 2335 1978 1863 1857 1778 1759 1742 1698 1655 1618 ...
## $ birth_year : int 1989 1990 1996 1994 1998 1999 1993 1984 1996 1993 ...
## $ height_cm : int 196 191 198 211 188 201 191 203 191 208 ...
## $ weight_kg : int 100 88 93 110 82 99 94 113 98 115 ...
## $ nationality: Factor w/ 94 levels "Angola","Argentina",..: 75 75 75 33 75 64 75 75 75 75 ...Análisis exploratorio
- A partir de las 22 variables que obtenemos del apartado anterior. LLevamos a cabo un primer análisis exploratiorio para ver correlaciones o posibles outliers En primer lugar, a partir del comando ‘summary’ vemos como estan ditribuidos los datos en cada una de las variables restantes:
summary(datosNBA)## GP MIN FGM FGA
## Min. : 1.00 Min. : 0.7 Min. : 0.0 Min. : 0.0
## 1st Qu.:12.00 1st Qu.: 277.2 1st Qu.: 39.0 1st Qu.: 88.0
## Median :66.00 Median :1344.2 Median :173.0 Median : 379.0
## Mean :49.38 Mean :1314.6 Mean :208.7 Mean : 456.6
## 3rd Qu.:77.00 3rd Qu.:2133.3 3rd Qu.:322.0 3rd Qu.: 712.0
## Max. :85.00 Max. :3485.0 Max. :978.0 Max. :2173.0
##
## X3PM X3PA FTM FTA
## Min. : 0.00 Min. : 0.0 Min. : 0.0 Min. : 0.0
## 1st Qu.: 1.00 1st Qu.: 5.0 1st Qu.: 19.0 1st Qu.: 26.0
## Median : 14.00 Median : 42.0 Median : 67.0 Median : 90.0
## Mean : 40.62 Mean : 112.5 Mean :103.7 Mean :135.8
## 3rd Qu.: 69.00 3rd Qu.: 197.0 3rd Qu.:148.0 3rd Qu.:197.0
## Max. :402.00 Max. :1028.0 Max. :756.0 Max. :972.0
##
## TOV PF ORB DRB
## Min. : 0.00 Min. : 0.0 Min. : 0.00 Min. : 0.0
## 1st Qu.: 14.00 1st Qu.: 27.0 1st Qu.: 11.00 1st Qu.: 35.0
## Median : 61.00 Median :116.0 Median : 35.00 Median :146.0
## Mean : 75.21 Mean :110.8 Mean : 59.72 Mean :172.3
## 3rd Qu.:116.00 3rd Qu.:176.0 3rd Qu.: 87.00 3rd Qu.:254.0
## Max. :464.00 Max. :371.0 Max. :440.00 Max. :894.0
##
## REB AST STL BLK
## Min. : 0 Min. : 0 Min. : 0.00 Min. : 0.00
## 1st Qu.: 47 1st Qu.: 19 1st Qu.: 8.00 1st Qu.: 4.00
## Median : 186 Median : 73 Median : 34.00 Median : 14.00
## Mean : 232 Mean :122 Mean : 41.44 Mean : 26.66
## 3rd Qu.: 344 3rd Qu.:169 3rd Qu.: 64.00 3rd Qu.: 34.00
## Max. :1247 Max. :925 Max. :225.00 Max. :307.00
##
## PTS birth_year height_cm weight_kg
## Min. : 0.0 Min. :1961 Min. :160.0 Min. : 61.0
## 1st Qu.: 106.0 1st Qu.:1977 1st Qu.:193.0 1st Qu.: 91.0
## Median : 459.0 Median :1982 Median :201.0 Median :100.0
## Mean : 561.8 Mean :1982 Mean :200.8 Mean :100.8
## 3rd Qu.: 863.0 3rd Qu.:1988 3rd Qu.:208.0 3rd Qu.:109.0
## Max. :2832.0 Max. :2000 Max. :229.0 Max. :147.0
##
## nationality
## United States:5965
## France : 129
## Canada : 90
## Spain : 79
## Argentina : 63
## Brazil : 60
## (Other) :1104Tras echar un vistazo al summary, se aprecia que la mayoría de variables son bastante estables, no obstante se ve que en algunas la media y la mediana están bastante dispersas.
Estas variables son sobre todo las variables que describen los puntos, asi como los porcentajes de acierto. Esto nos da una idea de las dispersión de los datos en estas variables y nos da una idea de cómo de diferentes son los jugadores en esta liga ya que si miramos al acierto de 3 puntos varia desde 14 aciertos a una media de 40 aciertos por temporada
En el siguiente gráfico nos vamos a hacer una idea de como es nuestro output, es decir, qué distribución representan los datos para la variable ‘PTS’ que son los puntos, que queremeos predecir:
hist(datosNBA$PTS, main = "Puntos Totales", xlab = "puntos" , ylab = "Frecuencia")
En este histograma hay un claro sesgo hacia la derecha. Es decir, la mayoria de puntos se acumulan en 1/3 del total. Todo esto puede deberse a que hay muchos jugadores que juegan muy pocos minutos y que no aportan a este campo, lo que no quiere decir que no ayuden a otros jugadores de su equipo a generar esos puntos.
Parece que las variable nacinality tiene un elevado numero de factores y el procesamiento de los datos puede dar problemas. Este problema puede ser muy común en muchos set de datos y no se puede eliminar la variable directamente. Vamos a llevar a cabo un análisis primero para ver su distribución. En el caso que la mayoría de factores sean de uno o dos paises, y el restos sean paises que representen a un solo jugador, se procederá a elimnar la variable ya que no aportaría mucha información puesto que la mayoría de jugadores pertenecen a ese país:
nacionalidades = datosNBA$nationality
summary(nacionalidades)## Angola
## 1
## Argentina
## 63
## Argentina / Italy
## 4
## Australia
## 53
## Austria
## 6
## Bahamas
## 5
## Belgium / France
## 2
## Bosnia and Herzegovina
## 8
## Bosnia and Herzegovina / Croatia
## 13
## Brazil
## 60
## Cameroon
## 22
## Canada
## 90
## Canada / Bahamas
## 9
## Canada / Haiti
## 13
## Canada / South Africa
## 21
## Canada / United States
## 5
## China
## 8
## Croatia
## 23
## Czech Republic
## 8
## Democratic Republic of the Congo
## 18
## Dominican Republic
## 7
## Dominican Republic / United States
## 22
## England / Nigeria
## 2
## England / South Sudan
## 15
## England / United States
## 15
## Finland
## 4
## France
## 129
## France / United States
## 13
## Georgia
## 22
## Germany
## 50
## Germany / United States
## 20
## Greece / Georgia
## 1
## Greece / Nigeria
## 11
## Haiti
## 6
## Israel
## 4
## Italy
## 30
## Italy / United States
## 9
## Latvia
## 15
## Lithuania
## 51
## Mali
## 2
## Mexico
## 10
## Montenegro
## 3
## Montenegro / Spain
## 7
## Netherlands
## 2
## Netherlands / South Sudan
## 5
## Netherlands / United States
## 4
## New Zealand
## 13
## New Zealand / Australia
## 7
## Nigeria
## 4
## Nigeria / England
## 4
## Nigeria / United States
## 3
## North Macedonia
## 3
## North Macedonia / Turkey
## 4
## Panama
## 1
## Poland
## 16
## Puerto Rico / United States
## 21
## Republic of the Congo / Spain
## 19
## Russia
## 20
## Saint Lucia / Canada
## 1
## Saint Vincent and the Grenadines / United States
## 6
## Senegal
## 14
## Serbia
## 56
## Serbia / Greece
## 20
## Slovenia
## 59
## South Sudan / Australia
## 7
## Spain
## 79
## Sweden
## 13
## Switzerland
## 24
## Switzerland / Montenegro
## 7
## Switzerland / Turkey
## 11
## Tanzania
## 1
## Tunisia
## 3
## Turkey
## 57
## Ukraine
## 14
## United States
## 5965
## United States / Australia
## 9
## United States / Croatia
## 1
## United States / Democratic Republic of the Congo
## 3
## United States / Dominican Republic
## 11
## United States / Egypt
## 3
## United States / Germany
## 15
## United States / Greece
## 10
## United States / Israel
## 1
## United States / Jamaica
## 4
## United States / Lebanon
## 5
## United States / Lithuania
## 6
## United States / Nigeria
## 23
## United States / Norway
## 3
## United States / Philippines
## 8
## United States / Puerto Rico
## 13
## United States / Qatar
## 6
## United States / Spain
## 14
## United States / Turkey
## 4
## Venezuela
## 8jugadoresUSA = datosNBA %>%
filter(nationality == "United States") %>%
count()
pricentajeJugadoresUsa = jugadoresUSA/length(nacionalidades)
pricentajeJugadoresUsa## n
## 1 0.7963952Con este resumen de los paises a los que pertenecen los jugadores se puede ver como ningún pais a parte de Estados Unidos supera los 100 jugadores, es decir, Estados Unidos representa casi un 80% de todos los jugadores presentes en la NBA. Por tanto, ya que no nos aporta mucha variabilidad ni información, se puede proceder a eliminar dicha variable:
datosNBA = datosNBA[-21]
str(datosNBA)## 'data.frame': 7490 obs. of 20 variables:
## $ GP : int 68 66 70 63 60 61 57 67 69 62 ...
## $ MIN : num 2483 2474 2512 1917 2120 ...
## $ FGM : int 672 624 627 685 546 581 593 643 602 551 ...
## $ FGA : int 1514 1349 1283 1238 1249 1255 1303 1303 1342 1096 ...
## $ X3PM : int 299 270 141 89 205 171 170 148 173 72 ...
## $ X3PA : int 843 674 398 293 568 541 481 425 473 218 ...
## $ FTM : int 692 460 468 398 481 426 386 264 278 444 ...
## $ FTA : int 800 518 509 629 559 562 458 381 322 525 ...
## $ TOV : int 308 194 264 230 289 260 194 261 184 154 ...
## $ PF : int 227 114 213 195 104 153 126 118 172 156 ...
## $ ORB : int 70 33 29 140 32 78 52 65 53 143 ...
## $ DRB : int 376 251 268 716 223 495 190 459 251 435 ...
## $ REB : int 446 284 297 856 255 573 242 524 304 578 ...
## $ AST : int 512 530 456 354 560 538 347 684 294 200 ...
## $ STL : int 125 70 49 61 65 60 71 78 70 91 ...
## $ BLK : int 60 22 18 66 8 14 23 36 14 143 ...
## $ PTS : int 2335 1978 1863 1857 1778 1759 1742 1698 1655 1618 ...
## $ birth_year: int 1989 1990 1996 1994 1998 1999 1993 1984 1996 1993 ...
## $ height_cm : int 196 191 198 211 188 201 191 203 191 208 ...
## $ weight_kg : int 100 88 93 110 82 99 94 113 98 115 ...Correlciones Como todas nuestras variables resultantes son numéricas, se procede a ver sus correlaciones
#LLevamos a cabo el grafico para las variables numéricas
numvars <- sapply(datosNBA, class) %in% c("integer","numeric")
C <- cor(datosNBA[,numvars])
corrplot(C, method = "circle")
Relaciones significativas - FGM-FGA - FTm-FTA - x3pa - x3pm - DRB-REB - ORB-REB - PTS-MIN - PTS-FGA - PF-GP - FGM-PTS - FGA-PTS
Hay unas correlaciones bastante altas en esas variables que se refieren al acierto en el tiro y sus intentos. Si miramos la relacion entre FGM y FGA (Tiros de campo encestados) y (Tiros de campo intentado) respectivamente, se aprecia una relación muy elevada. En estos casos, como no sabemos como pueden influir en los modelos, lo mas seguro sería unirlas en una sola variable es decir, poner estas variables como porcentajes, FGM/FGA, y reducir así el número de variables. Lo mismo pasa con FTM-FTA y X3pA-X3PM
#datosNBA$FGM/datosNBA$FGA
#datosNBA$FGM
#datosNBA$FGA#aquellos que son cero daran indeterminaciones NAs por lo que los pondremos a cero posteriormente.
datosNBA$FGPercent = datosNBA$FGM/datosNBA$FGA
datosNBA$FTPercent = datosNBA$FTM/datosNBA$FTA
datosNBA$X3Percent = datosNBA$X3PM/datosNBA$X3PA
datosNBA = datosNBA %>%
select(GP,MIN,FGPercent,X3Percent,FTPercent,
TOV,PF,ORB,DRB,REB,AST,
STL,BLK,PTS,birth_year,height_cm,weight_kg)
datosNBA %>%
count(is.na(FGPercent))## is.na(FGPercent) n
## 1 FALSE 7488
## 2 TRUE 2datosNBA$FGPercent[is.na(datosNBA$FGPercent)] = 0
datosNBA %>%
count(is.na(X3Percent))## is.na(X3Percent) n
## 1 FALSE 6651
## 2 TRUE 839datosNBA$X3Percent[is.na(datosNBA$X3Percent)] = 0
datosNBA %>%
count(is.na(FTPercent))## is.na(FTPercent) n
## 1 FALSE 7416
## 2 TRUE 74datosNBA$FTPercent[is.na(datosNBA$FTPercent)] = 0Volvemos a ver las correlaciones con las nuevas variables y vemos como la mayoría de variables están relativamente poco correlacionadas.
numvars <- sapply(datosNBA, class) %in% c("integer","numeric")
C <- cor(datosNBA[,numvars])
corrplot(C, method = "circle")
Una vez hemos hecho una primera limipeza de datos y una pequeña reestructuración es hora de ver la relacion directa de nuestras variables input con respecto a nuestra variable output: PTS
p1 = ggplot(data= datosNBA,aes(y =PTS , x = GP)) +
geom_point(position = position_jitter(w = 0, h = 0.02))
p2 = ggplot(data= datosNBA,aes(y =PTS , x = MIN)) +
geom_point(position = position_jitter(w = 0, h = 0.02))
p3 = ggplot(data= datosNBA,aes(y =PTS , x = FGPercent)) +
geom_point(position = position_jitter(w = 0, h = 0.02))
p4 = ggplot(data= datosNBA,aes(y =PTS , x = X3Percent)) +
geom_point(position = position_jitter(w = 0, h = 0.02))
p5 = ggplot(data= datosNBA,aes(y =PTS , x = FTPercent)) +
geom_point(position = position_jitter(w = 0, h = 0.02))
p6 = ggplot(data= datosNBA,aes(y =PTS , x = TOV)) +
geom_point(position = position_jitter(w = 0, h = 0.02))
p7 = ggplot(data= datosNBA,aes(y =PTS , x = PF)) +
geom_point(position = position_jitter(w = 0, h = 0.02))
p8 = ggplot(data= datosNBA,aes(y =PTS , x = ORB)) +
geom_point(position = position_jitter(w = 0, h = 0.02))
p9 = ggplot(data= datosNBA,aes(y =PTS , x = DRB)) +
geom_point(position = position_jitter(w = 0, h = 0.02))
p10 = ggplot(data= datosNBA,aes(y =PTS , x = REB)) +
geom_point(position = position_jitter(w = 0, h = 0.02))
p11 = ggplot(data= datosNBA,aes(y =PTS , x = AST)) +
geom_point(position = position_jitter(w = 0, h = 0.02))
p12 = ggplot(data= datosNBA,aes(y =PTS , x = STL)) +
geom_point(position = position_jitter(w = 0, h = 0.02))
p13 = ggplot(data= datosNBA,aes(y =PTS , x = BLK)) +
geom_point(position = position_jitter(w = 0, h = 0.02))
p14 = ggplot(data= datosNBA,aes(y =PTS , x = birth_year)) +
geom_point(position = position_jitter(w = 0, h = 0.02))
p15 = ggplot(data= datosNBA,aes(y =PTS , x = height_cm)) +
geom_point(position = position_jitter(w = 0, h = 0.02))
p16 = ggplot(data= datosNBA,aes(y =PTS , x = weight_kg)) +
geom_point(position = position_jitter(w = 0, h = 0.02))
grid.arrange(p1,p2,p3,p4,p5,p6,p7,p8,ncol = 2)
grid.arrange(p9,p10,p11,p12,p13,p14,p15,p16, ncol =2)
Relaciones significativas a primera vista y que resultan curiosas - Evidentemente la variable MIN (minutos) va a ser una de las mas importantes para nuestro output No obstante, se ve que la variable TOV también afecta de manera positiva a nuestro output, parece curioso que cuanto mayor cantidad de perdidas (TOV), mayor cantidad de puntos. No obstante, parece que puede tener sentido, ya que aquellos jugadore que juegan más minutos, pueden ser aquellos que tengan un mayor número de perididas. Si nos fijamos en el grafico de correlación entre variables anterior, se aprecia que la relación entre TOV y MIN es también bastante elevada.
Otras relaciones importantes: Los robos (STL) afectan también de manera positva a los PTS, no tanto como la cantidad de asistencias. Esto último tiene sentido ya que las asistencias son los pases que un jugador da, para que otro jugador enceste.
Se aprecian también algunos plots donde es posible que haya ciertas interacciones entre variables. Por ejemplo, en el caso de los rebotes ofensivos o los tapones (BLK), la distribución con respecto al output parece que depende de otra variable, en este caso podría ser la altura. Por este, motivos, vamos a ver la relación poniendo como factor la variable altura:
datosNBA$height_cm <- as.factor(datosNBA$height_cm)
str(datosNBA)## 'data.frame': 7490 obs. of 17 variables:
## $ GP : int 68 66 70 63 60 61 57 67 69 62 ...
## $ MIN : num 2483 2474 2512 1917 2120 ...
## $ FGPercent : num 0.444 0.463 0.489 0.553 0.437 ...
## $ X3Percent : num 0.355 0.401 0.354 0.304 0.361 ...
## $ FTPercent : num 0.865 0.888 0.919 0.633 0.86 ...
## $ TOV : int 308 194 264 230 289 260 194 261 184 154 ...
## $ PF : int 227 114 213 195 104 153 126 118 172 156 ...
## $ ORB : int 70 33 29 140 32 78 52 65 53 143 ...
## $ DRB : int 376 251 268 716 223 495 190 459 251 435 ...
## $ REB : int 446 284 297 856 255 573 242 524 304 578 ...
## $ AST : int 512 530 456 354 560 538 347 684 294 200 ...
## $ STL : int 125 70 49 61 65 60 71 78 70 91 ...
## $ BLK : int 60 22 18 66 8 14 23 36 14 143 ...
## $ PTS : int 2335 1978 1863 1857 1778 1759 1742 1698 1655 1618 ...
## $ birth_year: int 1989 1990 1996 1994 1998 1999 1993 1984 1996 1993 ...
## $ height_cm : Factor w/ 23 levels "160","165","175",..: 11 9 12 17 8 13 9 14 9 16 ...
## $ weight_kg : int 100 88 93 110 82 99 94 113 98 115 ...ggplot(datosNBA) +
geom_point(aes(x = BLK, y = PTS, color = height_cm))
ggplot(datosNBA) +
geom_point(aes(x = ORB, y = PTS, color = height_cm))
ggplot(datosNBA) +
geom_point(aes(x = AST, y = PTS, color = height_cm))
Ejectivamente, hay una clara distinción entre los puntos dependiendo de la altura del jugador, no obstante, llama la atención que el hecho de ser mas alto no implica meter más puntos, pero sí, poner más tapones.
EN el caso de las asistencias AST, se aprecia que los jugadores menos altos, son aquello que reparten más asistencias, es decir, aquellos jugadores que juegan en la posición de base.
Dado que la variable REB simplemente parece aportar lo mismo que el conjunto de ORB y DRB, se elimina.
#Eliminamos la variable rebotes puesto que aporta lo mismo que ORB y DRB
datosNBA = datosNBA %>%
select(GP,MIN,FGPercent,X3Percent,FTPercent,
TOV,PF,ORB,DRB,AST,
STL,BLK,PTS,birth_year,height_cm,weight_kg)Resumen análisis exploratorio:
- En el análisis exploratorio se ha hecho repaso de todas las variables originales que componían el data set. En primer lugar se ha visto como era el formato de dichas variables y la naturaleza de los datos. Se han analizado valores nulos y se han eliminados variables que a simple vista son poco significativas.
- Se ha visto un resumen de como están distribuidos los datos de cada variable para poder extraer conclusiones y aplicarlas posteriormente.
- Se ha analizado la distribución de la variable output PTS
- Se ha reducido notablemente la cantidad de variables iniciales pasando de 31 variables a 16 variables sin valores nulos y sin niveles de correlación excesivamente altos entre las variables resultantes. Finalmente, se han analizado todas las variables con respecto al output para hacernos una idea de cuáles puedes ser aquellas que afecten en mayor medida a nuestro output.
Model Training
- Dado que se ha visto que las relaciones entre la mayoría de las variables con respecto a nuestro output es mayoritariamente lineal, excepto algunas interacciones, el modelo que se va a entrenar va a ser un modelo de regresión lineal, donde se analizarán cuales son las variables más significativas y se verán diferentes modelos con diferente selección de variables
- Se van a analizar diferentes métodos para ver cual es el mas preciso y adecuado para poder determinar la cantidad de puntos que un jugador puede meter a partir del conocimiento de otras variables.
- Por otro lado también veremos cuales son las variables más significativas en cada modelo para este output y determinar así en que puntos fuertes los observadores se tienen que fijar para pode fichar a un jugador anotado.
En primer lugar, dividimos nuestro data set en un set de entrenamiento y otro de test:
library(caret)## Loading required package: latticelibrary(ggplot2)
library(GGally)
library(leaps)## Warning: package 'leaps' was built under R version 4.0.3library(glmnet)## Warning: package 'glmnet' was built under R version 4.0.3## Loading required package: Matrix## Loaded glmnet 4.0-2library(pls)## Warning: package 'pls' was built under R version 4.0.3##
## Attaching package: 'pls'## The following object is masked from 'package:caret':
##
## R2## The following object is masked from 'package:corrplot':
##
## corrplot## The following object is masked from 'package:stats':
##
## loadingslibrary(car)
library(corrplot)
library(MLTools)## __ __ _ _________
## | \ / | | | |___ ___| _____ _____ _ _____
## | \/ | | | ____ | | | _ | | _ | | | | ___|
## | |\ /| | | | |____| | | | | | | | | | | | | |___ |
## | | \/ | | | |____ | | | |_| | | |_| | | |__ ___| |
## |_| |_| |______| |_| |_____| |_____| |____| |_____|
##
## Learning is fun, Machine Learning is funnier
## -----------------------------------------
## With great power comes great responsibility
## -----------------------------------------## Created by:
## José Portela González <Jose.Portela@iit.comillas.edu>
## Guillermo Mestre Marcos <Guillermo.Mestre@comillas.edu>
## Jaime Pizarroso Gonzalo <jpizarroso@comillas.edu>
## Antonio Muñoz San Roque <antonio.munoz@iit.comillas.edu>##
## Escuela Técnica Superior de Ingeniería ICAIset.seed(150)
#particion 80/20
trainIndex <- createDataPartition(datosNBA$PTS, #nuestra variable output
p = 0.8, #particion para training
list = FALSE, #evitar que el output salga como lista
times = 1) #realizamos solo una particion
fTR <- datosNBA[trainIndex,]
fTS <- datosNBA[-trainIndex,]
## Inivializamos el trainControl -----------------------------------------------------------------------
#Hacemos una validación cruzada de 10 folds
ctrl_tune <- trainControl(method = "cv",
number = 10,
summaryFunction = defaultSummary,
returnResamp = "final",
savePredictions = TRUE) Regresión Lineal:
En primer lugar establceremos un modelos re regresiónlineal ya que la mayoría de las relaciones parecian seguir esta distribucion con respecto a nuestor output. EL objetivo de esta primera regresion lineal es ver cuales de las variables no son significativas para este modelo y poder ir eliminandolas hasta obtener el óptimo
set.seed(150)
lm.fit = train(form = PTS~.,
data = fTR,
method = "lm", #Linear model
tuneGrid = data.frame(intercept = TRUE),
#preProcess = c("center","scale"),
trControl = ctrl_tune,
metric = "RMSE")## Warning in predict.lm(modelFit, newdata): prediction from a rank-deficient fit
## may be misleadinglm.fit #information about the resampling settings## Linear Regression
##
## 5994 samples
## 15 predictor
##
## No pre-processing
## Resampling: Cross-Validated (10 fold)
## Summary of sample sizes: 5394, 5394, 5396, 5394, 5395, 5395, ...
## Resampling results:
##
## RMSE Rsquared MAE
## 144.332 0.9187241 98.34349
##
## Tuning parameter 'intercept' was held constant at a value of TRUEsummary(lm.fit) ##
## Call:
## lm(formula = .outcome ~ ., data = dat)
##
## Residuals:
## Min 1Q Median 3Q Max
## -693.25 -64.00 -3.42 59.27 1008.34
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -5.258e+03 5.095e+02 -10.318 < 2e-16 ***
## GP -2.837e+00 1.605e-01 -17.682 < 2e-16 ***
## MIN 4.501e-01 8.140e-03 55.292 < 2e-16 ***
## FGPercent 2.954e+02 3.040e+01 9.718 < 2e-16 ***
## X3Percent 1.004e+02 1.338e+01 7.507 6.92e-14 ***
## FTPercent 1.520e+02 1.398e+01 10.875 < 2e-16 ***
## TOV 4.277e+00 8.431e-02 50.725 < 2e-16 ***
## PF -1.287e+00 7.029e-02 -18.317 < 2e-16 ***
## ORB -7.053e-01 6.922e-02 -10.190 < 2e-16 ***
## DRB 3.088e-01 3.572e-02 8.645 < 2e-16 ***
## AST -7.041e-01 3.377e-02 -20.853 < 2e-16 ***
## STL -1.174e-01 1.136e-01 -1.033 0.3015
## BLK -2.069e-01 8.983e-02 -2.303 0.0213 *
## birth_year 2.503e+00 2.548e-01 9.824 < 2e-16 ***
## height_cm165 5.593e+01 1.246e+02 0.449 0.6535
## height_cm175 8.858e+01 1.090e+02 0.812 0.4166
## height_cm178 -1.242e+02 1.080e+02 -1.150 0.2501
## height_cm180 -7.084e+01 1.047e+02 -0.677 0.4987
## height_cm183 -4.598e+01 1.026e+02 -0.448 0.6541
## height_cm185 -9.194e+01 1.023e+02 -0.898 0.3690
## height_cm188 -8.881e+01 1.025e+02 -0.867 0.3860
## height_cm191 -7.228e+01 1.023e+02 -0.707 0.4797
## height_cm193 -1.009e+02 1.024e+02 -0.985 0.3245
## height_cm196 -8.881e+01 1.025e+02 -0.867 0.3862
## height_cm198 -8.100e+01 1.025e+02 -0.790 0.4293
## height_cm201 -1.031e+02 1.025e+02 -1.006 0.3145
## height_cm203 -8.589e+01 1.026e+02 -0.837 0.4027
## height_cm206 -8.044e+01 1.027e+02 -0.783 0.4335
## height_cm208 -6.350e+01 1.028e+02 -0.617 0.5369
## height_cm211 -7.656e+01 1.029e+02 -0.744 0.4570
## height_cm213 -7.063e+01 1.032e+02 -0.684 0.4939
## height_cm216 -1.001e+02 1.040e+02 -0.963 0.3356
## height_cm218 -1.357e+02 1.066e+02 -1.273 0.2029
## height_cm221 -3.799e+01 1.074e+02 -0.354 0.7236
## height_cm224 3.023e+01 1.767e+02 0.171 0.8642
## height_cm229 -8.736e+01 1.110e+02 -0.787 0.4314
## weight_kg 1.196e+00 2.951e-01 4.054 5.10e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 143.7 on 5957 degrees of freedom
## Multiple R-squared: 0.9194, Adjusted R-squared: 0.9189
## F-statistic: 1887 on 36 and 5957 DF, p-value: < 2.2e-16#Identify correlated variables
vif(lm.fit$finalModel)## GP MIN FGPercent X3Percent FTPercent TOV
## 7.383841 17.924620 1.326436 1.491790 1.213725 9.512446
## PF ORB DRB AST STL BLK
## 9.030532 5.931350 8.888174 6.733841 5.061042 3.026423
## birth_year height_cm165 height_cm175 height_cm178 height_cm180 height_cm183
## 1.099806 3.003518 8.041231 9.008016 18.996299 71.644120
## height_cm185 height_cm188 height_cm191 height_cm193 height_cm196 height_cm198
## 125.691356 103.466888 226.953168 172.314532 172.957521 225.374193
## height_cm201 height_cm203 height_cm206 height_cm208 height_cm211 height_cm213
## 307.955666 277.031647 333.569254 251.653267 251.634182 162.737164
## height_cm216 height_cm218 height_cm221 height_cm224 height_cm229 weight_kg
## 52.983307 15.880307 12.804664 1.512429 7.741120 3.778272#Evaluate the model with training sets and diagnosis
fTR_eval = fTR
fTR_eval$lm_pred = predict(lm.fit, newdata = fTR)
fTS_eval = fTS
fTS_eval$lm_pred = predict(lm.fit, newdata = fTS)
#Analysis of residuals
PlotModelDiagnosis(fTR, fTR$PTS, fTR_eval$lm_pred,
together = TRUE)## [1] "Residuals vs GP"
## [1] "Residuals vs MIN"
## [1] "Residuals vs FGPercent"
## [1] "Residuals vs X3Percent"
## [1] "Residuals vs FTPercent"
## [1] "Residuals vs TOV"
## [1] "Residuals vs PF"
## [1] "Residuals vs ORB"
## [1] "Residuals vs DRB"
## [1] "Residuals vs AST"
## [1] "Residuals vs STL"
## [1] "Residuals vs BLK"
## [1] "Residuals vs PTS"
## [1] "Residuals vs birth_year"
## [1] "Residuals vs height_cm"
## [1] "Residuals vs weight_kg"## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
#Training and validation errors
caret::R2(fTR_eval$lm_pred,fTR_eval$PTS)## [1] 0.9193612caret::R2(fTS_eval$lm_pred,fTS_eval$PTS)## [1] 0.9203182caret::RMSE(fTR_eval$lm_pred,fTR_eval$PTS)## [1] 143.2621caret::RMSE(fTS_eval$lm_pred,fTS_eval$PTS)## [1] 140.7907Tras una primera pasada, se aprecia que nuestro análisis exploratorio ha sido bastante satisfactorio ya que la mayoría de variables son muy significativas para nuestro Output. No obstante, se aprecia que variables como REB, o STLo height_cm no son significativas para nuestro primer modelo.
Por tanto, para el siguiente modelo eliminamos las dos variables menos significativas: height_cm y STL.
set.seed(150)
lm2.fit = train(form = PTS~ GP + MIN + FGPercent + X3Percent + FTPercent +
TOV + PF + ORB + DRB + AST + BLK + birth_year + weight_kg,
data = fTR,
method = "lm", #Linear model
tuneGrid = data.frame(intercept = TRUE),
#preProcess = c("center","scale"),
trControl = ctrl_tune,
metric = "RMSE")
lm2.fit #information about the resampling settings## Linear Regression
##
## 5994 samples
## 13 predictor
##
## No pre-processing
## Resampling: Cross-Validated (10 fold)
## Summary of sample sizes: 5394, 5394, 5396, 5394, 5395, 5395, ...
## Resampling results:
##
## RMSE Rsquared MAE
## 144.694 0.9182745 98.30902
##
## Tuning parameter 'intercept' was held constant at a value of TRUEsummary(lm2.fit) ##
## Call:
## lm(formula = .outcome ~ ., data = dat)
##
## Residuals:
## Min 1Q Median 3Q Max
## -690.16 -63.94 -4.16 58.97 1009.31
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -5.422e+03 5.001e+02 -10.842 < 2e-16 ***
## GP -2.814e+00 1.605e-01 -17.530 < 2e-16 ***
## MIN 4.393e-01 7.568e-03 58.047 < 2e-16 ***
## FGPercent 3.122e+02 3.015e+01 10.354 < 2e-16 ***
## X3Percent 9.512e+01 1.326e+01 7.174 8.16e-13 ***
## FTPercent 1.584e+02 1.391e+01 11.387 < 2e-16 ***
## TOV 4.283e+00 8.419e-02 50.876 < 2e-16 ***
## PF -1.261e+00 6.980e-02 -18.068 < 2e-16 ***
## ORB -6.695e-01 6.869e-02 -9.747 < 2e-16 ***
## DRB 3.135e-01 3.527e-02 8.889 < 2e-16 ***
## AST -6.948e-01 3.118e-02 -22.282 < 2e-16 ***
## BLK -1.957e-01 8.706e-02 -2.248 0.0246 *
## birth_year 2.542e+00 2.529e-01 10.052 < 2e-16 ***
## weight_kg 1.138e+00 2.109e-01 5.397 7.02e-08 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 144.4 on 5980 degrees of freedom
## Multiple R-squared: 0.9183, Adjusted R-squared: 0.9181
## F-statistic: 5168 on 13 and 5980 DF, p-value: < 2.2e-16vif(lm2.fit$finalModel)## GP MIN FGPercent X3Percent FTPercent TOV PF
## 7.318753 15.347064 1.292438 1.451268 1.189948 9.395319 8.822499
## ORB DRB AST BLK birth_year weight_kg
## 5.785870 8.584591 5.687615 2.815596 1.073258 1.910805#Evaluate the model with training sets and diagnosis
#fTR_eval = fTR
fTR_eval$lm_pred2 = predict(lm2.fit, newdata = fTR)
#fTS_eval = fTS
fTS_eval$lm_pred2 = predict(lm2.fit, newdata = fTS)
#Analysis of residuals
PlotModelDiagnosis(fTR, fTR$PTS, fTR_eval$lm_pred2,
together = TRUE)## [1] "Residuals vs GP"
## [1] "Residuals vs MIN"
## [1] "Residuals vs FGPercent"
## [1] "Residuals vs X3Percent"
## [1] "Residuals vs FTPercent"
## [1] "Residuals vs TOV"
## [1] "Residuals vs PF"
## [1] "Residuals vs ORB"
## [1] "Residuals vs DRB"
## [1] "Residuals vs AST"
## [1] "Residuals vs STL"
## [1] "Residuals vs BLK"
## [1] "Residuals vs PTS"
## [1] "Residuals vs birth_year"
## [1] "Residuals vs height_cm"
## [1] "Residuals vs weight_kg"## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
caret::R2(fTR_eval$lm_pred2,fTR_eval$PTS)## [1] 0.9182705caret::R2(fTS_eval$lm_pred2,fTS_eval$PTS)## [1] 0.9192883caret::RMSE(fTR_eval$lm_pred2,fTR_eval$PTS)## [1] 144.2278caret::RMSE(fTS_eval$lm_pred2,fTS_eval$PTS)## [1] 141.7071Comparación de modelos:
caret::R2(fTR_eval$lm_pred,fTR_eval$PTS)## [1] 0.9193612caret::R2(fTS_eval$lm_pred,fTS_eval$PTS)## [1] 0.9203182caret::R2(fTR_eval$lm_pred2,fTR_eval$PTS)## [1] 0.9182705caret::R2(fTS_eval$lm_pred2,fTS_eval$PTS)## [1] 0.9192883caret::RMSE(fTR_eval$lm_pred,fTR_eval$PTS)## [1] 143.2621caret::RMSE(fTS_eval$lm_pred,fTS_eval$PTS)## [1] 140.7907caret::RMSE(fTR_eval$lm_pred2,fTR_eval$PTS)## [1] 144.2278caret::RMSE(fTS_eval$lm_pred2,fTS_eval$PTS)## [1] 141.7071Para el último modelo vamos a utilizar solo las variables que se considera significativas y además vamos a proceder a aliminar la variable minutos puesto que parece que hay una multicolinealidad ya que el ‘vif’ para esta variable nos sale > 10.
set.seed(150)
lm3.fit = train(form = PTS~ GP + FGPercent + X3Percent + FTPercent +
TOV + PF + ORB + DRB + AST + birth_year + weight_kg,
data = fTR,
method = "lm", #Linear model
tuneGrid = data.frame(intercept = TRUE),
#preProcess = c("center","scale"),
trControl = ctrl_tune,
metric = "RMSE")
lm3.fit #information about the resampling settings## Linear Regression
##
## 5994 samples
## 11 predictor
##
## No pre-processing
## Resampling: Cross-Validated (10 fold)
## Summary of sample sizes: 5394, 5394, 5396, 5394, 5395, 5395, ...
## Resampling results:
##
## RMSE Rsquared MAE
## 181.1964 0.8723225 125.0711
##
## Tuning parameter 'intercept' was held constant at a value of TRUEsummary(lm3.fit) ##
## Call:
## lm(formula = .outcome ~ ., data = dat)
##
## Residuals:
## Min 1Q Median 3Q Max
## -902.14 -87.63 -9.27 72.22 1139.49
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -2.056e+03 6.216e+02 -3.307 0.000947 ***
## GP 1.647e+00 1.764e-01 9.336 < 2e-16 ***
## FGPercent 2.846e+02 3.767e+01 7.555 4.83e-14 ***
## X3Percent 2.136e+02 1.638e+01 13.042 < 2e-16 ***
## FTPercent 2.417e+02 1.729e+01 13.979 < 2e-16 ***
## TOV 5.703e+00 1.008e-01 56.550 < 2e-16 ***
## PF -4.052e-01 8.464e-02 -4.787 1.74e-06 ***
## ORB -8.943e-01 8.438e-02 -10.598 < 2e-16 ***
## DRB 1.019e+00 3.905e-02 26.095 < 2e-16 ***
## AST -3.350e-01 3.812e-02 -8.787 < 2e-16 ***
## birth_year 8.643e-01 3.145e-01 2.749 0.006002 **
## weight_kg -8.910e-02 2.626e-01 -0.339 0.734370
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 180.7 on 5982 degrees of freedom
## Multiple R-squared: 0.8719, Adjusted R-squared: 0.8717
## F-statistic: 3703 on 11 and 5982 DF, p-value: < 2.2e-16vif(lm3.fit$finalModel)## GP FGPercent X3Percent FTPercent TOV PF ORB
## 5.640282 1.287500 1.413960 1.174073 8.606619 8.281442 5.574389
## DRB AST birth_year weight_kg
## 6.715406 5.426700 1.059290 1.891430#Evaluate the model with training sets and diagnosis
#fTR_eval = fTR
fTR_eval$lm_pred3 = predict(lm3.fit, newdata = fTR)
#fTS_eval = fTS
fTS_eval$lm_pred3 = predict(lm3.fit, newdata = fTS)
#Analysis of residuals
PlotModelDiagnosis(fTR, fTR$PTS, fTR_eval$lm_pred3,
together = TRUE)## [1] "Residuals vs GP"
## [1] "Residuals vs MIN"
## [1] "Residuals vs FGPercent"
## [1] "Residuals vs X3Percent"
## [1] "Residuals vs FTPercent"
## [1] "Residuals vs TOV"
## [1] "Residuals vs PF"
## [1] "Residuals vs ORB"
## [1] "Residuals vs DRB"
## [1] "Residuals vs AST"
## [1] "Residuals vs STL"
## [1] "Residuals vs BLK"
## [1] "Residuals vs PTS"
## [1] "Residuals vs birth_year"
## [1] "Residuals vs height_cm"
## [1] "Residuals vs weight_kg"## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
caret::R2(fTR_eval$lm_pred3,fTR_eval$PTS)## [1] 0.8719355caret::R2(fTS_eval$lm_pred3,fTS_eval$PTS)## [1] 0.872187caret::RMSE(fTR_eval$lm_pred3,fTR_eval$PTS)## [1] 180.5401caret::RMSE(fTS_eval$lm_pred3,fTS_eval$PTS)## [1] 178.4139Se peude ver que en este caso, las predicciones con repecto a los residuos empeora y se aleja del eje 0 en bastantes puntos, por lo que parece que este modelo puede que no sea óptimo
Conclusión
ggplot(fTS_eval) + geom_point(aes(x=PTS, y=lm_pred, color="lm1"))+
geom_point(aes(x=PTS, y=lm_pred2, color="lm2"))+
geom_point(aes(x=PTS, y=lm_pred3, color="lm3"))+
geom_abline()
transformResults <- resamples(list(lm=lm.fit, lm2=lm2.fit, lm3=lm2.fit))
summary(transformResults)##
## Call:
## summary.resamples(object = transformResults)
##
## Models: lm, lm2, lm3
## Number of resamples: 10
##
## MAE
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## lm 91.07536 97.35508 98.74480 98.34349 100.5258 102.0403 0
## lm2 91.26590 97.22090 98.34102 98.30902 100.7333 102.4083 0
## lm3 91.26590 97.22090 98.34102 98.30902 100.7333 102.4083 0
##
## RMSE
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## lm 131.3004 142.1013 146.0292 144.332 149.0975 151.7804 0
## lm2 131.2387 142.0945 146.4862 144.694 149.9612 151.3587 0
## lm3 131.2387 142.0945 146.4862 144.694 149.9612 151.3587 0
##
## Rsquared
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## lm 0.9053053 0.9171552 0.9188379 0.9187241 0.9231892 0.9291584 0
## lm2 0.9042010 0.9162859 0.9184169 0.9182745 0.9223609 0.9292595 0
## lm3 0.9042010 0.9162859 0.9184169 0.9182745 0.9223609 0.9292595 0dotplot(transformResults)
Habiendo realizado diferente selección de variables, se peude ver que tanto como el MAE, RMSE y el Rsquared varían muy poco entre los diferentes modelos. No obstante, mirando los gráficos de los residuos se puede apreciar, como se ha comentado anteriormente, que el último modelo, podría ser el pero. Si tuviéramos que elegir entre los tres modelos, el segundo modelo sería bastante razonable ya qye los resultados son muy similares al primero pero con menos variables, por lo que nos simplificaría el modelo.