Predicción del rendimiento futuro de los jugadores del circuito masculino de tenis

Título: Predicción del rendimiento futuro de los jugadores del circuito masculino de tenis Autor: Luis Nuevo Mengual Director: Luis Ortiz Gracia Departamento: Econometria, Estadística i Economia Aplicada Convocatoria: Junio 2022 Grado en Estadística A mi familia y amigos por apoyarme en todo lo que hago y confiar siempre en mí. A los que están y a los que se fueron. Gracias Luis por darme la oportunidad de hacer realidad este trabajo y por toda la ayuda. RESÚMEN Este trabajo consiste en la creación de una base de datos con las variables de interés para su posterior modelización. Para hacerlo se hará uso de un modelo de regresión logística. El objetivo de este modelo es obtener una probabilidad de victoria entre dos jugadores para un partido de tenis. A partir de este modelo se realizará una simulación de los torneos disputados en 2021 para a posteriori predecir el rendimiento futuro de los diferentes jugadores comparándolos con los resultados reales. El objetivo es predecir y cuantificar la capacidad de predicción de los diferentes jugadores que componen el circuito masculino de tenis. Palabras clave: Deporte, tenis, predicción, modelos lineales generalizados, regresión logística, probabilidad, simulación. Clasifiación AMS: - 62J12 Modelos lineales generalizados - 62M20 Predicción ABSTRACT This report consists on creating a data base with the variables of interest to create a predicting model. To do it so, a logistic regression model will be used. The goa lof tis model is to obtain a win probability between two players in a tennis match. With the model a simulation will be made for all the tournaments played in 2021 to predict the future performance of the different players comparing to these results to the real ones. The main goa is to predict and quantify the predictive capacity of the model for the different type of players that play at the man’s tennis circuit. Keywors: Sport, tennis, prediction, generalized linear models, logistic regression, probability, simulation. AMS Classification: - 62J12 Generalized linear models - 62M20 Prediction ÍNDICE INTRODUCCIÓN .......................................................................................................... 1 CONCEPTOS PREVIOS .............................................................................................. 2 METODOLOGIA ........................................................................................................... 4 BASE DE DATOS ..................................................................................................... 4 MODELIZACIÓN ..................................................................................................... 12 SIMULACIÓN .......................................................................................................... 21 RESULTADOS ........................................................................................................... 25 PRUEBA MODELO ................................................................................................. 25 SIMULACIÓN .......................................................................................................... 28 JUGADORES .......................................................................................................... 33 CONCLUSIONES ....................................................................................................... 40 BIBLIOGRAFIA ........................................................................................................... 41 ANEXO ....................................................................................................................... 43 1 INTRODUCCIÓN Durante el transcurso del tercer año de carrera se nos enseñaron diferentes modelos de predicción. Soy una persona amante y apasionada del deporte, por lo que pensé en aplicar por mi cuenta lo aprendido en este mundo, la duda estaba en cuál de ellos escoger. En España hay tres deportes dominantes. El fútbol, el baloncesto y el tenis. Este último debe su alta popularidad en las nuevas generaciones como la mía a Rafael Nadal Parera, para muchos el mejor jugador de la historia del tenis y de los mejores deportistas españoles que se han visto. No es solo elevado su rendimiento, sino que su forma de ser y los valores que infunde tanto en espectadores como en tenistas es algo para tener en cuenta. Es por esto por lo que, hoy por hoy, soy seguidor de este deporte. A todo esto, se le suma el hecho de que en internet hay una gran fuente de datos de los diferentes partidos disputados de manera abierta para todo el mundo. Es por estos motivos que empecé a trabajar en un modelo de predicción para partidos de tenis. Para hacerlo se tomaban en cuenta diferentes variables, las cuales dependían de cada jugador. Estas ponían contexto al partido y creaban dos perfiles únicos que se enfrentaban en un momento determinado en el tiempo para obtener una probabilidad de victoria para cada uno de ellos. A partir de esta idea y el trabajo previo realizado decidí hacer este trabajo de fin de grado. La primera intención era predecir el resultado de un partido mediante probabilidades. En este caso quería ir más allá, predecir el rendimiento futuro de un jugador para el próximo año. Con el objetivo de resolver este problema era necesario generar de 0 un nuevo modelo que mejorase el anterior con todo lo aprendido previamente. Para ello se generará una base de datos a partir de la información de los diferentes partidos, creando variables que puedan ser significativas para el modelo. El modelo al definir la probabilidad entre 0 y 1 de cada jugador será un modelo de respuesta binaria que, basándonos en pruebas previamente efectuadas, será el logístico, ya que fue el que mejor funcionaba para este caso. Una vez procedido con todo eso, se hará una simulación del 2021 de la temporada de tenis, puesto que es el último año completo de datos que se tiene. Una vez terminada esta simulación se comparará los resultados observados en la realidad junto a los esperados obtenidos en la simulación para poder obtener una predicción individual de algunos jugadores en concreto. 2 CONCEPTOS PREVIOS Este trabajo que trata sobre la predicción se centra en el deporte de raqueta llamado tenis. Para poder proceder durante el trabajo con un total entendimiento del proceso es necesario contextualizar este deporte, así mismo como algunos conceptos relacionados con este. Una de las cosas necesarias es como se define el ganador. Ambos jugadores golpean la pelota con una raqueta dentro del límite del campo. En caso de que un jugador no devuelva la pelota dentro del campo rival, pierde el punto. Cada un número determinado de puntos se gana un juego. El primero en alcanzar los 6 juegos gana el set. Para ganarlo, no obstante, se debe ganar por una diferencia de dos. Es por ello por lo que en caso de empate a cinco juegos se disputa hasta 7. En caso de llegar a empate en seis juegos se disputa un último llamado tie-break. El primero en llegar a 7 juegos con una diferencia de dos, ganar el set. El ganador es el primero en llegar a 2 sets ganados en un mejor de 3 o a 3 sets ganados en un mejor de 5. Además, el tenis se juega en diferentes superficies. Estas superficies pueden ser arcilla, hierba o cemento (también conocido como pista dura). Esto afecta en el juego, ya que el bote de la pelota es diferente dependiendo de en cuál se dispute el partido. Este deporte se puede disputar tanto de forma individual como en la modalidad de dobles. En este trabajo nos centramos en partidos individuales disputados en el circuito ATP. ATP son las siglas de Asociación de Tenistas Profesionales. Es la entidad que organiza los circuitos masculinos de tenis y que además elabora el ranking ATP. Estos torneos que organizan se dividen en tres categorías, ATP Tour, ATP Challenger Tour y ATP 3 Champions Tour. El ranking ATP, como comentábamos antes, es un orden que indica los jugadores que más puntos tienen al final del año. Estos puntos se obtienen en los diferentes torneos que se disputan a lo largo de la temporada, la cual es de un año y comienza en enero. No obstante, no todos los torneos a disputar tienen el mismo peso en el ranking. También participa en este circuito la federación internacional de tenis. Así pues, todos los torneos que hay son: Nosotros nos centraremos en las cuatro primeras categorías, ya que son los que reparten más puntos. También, dada la magnitud de torneos tanto para los Challenger Series e ITF se ha prescindido de ellos. Otro motivo es que los puntos obtenidos de los jugadores con un ranking más alto provienen el 100% de los torneos que ya tenemos en cuenta y el objetivo es predecir el rendimiento de estos jugadores. Categoría del evento Dinero en premios ($) Puntos para el Ranking Grand Slam Por determinar según torneo 2000 ATP World Tour Finals 7 500 000 1100-1500 ATP Tour Masters 1000 de 3 748 925 a 5 452 985 1000 ATP Tour 500 de 1 333 085 a 2 249 215 500 ATP Tour 250 de 404 780 a 1 189 605 250 ATP Challenger Series de 35 000+H a 125 000+H 80 a 125 ITF World Tennis Tour de 15 000 a 25 000+H 10 a 20 Copa Davis 1 750 000 - 4 METODOLOGIA En este capítulo se expondrá la metodología del estudio. El objetivo es mostrar el proceso realizado para alcanzar los resultados y conclusiones que veremos más adelante. La metodología del trabajo se divide en tres grandes apartados. Base de datos, donde veremos los datos usados, origen y estructura, junto a las variables utilizadas analizadas. Modelización, donde podremos ver qué tipo de modelo es el escogido como óptimo para la predicción, selección del mejor modelo y su validación. Por último, tendremos la simulación donde comentaremos cuál es el objetivo, planteamiento y estructura de esta. BASE DE DATOS Dado que el objetivo de este trabajo es la predicción del ganador de un partido determinado para poder realizar una simulación de una temporada entera del circuito ATP en torneos 250 o superior, era necesario un registro de los partidos previamente jugados. Es por ello que hice una búsqueda para obtener estos datos y encontré el repositorio en GitHub de Jeff Sackmann. Allí encontraremos todos los partidos disputados para todo tipo de torneo por año en el circuito masculino de tenis. Los datos se reparten en diferentes csv, uno por cada año natural (temporada). También vemos como cada fila corresponde a un partido diferente. A continuación, vemos un par de registros para poder visualizar mejor los datos. Podemos ver como son varios los atributos, 49 exactamente, asociados a esta base de datos, no obstante, se han eliminado los que no aportaban información necesaria. Estas son las variables utilizadas. • Surface → En que superficie se ha jugado el partido. Puede ser arcilla, dura (cemento), hierba o moqueta. • Tourney_level → Tipo de torneo en el que se juega. Puede ser Grand Slam, torneos de repartimiento de 1000, 500 y 250 puntos, Challenger, ITF, Master Finals y por último, Copa Davis. • winner_name/loser_name → Nombre del jugador que ha ganado o perdido el partido • winner_age/loser_age → Edad del jugador que ha ganado o perdido el partido • winner_height/ loser_height → Altura del jugador que ha ganado o perdido el partido • tourney_date → Fecha en la que se disputa el torneo 11 Para finalizar encontramos las formas recientes. Aquí vemos que la tónica es la misma para todos. No obstante ser la misma, esta no indica grandes indicios de que haya significación ni de su inexistencia. 12 MODELIZACIÓN Para poder realizar la simulación de la temporada ATP es necesario crear un modelo para poder predecir el resultado de un partido entre dos jugadores determinados. Se quiere predecir la probabilidad de que gane un jugador u otro y a partir de esa probabilidad seleccionar aleatoriamente el ganador. Como previamente hemos comentado nuestra variable respuesta (y = qué jugador ha ganado) es una variable binaria. Con todo esto en mente se plantea usar un modelo de regresión logística. Este tipo de modelos es utilizado para predecir el resultado de una variable categórica en función de las variables independientes o predictores. Este modelo es útil para modelar la probabilidad de un evento ocurriendo en función de otros factores, lo cual es perfecto para la situación que es propuesta con la predicción de un partido de tenis. El modelo en sí quedaría de la siguiente forma. 𝑙𝑜𝑔𝑖𝑡(𝑝𝑖)=ln(𝑝𝑖 1−𝑝𝑖)=𝛽0+𝛽1𝑥1,𝑖 +⋯+𝛽𝑘𝑥𝑘,𝑖 Por lo que a la hora de obtener la probabilidad de victoria para un conjunto de datos x aplicaríamos la siguiente formula. 𝑝(𝑥)=1 1+𝑒−(𝛽0+𝛽1𝑥)=𝑒𝛽0+𝛽1𝑥 1+𝑒𝛽0+𝛽1𝑥 Dado que hemos calculado tres tipos de porcentaje de victorias (por pista, por torneo y ambas cruzadas) se plantean dos modelos diferentes. El primero de ellos se tiene en cuenta los porcentajes de victorias tanto por tipo de pista como por nivel de torneo por separado para que calcule el peso que tiene cada una en el modelo. Por otra parte, el segundo planteamiento se descarta estas dos variables y se usa solo la variable que cruza ambas. Con esto queremos ver si es mejor para el modelo calcula que la importancia que tienen en las predicciones estos porcentajes de victorias son diferentes o si por contraparte es óptimo cruzarlas y dar un único coeficiente para la estimación de su parámetro. También es importante comentar que estos modelos no tendrán intecept, es decir, será 0. Esto se debe a que en el caso de tener dos jugadores con exactamente las mismas características, la probabilidad de victoria tanto para uno como para otro debe ser de 0’5. Fijando nuestro 𝛽0 en 0 hace que en encontrarnos con dicho caso la probabilidad de victoria quedaría como comentábamos, ya que sería 1 1+𝑒0= 1 1+1 =0.5 . Esto ocurre 13 porque, como ya se ha comentado previamente, las variables son la diferencia de estadísticos, por lo que nos encontramos que en este caso todas las 𝑥𝑘 serian 0. Por lo tanto, nuestras funciones lineales del modelo quedarían. Modelo Superficie + Nivel Torneo 𝛽1𝑇𝑜𝑢𝑟𝐷𝑖𝑓+𝛽2𝑆𝑢𝑟𝑓𝑎𝑐𝑒𝐷𝑖𝑓+𝛽3𝐴𝑔𝑒𝐷𝑖𝑓... Modelo variables cruzadas 𝛽1𝑆𝑢𝑟𝑓𝑎𝑐𝑒𝑇𝑜𝑢𝑟𝐷𝑖𝑓+𝛽2𝐴𝑔𝑒𝐷𝑖𝑓... No obstante, cada modelo contiene algunas variables las cuales tienen un período de tiempo de los últimos 6, 4 y 2 años, por lo que en total obtendremos 6 modelos distintos, pues el objetivo también es ver en qué intervalo de tiempo hemos de fijarnos para que el modelo sea el mejor posible. Además, en cada modelo se añadirán las variables con su período de tiempo de referencia correspondiente para la variable de estado de forma. Todos los modelos tienen las variables de diferencia de edad, altura y los cara a cara, tanto teniendo en cuenta el tipo de superficie como si no. Con todo esto dicho, un ejemplo sería el modelo a 6 años de variables cruzadas que quedaría de la siguiente manera. 𝑙𝑜𝑔𝑖𝑡(𝑝𝑖)= 𝛽1𝑆𝑢𝑟𝑓𝑎𝑐𝑒𝑇𝑜𝑢𝑟𝐷𝑖𝑓6+𝛽2𝐴𝑔𝑒𝐷𝑖𝑓+𝛽3𝐻𝑒𝑖𝑔ℎ𝑡𝐷𝑖𝑓:𝑆𝑢𝑟𝑓𝑎𝑐𝑒+𝛽4ℎ2ℎ𝐷𝑖𝑓6 +𝛽5ℎ2ℎ𝐷𝑖𝑓3+𝛽6ℎ2ℎ𝐷𝑖𝑓1+𝛽7ℎ2ℎ𝑆𝑢𝑟𝐷𝑖𝑓6+𝛽8ℎ2ℎ𝑆𝑢𝑟𝐷𝑖𝑓3 +𝛽9ℎ2ℎ𝑆𝑢𝑟𝐷𝑖𝑓1+𝛽10𝑟𝑓(6,12)+𝛽11𝑟𝑓(6,6)+𝛽12𝑟𝑓(6,3)+𝛽13𝑟𝑓(6,1) Encontramos que por cada modelo de superficie + nivel de torneo tendremos 14 parámetros a estimar y 13 para variables cruzadas. Con tal de tener el mejor modelo posible, aplicamos la función step en R la cual calcula la mejor combinación de variables para explicar la variable a explicar. Una vez aplicado en cada modelo debemos seleccionar el mejor modelo de los 6. Para ello se usarán dos métodos de selección de modelo, el Akaike Information Criterion (AIC) y el Bayesian Information Criterium (BIC). Sus fórmulas son las siguientes. 𝐴𝐼𝐶 =2𝑘−2𝑙𝑛(𝐿 ) 𝐵𝐼𝐶 =𝑘𝑙𝑛(𝑘)−2𝑙𝑛(𝐿 ) Siendo k el número de parámetros estimados por el modelo y 𝐿  el valor de la máxima verosimilitud de la función del modelo. Todo esto es calculado por las funciones AIC( ) y BIC( ) de R 14 Los valores para ambos estadísticos de todos los modelos son los siguientes Como podemos observar, tanto para el AIC como para el BIC, el mejor modelo es el 4b el cual corresponde al que tiene las variables superficie y tipo de torneo cruzadas y con teniendo en cuenta un intervalo de tiempo de 4 años. El modelo final seleccionado con la función step aplicada es: 𝑙𝑜𝑔𝑖𝑡(𝑝𝑖)= 𝛽1𝑆𝑢𝑟𝑓𝑎𝑐𝑒𝑇𝑜𝑢𝑟𝐷𝑖𝑓4+𝛽2𝐴𝑔𝑒𝐷𝑖𝑓+𝛽3𝐻𝑒𝑖𝑔ℎ𝑡𝐷𝑖𝑓:𝑆𝑢𝑟𝑓𝑎𝑐𝑒+ 𝛽4ℎ2ℎ𝐷𝑖𝑓6+ 𝛽5ℎ2ℎ𝐷𝑖𝑓3+𝛽6𝑟𝑓(4,12)+𝛽7𝑟𝑓(4,3) Finalmente, nos quedamos con la variable que identifica el modelo junto a las diferencias de edad, interacción, altura y superficie, cara a cara de los últimos 6 y 3 años y estado de forma del último año y de los últimos 3 meses, con los resultados de los últimos 4 años como referencia. A continuación, encontramos los valores β finalmente estimados y su interpretación. De la interacción Height:Surface solo encontramos un valor porque es el único significativo, es decir, los otros dos estadísticamente no son diferentes de 0. AIC BIC m6a 9865.338 9941.877 m6b 10025.900 10088.522 m4a 9885.616 9955.196 m4b 8947.569 9009.106 m2a 11345.622 11402.279 m2b 11497.124 11567.946 15 Variable Parámetro Interpretación 𝑆𝑢𝑟𝑓𝑎𝑐𝑒𝑇𝑜𝑢𝑟 3.789859 Por cada diferencia de 0.1 en el porcentaje de victoria según tipo de pista y torneo la probabilidad de ganar dicho jugador aumenta en un 38’17% 𝐴𝑔𝑒 -0.021795 En este caso tenemos un parámetro negativo, por lo tanto, por cada año de más que tenga el jugador su probabilidad de victoria descenderá en un 2’06% 𝐻𝑒𝑖𝑔ℎ𝑡:𝐻𝑎𝑟𝑑 0.011838 Por cada centímetro que sea más alto que el otro jugador, disputándose el partido en pista Hard, la probabilidad de ganar dicho jugador aumenta en un 1’18% ℎ2ℎ𝐷𝑖𝑓6 0.124109 En caso de que un jugador haya ganado todos los previos enfrentamientos entre ambos en los últimos 6 años, la probabilidad de victoria aumentará en un 12’41% ℎ2ℎ𝐷𝑖𝑓3 0.176542 En caso de que un jugador haya ganado todos los previos enfrentamientos entre ambos en los últimos 3 la probabilidad de victoria aumentará en un 17’65% 𝑟𝑓(4,12) 2.471392 Por cada diferencia a favor de un jugador de 0.1 en el estado de forma en los últimos 12 meses respecto los últimos 4 años el porcentaje de victoria aumentará en un 24’71% 𝑟𝑓(4,3) 0.861058 Por cada diferencia a favor de un jugador de 0.1 en el estado de forma en los últimos 3 meses respecto los últimos 4 años el porcentaje de victoria aumentará en un 8’61% Como podemos observar, tan solo la edad tiene un efecto negativo en el porcentaje de victorias. Además, vemos como el modelo no se ha quedado con nada más una variable referente al estado de forma, pero si se observa que tiene más peso el estado de forma en el último año que en los últimos 3 meses. Para finalizar debemos ver como de bueno es el modelo y validarlo antes de pasar a la simulación. 16 Encontramos arriba el ajuste de las predictoras. Podemos ver que el ajuste es muy bueno con la edad y él cara a cara. Se desvía un poco más en el resto de las variables. Vemos ahora el ajuste del modelo. 17 Podemos observar como el ajuste del modelo es bastante bueno, aunque todavía podría ser mejor. Para la capacidad predictiva del modelo tenemos el siguiente gráfico con la curva de ROC. 18 Siendo el estimador 0.67, lo cual nos indica que la capacidad predictiva del modelo no es mala pero que tampoco es muy elevada. Aun así, todavía podemos obtener una mejor capacidad predictiva. Realizamos un análisis de outliers y observaciones influentes a posteriori, las cuales pueden estar afectando a las estimaciones y como consecuencia empeorando el modelo. Todo esto se obtiene a raíz de la función influenceIndexPlot( ). No obstante, de esta forma somos incapaces de ver realmente que está afectando al modelo. Al realizar un OutlierTest obtenemos que solo una observación se le considera outlier. En cuanto a las observaciones influentes encontramos el siguiente gráfico 19 Tenemos todas las distancias de Cook junto a una constante representada de color roja que indica el cutoff. Este cutoff el cual es igual a 4/n, nos indica que observaciones son influentes. Con tal de mejorar el modelo eliminamos estas observaciones que hemos encontrado. El AIC del modelo ahora es de 8496 frente al valor de 8950 que teníamos antes, por lo que vemos ya una mejora en el ajuste del modelo. Además, una vez hecho esto tenemos una mejora en el estimador del AUC de la curva de ROC, medida para analizar la capacidad predictiva. Ahora hemos pasado de tener 0.67 a un AUC de 0.7, por lo que ya podemos decir que el modelo es bueno prediciendo, no obstante, podría ser mejor ya que todavía tenemos un valor bastante reducido. Vemos las nuevas estimaciones de los parámetros del modelo. Variable Parámetro Antiguo Nuevo Parámetro 𝑆𝑢𝑟𝑓𝑎𝑐𝑒𝑇𝑜𝑢𝑟 3.789859 4.853475 𝐴𝑔𝑒 -0.021795 -0.026824 𝐻𝑒𝑖𝑔ℎ𝑡 0.011838 0.010341 ℎ2ℎ𝐷𝑖𝑓6 0.124109 ℎ2ℎ𝐷𝑖𝑓3 0.176542 0.303061 𝑟𝑓(4,12) 2.471392 2.724822 𝑟𝑓(4,3) 0.861058 1.509939 20 Podemos observar como todas las estimaciones han cambiado. Algunas en menor cantidad, pero las que variables que ahora tienen un mayor peso en comparación con el que tenían previamente son SurfaceTour que ha aumentado en 1 la estimación y el estado de forma en los últimos 3 meses que ha aumentado en casi 0.7. Vemos finalmente de nuevo el calibrationPlot para ver el ajuste, donde observaremos que, aunque algunos puntos se alejen de la recta, el ajuste es bueno. 27 Aquí vemos como Rublev domina en todos los aspectos, a excepción de los partidos previos entre ambos jugadores. Esto se plasma en la aplastante diferencia en la probabilidad de victoria del ruso, que en este caso es de un 72%. Las casas de apuestas le daban un 60% de victoria, pero en este caso el ruso nos daba la razón al modelo mostrando esa superioridad que se esperaba ganando en dos mangas. Djokovic - Alcaraz No siempre el modelo acierta, eso es obvio. Uno de esos partidos donde no pudo leer bien el resultado fue entre él tantas veces número 1, Novak Djokovic, con el llamado a tomar el relevo de Rafa, la joven promesa Carlos Alcaraz. El partido se sitúa en las semifinales del Masters 1000 de Madrid. Djokovic se plantaba como ligero favorito tanto para las casas de apuestas como en el modelo, como vemos a continuación. Ligeramente favorito Djokovic con un 60% de victoria y un 55% según las casas de apuestas. Vemos como no hay valores para él cara a cara, ya que era el primer enfrentamiento de la historia entre estos dos jugadores. La altura, aún siendo parecida, no afecta en este partido, puesto que se disputó en arcilla, pista y tipo de torneo donde el serbio tiene mejor bagaje. No obstante, la juventud de Carlos y el estado de forma tan pletórico en el que venía le daba más oportunidades de las que se esperarían normalmente. El resultado fue una victoria muy ajustada en un tie-break en el tercer set para el murciano, sorprendiendo así a todo el mundo. 28 Nadal - Djokovic El último partido donde probaremos el modelo será entre dos eternos rivales como son Nole y Rafa en los cuartos de final del Roland Garros, torneo de arcilla que se disputa en París. Tenemos un partido con condiciones muy iguales entre ambos jugadores, pero con ventaja para el español dada su mejor forma en los últimos meses y su ligera superioridad en este torneo ante su rival. No obstante, en las casas de apuestas daban un 35% de probabilidades de ganar a Rafa. Esto se debe en parte a las posibles molestias que podía acarrear para el partido y que en la ronda anterior tuvo un enfrentamiento muy duro. Sorprendentemente, para algunos, aunque no para el modelo, el de Manacor se anteponía en cuatro sets por un 6-2 / 4-6 / 6-2 / 7-6(4). SIMULACIÓN Como ya se ha comentado varias veces, el objetivo de la creación de este modelo es el de poder realizar una simulación del circuito ATP en el 2021. Para ello se han efectuado 500 simulaciones para poder encontrar el resultado final del ranking minimizando la aleatoriedad. Me hubiera gustado hacer más simulaciones, pero el coste computacional era enorme, por lo que no he podido hacerlo. Ahora veremos los resultados generales de obtenidos. Por cada simulación obtenemos los puntos y el ranking de cada jugador en cada bucle. Con ello obtenemos los puntos medios obtenidos en el año para tener un ranking final. A continuación, tenemos el top 8 final obtenido y, por lo tanto, los jugadores que según la simulación clasificarían al ATP Finals. 29 Jugador País Edad Alexander Zverev 25 Daniil Medvedev 26 Novak Djokovic 35 Stefanos Tsitsipas 23 Reilly Opelka 24 Andrey Rublev 24 Casper Ruud 23 Felix Auger Aliassime 21 Ahora sí, lo interesante también es poder comparar los rankings obtenidos en la simulación con lo que realmente ocurrió. Es por ello por lo que para cuantificarlo restamos al ranking real el simulado. Así pues, las mayores diferencias negativas, es decir, donde se rindió más de lo esperado, son las siguientes. 30 Como el propio título del gráfico indica, nos hemos fijado solo en las diferencias negativas de jugadores que se encontraban en el top 50. Esto se debe a que solamente se han simulado partidos de nivel open hacia arriba y no Challenger. La mayoría de los jugadores que componen las posiciones entre la 100 y la 50 participan en bastantes fechas de este tipo de nivel de torneos. Para poder sacar conclusiones con un peso real nos tenemos que fijar únicamente en estos jugadores que sus puntos son todos de los torneos que hemos utilizado para la simulación, en este caso, los 50 primeros. Nos fijamos en los jugadores de mayor ranking. Vemos que Berrettini ha quedado infravalorado por parte del modelo, en su caso terminó el año en la posición número 6 mientras que la simulación lo sitúa en la 25. Esto puede ser debido a cuadros difíciles a principio de año y que esto haya sido acarreado toda la temporada, ya que el italiano ya tenía buenos números a principio de año. Por otra parte, encontramos jugadores como Karatsev y Norrie, ambos jugadores que ya llevaban un tiempo en el circuito, pero que no lograban resultados muy notorios. En este 2021 dieron un salto de nivel ganando ambos algunos títulos y demostrando un nivel enorme. Este salto de nivel no se ha sido capaz de cuantificar por el modelo, colocándolos en el 36 y 38, respectivamente, cuando terminaron 11 y 13 del circuito, 25 posiciones de diferencia. 31 Volvemos a encontrar el mismo tipo de gráfico, pero con las diferencias positivas. En este caso tenemos a los jugadores los cuales, según la simulación, se esperaba que diesen un mejor resultado en el año. Marcados volvemos a tener a los jugadores de mayor ranking según la simulación. Podemos observar como las diferencias entre rankings son mayores que antes. La mayor diferencia la tenemos en Kecmanovic de 75 puestos mientras que antes era de -25 para Aslan y Cameron. La diferencia es tan grande que le dedicaremos un análisis más profundo más adelante. El caso de Dominic Thiem es especial. El modelo lo sitúa en el puesto número 19 mientras que realmente terminó el 69 en la race. Esto se debe a las lesiones. El austriaco pasó un infierno con sus lesiones en la temporada anterior y esto, cómo ya comentábamos en los primeros apartados de la metodología, es muy complicado de poder medir. El ex número 3 del circuito tiene unos números fabulosos en torneos ATP por lo que probablemente, aunque haya disputado pocos torneos, se esperaba un gran rendimiento de él, mientras que en la realidad no llegó a estar al 100%. El último caso que tenemos marcado es el de Pedro Martínez Portero. Pedro es un jugador bastante joven y un especialista en arcilla, es por ello que se esperaba una subida de nivel. Nada más lejos de la realidad, Tuvo dos lesiones durante la temporada, mismo caso que vimos antes, y sus mejores resultados fueron obtenidos en el circuito Challenger el cuál no se ha tenido en cuenta. Es por ello que se podía esperar una subida de nivel mayor por parte del español. Esta temporada empezó muy fuerte e incluso consiguió levantar su primer título ATP en Santiago, Chile. Por lo que la predicción no iba tan mal encaminada como nos indicaba la diferencia. Una vez esto, nos centramos en las primeras posiciones. Al final lo más interesante es ver qué jugadores acabaran en las posiciones de arriba. A continuación, encontramos el top 15 del circuito junto a sus rankings. 32 Encontramos en azul el ranking simulado y en rojo el ranking real para los 15 jugadores con más puntos de la race del 2021. Vemos como se han acertado 11 de los 15 jugadores que se situarían en este intervalo, un 73% de los jugadores, un resultado muy positivo. Los 4 jugadores que se sitúan fuera son Hurkacz, que se queda en el límite en el puesto 17, y los tres jugadores que previamente vimos con las diferencias negativas. Podemos observar también como las diferencias entre los jugadores acertados en el top 15 no son muchas. Además, como último punto positivo, se han acertado a la perfección las posiciones de Denis Shapovalov, decimocuarto situado, Stefanos Tsitsipas, cuarto de la race y Daniil Medvedev, segundo del ranking y que por un corto período de tiempo fue capaz de robarle la primera plaza a Djokovic este año. Una vez visto los resultados generales, vamos a fijarnos en los resultados de algunos jugadores de interés para hilar más fino en la simulación, estos jugadores son: - Miomir Kecmanovic, por la gran diferencia que lo sitúa dentro del top 50 - Matteo Berretini, por ser un jugador de arriba y no haber podido predecirlo - Carlos Alcaraz, jugador de interés personal - Casper Rudd, jugador de interés por el año que realizó 33 JUGADORES Una vez visto todo lo anterior, nos queda el último paso, predecir el rendimiento de un jugador a partir de los resultados esperados y observados. Para hacerlo debemos fijarnos con más detalle en los resultados simulados del jugador y contextualizarlos con el fin de poder explicarlos mejor. Para ello, de cada jugador veremos diferentes datos de interés. Uno de ellos es la posición anterior para la race del 2020, para ver la progresión del jugador. Miomir Kecmanovic Vemos un poco los datos del jugador - Edad: 22 años - Altura: 1.83 metros - País: Serbia - Ranking race 2019: 59 - Pista favorita: Dura, buenos resultados en arcilla también Estamos frente a un jugador joven y polivalente. Veamos los resultados de la simulación. Encontramos que el ranking real se sitúa muy lejos del esperado. Además, el 50% de los datos lo sitúan entre las posiciones 20 y 40, por lo que vemos que es constante en la mejora del ranking previo. Tenemos la existencia de varios outliers, siendo estos rankings de alrededor del puesto 85 de media, pero que ni en el peor de los casos alcanza el valor observado. 34 En la realidad, podemos ver como este jugador encajó bastantes derrotas seguidas sin tener realmente un buen resultado en ningún torneo, es por ello que terminó en el 97. Aquí podemos ver la frecuencia de las posiciones logradas por intervalo. Vemos como los intervalos más repetidos son él [20,30) y el [10,20), resultados extremadamente buenos que supondrían un aumento notorio en su ranking. Incluso en bastantes ocasiones lo sitúa en el top 10. Esto nos hace indicar el gran recorrido de nivel que tenía y el nefasto año que realizó. A partir de estos resultados, la predicción sería una clara subida del ranking. En este 2022 se podría esperar una subida de nivel para recuperar lo perdido y escalar puestos. Lo situaría mínimo por encima del puesto 50, mejorando su penúltimo resultado. Nada más lejos de la realidad, a mitad de esta temporada, el serbio ha mejorado y demostrado su nivel, ganando más partidos en 6 meses que todo el 2021 y actualmente, situándose en el puesto 30 de la race, por lo que estaríamos en un caso de acierto de la predicción hoy por hoy. 35 Carlos Alcaraz - Edad: 19 años - Altura: 1.83 metros - País: España - Ranking race 2020: 141 - Pista favorita: Por victorias arcilla, aunque personalmente él dijo que dura En este caso tenemos a un jugador jovencísimo y con muchísimo potencial. No obstante, muy joven y con poca experiencia en el circuito, que previamente se sentaba fuera del top 100, por lo que sus puntos provenían del circuito Challenger. Veamos más de cerca sus resultados. Vemos como no solo se espera que Carlos irrumpiera en el top 100, objetivo clásico de los jóvenes que disputan los circuitos menores, sino que parecía inevitable que rompiera la barrera de los 50 mejores. Ni más ni menos que una mejora de 110 puestos le daba la simulación. Aun así, el joven murciano, llegó a alcanzar el puesto 21. 36 Vemos de forma aún más clara la entrada de Carlos entre los mejores, obteniendo la mayoría de los resultados entre el puesto 10 y el 30, por lo que el modelo fue capaz de predecir bien el rendimiento de Alcaraz en 2021, el cual tiene una mejora exponencial en su nivel tenístico. Viendo esta diferencia tan abismal se esperaría que siguiese así e incluso que tal vez no tenga techo, llegando a poder alcanzar el tan codiciado primer puesto en los próximos años. Sin ir más lejos, esta hipótesis queda confirmada, ya que el futuro y presente del tenis español se sitúa ni más ni menos que en el segundo puesto de la race del 2022, solo superado por la leyenda del tenis Rafael Nadal. Por lo que volvemos a encontrarnos en un caso bien predicho. Matteo Berrettini - Edad: 26 años - Altura: 1.96 metros - País: Italia - Ranking race 2020: 10 - Pista favorita: Por victorias dura o hierba, aunque personalmente él dijo que arcilla Esta vez nos encontramos con el italiano Matteo Berrettini. Un jugador con un saque potentísimo que entró por primera vez en el top 10 en el año 2019 y desde entonces se ha mantenido en esas posiciones. Este es un jugador el cual, como ya habíamos visto antes, quedó infravalorado por el modelo. Veamos más de cerca sus resultados. 43 ANEXO Base de datos load("E:/TENIS 12-2021/backfile1.RData") dd$tourney_date <- as.Date(as.character(dd$tourney_date), "%Y%m% d") dd<-dd[order(dd$tourney_date, dd$match_num),] dd$tourney_level[dd$tourney_level=="S"] <- "ITF" dd$tourney_level[dd$tourney_level=="15"] <- "ITF" dd$tourney_level[dd$tourney_level=="25"] <- "ITF" dd <- dd%>% filter(tourney_date < as.Date("2021-01-01", "%Y-%m-% d") & tourney_date >= as.Date("2010-01-01", "%Y-%m-%d")) keep <- c("surface", "tourney_level", "tourney_date", "winner_na me", "loser_name", "player_1_id", "player_2_id", "y", "rank_p2", "rank_p 1", "age_p2", "age_p1", "winner_ht","loser_ht") dd <- dd[,keep] 508597 partidos entre el 2000 y el 2020, 287333 a partir del 2010 Las funciones de abajo del bucle se incorporan desde un RData Selección partidos ATP j <- c() start <- which(dd$tourney_date > as.Date("2016-01-01", "%Y-%m-%d "))[1] for(i in start:nrow(dd)){ if(dd[i, "tourney_level"] == "A" | dd[i, "tourney_level"] == " G" | dd[i, "tourney_level"] == "M"){ j <- c(j,i) } } k = 1 while(k <= length(j)){ i <- j[k] a <- dd[i,"player_1_id"] b <- dd[i,"player_2_id"] sur <- dd[1:(i-1),] %>% filter(surface == dd[i, "surface"]) tour <- dd[1:(i-1),] %>% filter(tourney_level == dd[i, "tourne y_level"]) surtour <- sur %>% filter(tourney_level == dd[i, "tourney_leve l"]) head_to_head <- dd[(dd[1:(i-1),"player_1_id"] == a | dd[1:(i-1 ),"player_1_id"] == b) & 44 (dd[1:(i-1),"player_2_id"]== a | dd[1:(i-1),"player_2_id"] == b),] ############# ### WIN % ### ############# # Tour dd[i,"tour_2_p1"] <- tourP(a,2);dd[i,"tour_2_p2"] <- tourP(b,2 ) dd[i,"tour_4_p1"] <- tourP(a,4);dd[i,"tour_4_p2"] <- tourP(b,4 ) dd[i,"tour_6_p1"] <- tourP(a,6);dd[i,"tour_6_p2"] <- tourP(b,6 ) # Surface dd[i,"sur_2_p1"] <- surP(a,2);dd[i,"sur_2_p2"] <- surP(b,2) dd[i,"sur_4_p1"] <- surP(a,4);dd[i,"sur_4_p2"] <- surP(b,4) dd[i,"sur_6_p1"] <- surP(a,6);dd[i,"sur_6_p2"] <- surP(b,6) # Surface vs Tour dd[i,"surtour_2_p1"] <- surtourP(a,2);dd[i,"surtour_2_p2"] <- surtourP(b,2) dd[i,"surtour_4_p1"] <- surtourP(a,4);dd[i,"surtour_4_p2"] <- surtourP(b,4) dd[i,"surtour_6_p1"] <- surtourP(a,6);dd[i,"surtour_6_p2"] <- surtourP(b,6) ############## ### HEIGHT ### ############## if(dd[i,"winner_name"] == dd[i,"player_1_id"]){ dd[i,"ht_p1"] <- trunc(dd[i,"winner_ht"]);dd[i,"ht_p2"] <- t runc(dd[i,"loser_ht"]) } else { dd[i,"ht_p2"] <- trunc(dd[i,"winner_ht"]);dd[i,"ht_p1"] <- t runc(dd[i,"loser_ht"]) } #################### ### HEAD TO HEAD ### #################### tipopista<-dd[i,"surface"] dd[i, "h2h_6_p1"] <- h2hf(a,b,6,0)[1];dd[i, "h2h_6_p2"] <- h2h f(a,b,6,0)[2] dd[i, "h2h_3_p1"] <- h2hf(a,b,3,0)[1];dd[i, "h2h_3_p2"] <- h2h 45 f(a,b,3,0)[2] dd[i, "h2h_1_p1"] <- h2hf(a,b,1,0)[1];dd[i, "h2h_1_p2"] <- h2h f(a,b,1,0)[2] dd[i, "h2h_6_sur_p1"] <- h2hf(a,b,6,tipopista)[1];dd[i, "h2h_6 _sur_p2"] <- h2hf(a,6,0,tipopista)[2] dd[i, "h2h_3_sur_p1"] <- h2hf(a,b,3,tipopista)[1];dd[i, "h2h_3 _sur_p2"] <- h2hf(a,b,3,tipopista)[2] dd[i, "h2h_1_sur_p1"] <- h2hf(a,b,1,tipopista)[1];dd[i, "h2h_1 _sur_p2"] <- h2hf(a,b,1,tipopista)[2] ################### ### RECENT FORM ### ################### dd[i,"rf_6_12_p1"] <- rf(a,6,12);dd[i,"rf_6_12_p2"] <- rf(b,6, 12) dd[i,"rf_6_6_p1"] <- rf(a,6,6);dd[i,"rf_6_6_p2"] <- rf(b,6,6) dd[i,"rf_6_3_p1"] <- rf(a,6,3);dd[i,"rf_6_3_p2"] <- rf(b,6,3) dd[i,"rf_6_1_p1"] <- rf(a,6,1);dd[i,"rf_6_1_p2"] <- rf(b,6,1) dd[i,"rf_4_12_p1"] <- rf(a,4,12);dd[i,"rf_4_12_p2"] <- rf(b,4, 12) dd[i,"rf_4_6_p1"] <- rf(a,4,6);dd[i,"rf_4_6_p2"] <- rf(b,4,6) dd[i,"rf_4_3_p1"] <- rf(a,4,3);dd[i,"rf_4_3_p2"] <- rf(b,4,3) dd[i,"rf_4_1_p1"] <- rf(a,4,1);dd[i,"rf_4_1_p2"] <- rf(b,4,1) dd[i,"rf_2_12_p1"] <- rf(a,2,12);dd[i,"rf_2_12_p2"] <- rf(b,2, 12) dd[i,"rf_2_6_p1"] <- rf(a,2,6);dd[i,"rf_2_6_p2"] <- rf(b,2,6) dd[i,"rf_2_3_p1"] <- rf(a,2,3);dd[i,"rf_2_3_p2"] <- rf(b,2,3) dd[i,"rf_2_1_p1"] <- rf(a,2,1);dd[i,"rf_2_1_p2"] <- rf(b,2,1) ################## ### CONTADORES ### ################## # 6 años dd6 <- dd[1:(i-1),]%>%filter(tourney_date>= (dd[i,"tourney_dat e"]-12*30*6)) dd[i,"contador6_p1"] <- length(dd6$surface[(dd6$player_1_id==a |dd6$player_2_id==a) & dd6$tourney_date < dd[i,"tourney_date"]]) dd[i,"contador6_p2"] <- length(dd6$surface[(dd6$player_1_id==b |dd6$player_2_id==b) & dd6$tourney_date < dd[i,"tourney_date"]]) 46 dd[i,"contador6_surtur_p1"] <- length(dd6$surface[(dd6$player_ 1_id==a|dd6$player_2_id==a) & dd6$surface==dd[i,"surface"] & dd6$tourney_ date < dd[i,"tourney_date"] & dd6$tourney_ level==dd[i,"tourney_level"]]) dd[i,"contador6_surtur_p2"] <- length(dd6$surface[(dd6$player_ 1_id==b|dd6$player_2_id==b) & dd6$surface==dd[i,"surface"] & dd6$tourney_ date < dd[i,"tourney_date"] & dd6$tourney_ level==dd[i,"tourney_level"]]) # 4 años dd3 <- dd[1:(i-1),]%>%filter(tourney_date>= (dd[i,"tourney_dat e"]-12*30*4)) dd[i,"contador4_p1"] <- length(dd3$surface[(dd3$player_1_id==a |dd3$player_2_id==a) & dd3$tourney_date < dd[i,"tourney_date"]]) dd[i,"contador4_p2"] <- length(dd3$surface[(dd3$player_1_id==b |dd3$player_2_id==b) & dd3$tourney_date < dd[i,"tourney_date"]]) dd[i,"contador4_surtur_p1"] <- length(dd3$surface[(dd3$player_ 1_id==a|dd3$player_2_id==a) & dd3$surface==dd[i,"surface"] & dd3$tourney_ date < dd[i,"tourney_date"] & dd3$tourney_ level==dd[i,"tourney_level"]]) dd[i,"contador4_surtur_p2"] <- length(dd3$surface[(dd3$player_ 1_id==b|dd3$player_2_id==b) & dd3$surface==dd[i,"surface"] & dd3$tourney_ date < dd[i,"tourney_date"] & dd3$tourney_ level==dd[i,"tourney_level"]]) # 2 años dd3 <- dd[1:(i-1),]%>%filter(tourney_date>= (dd[i,"tourney_dat e"]-12*30*2)) dd[i,"contador2_p1"] <- length(dd3$surface[(dd3$player_1_id==a |dd3$player_2_id==a) & dd3$tourney_date < dd[i,"tourney_date"]]) dd[i,"contador2_p2"] <- length(dd3$surface[(dd3$player_1_id==b |dd3$player_2_id==b) & dd3$tourney_date < dd[i,"tourney_date"]]) 47 dd[i,"contador2_surtur_p1"] <- length(dd3$surface[(dd3$player_ 1_id==a|dd3$player_2_id==a) & dd3$surface==dd[i,"surface"] & dd3$tourney_ date < dd[i,"tourney_date"] & dd3$tourney_ level==dd[i,"tourney_level"]]) dd[i,"contador2_surtur_p2"] <- length(dd3$surface[(dd3$player_ 1_id==b|dd3$player_2_id==b) & dd3$surface==dd[i,"surface"] & dd3$tourney_ date < dd[i,"tourney_date"] & dd3$tourney_ level==dd[i,"tourney_level"]]) if(dd[i,"winner_name"] == dd[i,"player_1_id"]){ dd[i,"y"] <- 1 }else{ dd[i,"y"] <- 0 } k=k+1 } Archivo partidos y modelo write.csv(dd, file = "E:/TFG/partidos.csv") train <- dd %>% drop_na(tour_2_p1) write.csv(train, file = "E:/TFG/train.csv") Completar Height dd[dd$player_1_id == "J J Wolf","ht_p1"] <- 183; dd[dd$player_2_ id == "J J Wolf","ht_p2"] <- 183 dd[dd$player_1_id == "Alejandro Tabilo","ht_p1"] <- 188; dd[dd$p layer_2_id == "Alejandro Tabilo","ht_p2"] <- 188 dd[dd$player_1_id == "Bjorn Fratangelo","ht_p1"] <- 183; dd[dd$p layer_2_id == "Bjorn Fratangelo","ht_p2"] <- 183 dd[dd$player_1_id == "Ernesto Escobedo","ht_p1"] <- 185; dd[dd$p layer_2_id == "Ernesto Escobedo","ht_p2"] <- 185 dd[dd$player_1_id == "Thomas Fabbiano","ht_p1"] <- 173; dd[dd$pl ayer_2_id == "Thomas Fabbiano","ht_p2"] <- 173 dd[dd$player_1_id == "Maximilian Marterer","ht_p1"] <- 191; dd[d d$player_2_id == "Maximilian Marterer","ht_p2"] <- 191 dd[dd$player_1_id == "Juan Ignacio Londero","ht_p1"] <- 180; dd[ dd$player_2_id == "Juan Ignacio Londero","ht_p2"] <- 180 dd[dd$player_1_id == "Jared Donaldson","ht_p1"] <- 188; dd[dd$pl ayer_2_id == "Jared Donaldson","ht_p2"] <- 188 dd[dd$player_1_id == "Adrian Menendez Maceiras","ht_p1"] <- 183; dd[dd$player_2_id == "Adrian Menendez Maceiras","ht_p2"] <- 183 dd[dd$player_1_id == "Jason Jung","ht_p1"] <- 178; dd[dd$player_ 2_id == "Jason Jung","ht_p2"] <- 178 dd[dd$player_1_id == "Mackenzie Mcdonald","ht_p1"] <- 178; dd[dd 48 $player_2_id == "Mackenzie Mcdonald","ht_p2"] <- 178 dd[dd$player_1_id == "Nicolas Kicker","ht_p1"] <- 178; dd[dd$pla yer_2_id == "Nicolas Kicker","ht_p2"] <- 178 dd[dd$player_1_id == "Marco Trungelliti","ht_p1"] <- 178; dd[dd$ player_2_id == "Marco Trungelliti","ht_p2"] <- 178 dd[dd$player_1_id == "Noah Rubin","ht_p1"] <- 175; dd[dd$player_ 2_id == "Noah Rubin","ht_p2"] <- 175 dd[dd$player_1_id == "Pedro Martinez","ht_p1"] <- 185; dd[dd$pla yer_2_id == "Pedro Martinez","ht_p2"] <- 185 dd[dd$player_1_id == "Alex Bolt","ht_p1"] <- 183; dd[dd$player_2 _id == "Alex Bolt","ht_p2"] <- 183 dd[dd$player_1_id == "Stefan Kozlov","ht_p1"] <- 183; dd[dd$play er_2_id == "Stefan Kozlov","ht_p2"] <- 183 Detectar jugadores que vale la pena meter altura (código ejemplo, hacer con contadores mejor) pr <-dd%>% filter(tourney_date >= as.Date("2016-01-01", "%Y-%m-% d")) pr <- sqldf::sqldf("SELECT winner_name, winner_ht, count(*) AS n FROM pr WHERE tourney_level = 'A' GROUP BY winner_name HAVING n > 10") pr <- pr[is.na(pr$winner_ht),] 49 Modelos set.seed(481078860) train <- read.csv("E:/TFG/train2.csv");train$y <- as.factor(trai n$y) train <- train %>% drop_na(sur_2_p1,sur_2_p2) train$surface <- as.factor(train$surface) train$age_p1 <- as.numeric(train$age_p1);train$age_p2 <- as.nume ric(train$age_p2) train$ht_p1 <- as.numeric(train$ht_p1);train$ht_p2 <- as.numeric (train$ht_p2) #6 años train6 <- train[train$contador6_p1 >= 50,];train6 <- train6[trai n6$contador6_p2 >= 50,] train6 <- train6[train6$contador6_surtur_p1 >= 10,];train6 <- tr ain6[train6$contador6_surtur_p2 >= 10,] #4 años train4 <- train[train$contador4_p1 >= 50,];train4 <- train4[trai n4$contador4_p2 >= 50,] train4 <- train4[train4$contador4_surtur_p1 >= 10,];train4 <- tr ain4[train4$contador4_surtur_p2 >= 10,] #2 años train2 <- train[train$contador2_p1 >= 50,];train2 <- train2[trai n2$contador2_p2 >= 50,] train2 <- train2[train2$contador2_surtur_p1 >= 10,];train2 <- tr ain2[train2$contador2_surtur_p2 >= 10,] Modelización predictive_metrics <- function(dd){ dd[,"age_dif"] <- dd[,"age_p1"]-dd[,"age_p2"] dd[,"ht_dif"] <- dd[,"ht_p1"]-dd[,"ht_p2"] ################################################################ ############### dd[,"sur_2_dif"] <- dd[,"sur_2_p1"]-dd[,"sur_2_p2"] dd[,"sur_4_dif"] <- dd[,"sur_4_p1"]-dd[,"sur_4_p2"] dd[,"sur_6_dif"] <- dd[,"sur_6_p1"]-dd[,"sur_6_p2"] dd[,"tour_2_dif"] <- dd[,"tour_2_p1"]-dd[,"tour_2_p2"] dd[,"tour_4_dif"] <- dd[,"tour_4_p1"]-dd[,"tour_4_p2"] dd[,"tour_6_dif"] <- dd[,"tour_6_p1"]-dd[,"tour_6_p2"] dd[,"surtour_2_dif"] <- dd[,"surtour_2_p1"]-dd[,"surtour_2_p2"] dd[,"surtour_4_dif"] <- dd[,"surtour_4_p1"]-dd[,"surtour_4_p2"] 50 dd[,"surtour_6_dif"] <- dd[,"surtour_6_p1"]-dd[,"surtour_6_p2"] ################################################################ ############### dd[,"h2h_6_dif"] <- dd[,"h2h_6_p1"]-dd[,"h2h_6_p2"] dd[,"h2h_3_dif"] <- dd[,"h2h_3_p1"]-dd[,"h2h_3_p2"] dd[,"h2h_1_dif"] <- dd[,"h2h_1_p1"]-dd[,"h2h_1_p2"] dd[,"h2h_6_sur_dif"] <- dd[,"h2h_6_sur_p1"]-dd[,"h2h_6_sur_p2"] dd[,"h2h_3_sur_dif"] <- dd[,"h2h_3_sur_p1"]-dd[,"h2h_3_sur_p2"] dd[,"h2h_1_sur_dif"] <- dd[,"h2h_1_sur_p1"]-dd[,"h2h_1_sur_p2"] ################################################################ ############### dd[,"rf_6_12_dif"] <- dd[,"rf_6_12_p1"]-dd[,"rf_6_12_p2"] dd[,"rf_6_6_dif"] <- dd[,"rf_6_6_p1"]-dd[,"rf_6_6_p2"] dd[,"rf_6_3_dif"] <- dd[,"rf_6_3_p1"]-dd[,"rf_6_3_p2"] dd[,"rf_6_1_dif"] <- dd[,"rf_6_1_p1"]-dd[,"rf_6_1_p2"] dd[,"rf_4_12_dif"] <- dd[,"rf_4_12_p1"]-dd[,"rf_4_12_p2"] dd[,"rf_4_6_dif"] <- dd[,"rf_4_6_p1"]-dd[,"rf_4_6_p2"] dd[,"rf_4_3_dif"] <- dd[,"rf_4_3_p1"]-dd[,"rf_4_3_p2"] dd[,"rf_4_1_dif"] <- dd[,"rf_4_1_p1"]-dd[,"rf_4_1_p2"] dd[,"rf_2_12_dif"] <- dd[,"rf_2_12_p1"]-dd[,"rf_2_12_p2"] dd[,"rf_2_6_dif"] <- dd[,"rf_2_6_p1"]-dd[,"rf_2_6_p2"] dd[,"rf_2_3_dif"] <- dd[,"rf_2_3_p1"]-dd[,"rf_2_3_p2"] dd[,"rf_2_1_dif"] <- dd[,"rf_2_1_p1"]-dd[,"rf_2_1_p2"] keep2 <- c("y","age_dif","ht_dif","sur_6_dif","sur_4_dif","sur_2 _dif", "tour_6_dif","tour_4_dif","tour_2_dif", "surtour_6_di f", "surtour_4_dif", "surtour_2_dif", "h2h_6_dif", "h2h_3_dif", "h2h_1_dif", "h2h_6_sur_dif ", "h2h_3_sur_dif", "h2h_1_sur_dif", "rf_6_12_dif", "rf_6_6_dif", "rf_6_3_dif","rf_6_1_dif ", "rf_4_12_dif", "rf_4_6_dif", "rf_4_3_dif","rf_4_1_dif ", "rf_2_12_dif", "rf_2_6_dif", "rf_2_3_dif","rf_2_1_dif ", "surface") dd <- dd[,keep2] return(dd) } Descriptiva (Bivariante) 51 pred6 <- predictive_metrics(train6) train6 <- predictive_metrics(train6) vars=colnames(train6)[c(4:12)] # windows(10,10) par(mfrow=c(3,3)) for (va in vars){ if (!is.factor(train6[,va])){ boxplot(as.formula(paste0(va,"~y")),train6,main=va,col=c(2,3 ),horizontal=T) } else{ barplot(prop.table(table(train6$y, train6[,va]),2),main=va,c ol=c(2,3)) } } vars=colnames(train6)[c(2)] # windows(10,10) par(mfrow=c(1,1)) for (va in vars){ if (!is.factor(train6[,va])){ boxplot(as.formula(paste0(va,"~y")),train6,main=va,col=c(2,3 ),horizontal=T) } else{ barplot(prop.table(table(train6$y, train6[,va]),2),main=va,c ol=c(2,3)) } } train6 <- train6 %>% drop_na(y,ht_dif) ggplot(train6, aes(x = surface, y = ht_dif)) + geom_bar( aes(color = y, fill = y), stat = "identity", position = position_dodge(0.8), width = 0.7 ) vars=colnames(train6)[c(13:18)] # windows(10,10) par(mfrow=c(2,3)) for (va in vars){ if (!is.factor(train6[,va])){ boxplot(as.formula(paste0(va,"~y")),train6,main=va,col=c(2,3 ),horizontal=T) } else{ barplot(prop.table(table(train6$y, train6[,va]),2),main=va,c ol=c(2,3)) } } vars=colnames(train6)[c(19:22)] # windows(10,10) 52 par(mfrow=c(2,2)) for (va in vars){ if (!is.factor(train6[,va])){ boxplot(as.formula(paste0(va,"~y")),train6,main=va,col=c(2,3 ),horizontal=T) } else{ barplot(prop.table(table(train6$y, train6[,va]),2),main=va,c ol=c(2,3)) } } vars=colnames(train6)[c(23:26)] # windows(10,10) par(mfrow=c(2,2)) for (va in vars){ if (!is.factor(train6[,va])){ boxplot(as.formula(paste0(va,"~y")),train6,main=va,col=c(2,3 ),horizontal=T) } else{ barplot(prop.table(table(train6$y, train6[,va]),2),main=va,c ol=c(2,3)) } } vars=colnames(train6)[c(27:30)] # windows(10,10) par(mfrow=c(2,2)) for (va in vars){ if (!is.factor(train6[,va])){ boxplot(as.formula(paste0(va,"~y")),train6,main=va,col=c(2,3 ),horizontal=T) } else{ barplot(prop.table(table(train6$y, train6[,va]),2),main=va,c ol=c(2,3)) } } Modelos 6 años #pred6 <- predictive_metrics(train6) pred6 <- pred6 %>% drop_na(sur_6_dif,tour_6_dif,surtour_6_dif,ag e_dif, h2h_6_dif , h2h_3_dif , h2h_1_dif , h 2h_6_sur_dif , h2h_3_sur_dif , h2h_1_sur_dif , ht_dif,rf_6_12_dif , rf_6_6_dif , rf_ 6_3_dif , rf_6_1_dif) m6a <- glm(y~ 0 + sur_6_dif + tour_6_dif + age_dif + ht_dif:surf ace + h2h_6_dif + h2h_3_dif + h2h_1_dif + h2h_6_sur_di f + h2h_3_sur_dif + h2h_1_sur_dif + rf_6_12_dif + rf_6_6_dif + rf_6_3_dif + rf_6_1_d if, 59 partidos[partidos$cf == "Aleksandar Vukic","htf"] <- 188;partido s[partidos$cf == "Dane Sweeny","htf"] <- 170 partidos[partidos$cf == "John Patrick Smith","htf"] <- 188;parti dos[partidos$cf == "Mikael Torpegaard","htf"] <- 193 partidos[partidos$cf == "Mario Vilella Martinez","htf"] <- 178;p artidos[partidos$cf == "Thomas Fancutt","htf"] <- 188 partidos[partidos$cf == "Andrew Harris","htf"] <- 183;partidos[p artidos$cf == "Borna Gojo","htf"] <- 196 partidos[partidos$cf == "Blake Mott","htf"] <- 180;partidos[part idos$cf == "Tomas Machac","htf"] <- 183 partidos[partidos$cf == "Quentin Halys","htf"] <- 191;partidos[p artidos$cf == "Jason Kubler","htf"] <- 178 partidos[partidos$cf == "Pedro Martinez","htf"] <- 185;partidos[ partidos$cf == "Sumit Nagal","htf"] <- 178 partidos[partidos$cf == "Frederico Ferreira Silva","htf"] <- 178 ;partidos[partidos$cf == "Li Tu","htf"] <- 180 partidos[partidos$cf == "Alejandro Tabilo","htf"] <- 188;partido s[partidos$cf == "Alex Bolt","htf"] <- 183 partidos[partidos$cf == "Arthur Rinderknech","htf"] <- 196;parti dos[partidos$cf == "Benjamin Bonzi","htf"] <- 183 partidos[partidos$cf == "Bernabe Zapata Miralles","htf"] <- 183; partidos[partidos$cf == "Brandon Nakashima","htf"] <- 188 partidos[partidos$cf == "Carlos Taberner","htf"] <- 183;partidos [partidos$cf == "Daniel Altmaier","htf"] <- 188 partidos[partidos$cf == "Christopher Eubanks","htf"] <- 201;part idos[partidos$cf == "Emilio Gomez","htf"] <- 185 partidos[partidos$cf == "Ernesto Escobedo","htf"] <- 185;partido s[partidos$cf == "Federico Coria","htf"] <- 180 partidos[partidos$cf == "Francisco Cerundolo","htf"] <- 185;part idos[partidos$cf == "Holger Rune","htf"] <- 188 partidos[partidos$cf == "Hugo Gaston","htf"] <- 173;partidos[par tidos$cf == "Jenson Brooksby","htf"] <- 193 partidos[partidos$cf == "Juan Ignacio Londero","htf"] <- 180;par tidos[partidos$cf == "Juan Manuel Cerundolo","htf"] <- 183 partidos[partidos$cf == "Liam Broady","htf"] <- 183;partidos[par tidos$cf == "Marc Polmans","htf"] <- 188 partidos[partidos$cf == "Tallon Griekspoor","htf"] <- 188;partid os[partidos$cf == "Thiago Seyboth Wild","htf"] <- 185 for(i in 1:nrow(partidos)){if(is.na(partidos[i,"htf"] == T)){par tidos[i,"htf"] <- trunc(mean(partidos$htf),na.rm=T)}} ranking = data.frame("jugador" = unique(partidos$cf), "puntos" = rep(0,length( unique(partidos$cf)))) write.csv(partidos, "F:/TFG/Cuadros/cuadros.csv") 60 Simulación library(tidyverse) library(readxl) library(Rlab) library(zoo) set.seed(22040619) cuadros <- read.csv("E:/TFG/Cuadros/cuadros.csv");cuadros <- cua dros[,-1] ranking = data.frame("jugador" = unique(cuadros$cf), "puntos" = rep(0,length(unique(cuadros$cf))));ranking <- ranking[-which(ran king$jugador == "BYE"),];rtot <- ranking;post <- rep(0, nrow(ran king)) colnames(cuadros) <- c("jugadores", "edad", "ht", "torneo", "sur face", "tourney_date", "tourney_type", "tipo"); cuadros$tourney_ date <- as.Date(cuadros$tourney_date) cuadros$ht <- as.numeric(cuadros$ht) mht <- trunc(mean(cuadros$ht,na.rm=T)) for(i in 1:nrow(cuadros)){if(is.na(cuadros[i,"ht"]) == T){cuadro s[i,"ht"] <- mht}} cuadros$edad <- as.numeric(cuadros$edad) partidos <- read.csv("E:/TFG/partidos.csv"); partidos$tourney_d ate <- as.Date(partidos$tourney_date) partidos <- partidos%>% filter(tourney_date < as.Date("2021-01-0 1", "%Y-%m-%d") & tourney_date >= as.Date("2017-01-01", "%Y-%m-% d")) partidos <- partidos[,c("surface", "tourney_date", "tourney_leve l", "winner_name", "loser_name")] partidosp <- partidos puntos <- read_excel("E:/TFG/Cuadros/puntos.xlsx") aht <- unique(cuadros[,c("jugadores","edad", "ht")]) ###### rp <- as.data.frame(ranking[,1]);rpo <- as.data.frame(ranking[,1 ]) ##### load("E:/TFG/modelf2.Rdata") load("E:/TFG/dataT2.RData") #nsim <- 10 #con=1 ini = Sys.time() ### SIMULACIÓN ### while(con <= nsim){ cuadrop <- cuadros partidos <- partidosp while(nrow(cuadrop) > 0){ # SEPARAR TORNEOS # k=2 61 while(cuadrop[1,"torneo"] == cuadrop[k,"torneo"] & k <= nrow(cua drop)){ end <- k k=k+1 } d <- cuadrop[1:end,] d <- dataT(d) add <- data.frame("surface" = NA,"tourney_date" = NA, "tourney_l evel" = NA,"winner_name" = NA,"loser_name" = NA) while(nrow(d)>=2){ i = 1 prob <- c() while(i < nrow(d)){ if(d[i,"jugadores"] == "BYE"){ prob <- c(prob,0) } else if(d[i+1,"jugadores"] == "BYE"){ prob <- c(prob,1) } else { h2h <- rbind(partidos %>% filter(winner_name == d[i,"jugad ores"] & loser_name==d[i+1,"jugadores"]), partidos %>% filter(winner_name == d[i+1,"jug adores"] & loser_name==d[i,"jugadores"])) if(nrow(h2h != 0)){ h2h1 <- length(h2h[h2h[i,"winner_name"] == d[i,"jugadore s"] & h2h[,"tourney_date"] >= (d[i,"tourney_date"] - 3*30*12),1] )/nrow(h2h) h2h2 <- length(h2h[h2h[i,"winner_name"] == d[i+1,"jugado res"] & h2h[,"tourney_date"] >= (d[i,"tourney_date"] - 3*30*12), 1])/nrow(h2h) } else { h2h1 <- 0;h2h2 <-0 } if(nrow(h2h != 0)){ h2h1_6 <- length(h2h[h2h[i,"winner_name"] == d[i,"jugado res"] & h2h[,"tourney_date"] >= (d[i,"tourney_date"] - 6*30*12), 1])/nrow(h2h) h2h2_6 <- length(h2h[h2h[i,"winner_name"] == d[i+1,"juga dores"] & h2h[,"tourney_date"] >= (d[i,"tourney_date"] - 6*30*12 ),1])/nrow(h2h) } else { h2h1_6 <- 0;h2h2_6 <-0 } pr <- predict(m4b, newdata = data.frame("surtour_4_dif" = 62 (d[i,"surtour_4"]-d[i+1,"surtour_4"]), "age_dif" = (d[i,"edad"] -d[i+1,"edad"]), "ht_dif" = (d[i,"ht"]-d[ i+1,"ht"]), "surface" = d[i,"surface "], "h2h_6_dif" = h2h1_6-h2h 2_6, "h2h_3_dif" = h2h1-h2h2, "rf_4_12_dif" = (d[i,"rf _4_12"]-d[i+1,"rf_4_12"]), "rf_4_3_dif" = (d[i,"rf_ 4_3"]-d[i+1,"rf_4_3"])) ,type="response") prob <- c(prob,pr) } i=i+2 } i = 1 ronda <- as.character(nrow(d)) while(i < nrow(d)){ ganador <- rbern(1,prob[i]) if(ganador == 1){ ranking[ranking$jugador == d[i+1,"jugadores"], "puntos"] < - ranking[ranking$jugador == d[i+1,"jugadores"], "puntos"] + as. numeric(puntos[puntos$Torneo == d[i+1,"tipo"], ronda ==colnames( puntos)]) add <- rbind(add, data.frame("surface" = d[i,"surface"],"t ourney_date" = as.Date(d[i,"tourney_date"]), "tourney_level" = d [i,"tourney_type"],"winner_name" = d[i,"jugadores"],"loser_name" = d[i+1,"jugadores"])) d <- d[-(i+1),] } else { ranking[ranking$jugador == d[i,"jugadores"], "puntos"] <- ranking[ranking$jugador == d[i,"jugadores"], "puntos"] + as.nume ric(puntos[puntos$Torneo == d[i,"tipo"], ronda ==colnames(puntos )]) add <- rbind(add, data.frame("surface" = d[i,"surface"],"t ourney_date" = as.Date(d[i,"tourney_date"]), "tourney_level" = d [i,"tourney_type"],"winner_name" = d[i+1,"jugadores"],"loser_nam e" = d[i,"jugadores"])) d<- d[-i,] } i = i+1 } } ranking[ranking$jugador == d[,"jugadores"], "puntos"] <- ranking [ranking$jugador == d[,"jugadores"], "puntos"] + as.numeric(punt 63 os[puntos$Torneo == d[,"tipo"], 1 == colnames(puntos)]) add<-add[-1,];add$tourney_date <- add$tourney_date <- as.Date(ad d$tourney_date) partidos <- rbind(partidos,add) cuadrop <- cuadrop[-c(1:end),] } pos <- rank(-ranking$puntos) ## ATP FINALS ## ranking$pos <- pos r8<-ranking[order(ranking$pos),] delete_j <- c("Stefanos Tsitsipas", "Rafael Nadal", "Matteo Berr ettini", "Dominic Thiem", "Cristian Garin") for(v in delete_j){r8 <- r8[-which(r8$jugador == v),]} r8 <- r8[1:8,] for (i in 1:nrow(r8)) { r8[i,"edad"] <- aht[match(r8[i,"jugador"], aht$jugadores),"eda d"] r8[i,"ht"] <- aht[match(r8[i,"jugador"], aht$jugadores),"ht"] r8[i,"surface"] <- "Hard"; r8[i,"tourney_type"] <- "F";r8[i,"t ourney_date"] <- as.Date("2021-11-22") } colnames(r8)[1] <- "jugadores" r8 <- dataT(r8) s <- sample(3:8,3) g1 <- r8[c(1,s),];g1$p <- 0;g1 <- fasegrupos(g1) g2 <- r8[-c(1,s),];g2$p <- 0;g2 <- fasegrupos(g2) for(i in 1:4){ranking[ranking$jugador == g1[i,"jugadores"], "pun tos"] <- ranking[ranking$jugador == g1[i,"jugadores"], "puntos"] + 200*g1[i,"p"] ranking[ranking$jugador == g2[i,"jugadores"], "puntos"] <- ranki ng[ranking$jugador == g2[i,"jugadores"], "puntos"] + 200*g2[i,"p "]} sem <- semis(g1,g2) d <- sem while(nrow(d)>=2){ i = 1 prob <- c() while(i < nrow(d)){ h2h <- rbind(partidos %>% filter(winner_name == d[i,"jugador es"] & loser_name==d[i+1,"jugadores"]), partidos %>% filter(winner_name == d[i+1,"jugad ores"] & loser_name==d[i,"jugadores"])) if(nrow(h2h != 0)){ 64 h2h1 <- length(h2h[h2h[i,"winner_name"] == d[i,"jugadores" ] & h2h[,"tourney_date"] >= (d[i,"tourney_date"] - 3*30*12),1])/ nrow(h2h) h2h2 <- length(h2h[h2h[i,"winner_name"] == d[i+1,"jugadore s"] & h2h[,"tourney_date"] >= (d[i,"tourney_date"] - 3*30*12),1] )/nrow(h2h) } else { h2h1 <- 0;h2h2 <-0 } if(nrow(h2h != 0)){ h2h1_6 <- length(h2h[h2h[i,"winner_name"] == d[i,"jugadore s"] & h2h[,"tourney_date"] >= (d[i,"tourney_date"] - 6*30*12),1] )/nrow(h2h) h2h2_6 <- length(h2h[h2h[i,"winner_name"] == d[i+1,"jugado res"] & h2h[,"tourney_date"] >= (d[i,"tourney_date"] - 6*30*12), 1])/nrow(h2h) } else { h2h1_6 <- 0;h2h2_6 <-0 } pr <- predict(m4b, newdata = data.frame("surtour_4_dif" = (d [i,"surtour_4"]-d[i+1,"surtour_4"]), "age_dif" = (d[i,"ed ad"]-d[i+1,"edad"]), "ht_dif" = (d[i,"ht" ]-d[i+1,"ht"]), "surface" = d[i,"sur face"], "h2h_6_dif" = h2h1_6 -h2h2_6, "h2h_3_dif" = h2h1-h 2h2, "rf_4_12_dif" = (d[i ,"rf_4_12"]-d[i+1,"rf_4_12"]), "rf_4_3_dif" = (d[i, "rf_4_3"]-d[i+1,"rf_4_3"])) ,type="response") prob <- c(prob,pr) i=i+2 } i = 1 while(i < nrow(d)){ ganador <- rbern(1,prob[i]) if(ganador == 1){ ranking[ranking$jugador == d[i+1,"jugadores"], "puntos"] < - ranking[ranking$jugador == d[i+1,"jugadores"], "puntos"] + 400 d <- d[-(i+1),] } else { ranking[ranking$jugador == d[i,"jugadores"], "puntos"] <- ranking[ranking$jugador == d[i,"jugadores"], "puntos"] + 400 65 d<- d[-i,] } i = i+1 } } ranking[ranking$jugador == d[1,"jugadores"], "puntos"] <- rankin g[ranking$jugador == d[1,"jugadores"], "puntos"] + 500 ################ # rtot$puntos <- rtot$puntos + ranking$puntos rp[,con+1] <- ranking$puntos rpo[,con+1] <- rank(-ranking$puntos) ranking$puntos <- 0; ranking <- ranking[,-3] con = con +1 #post <- post + pos } rtot[,2] <- rowMeans(rp[,-1]);rtot[,3] <- apply(rp[,-1], 1, sd) rtot[,4] <- rowMeans(rpo[,-1]);rtot[,5] <- apply(rpo[,-1], 1, sd ) rtot[,6] <- rank(-rtot$puntos) con=nsim+1 nsim <- 500 66 Resultados library(ggplot2) library(hrbrthemes) library(viridis) library(tidyverse) library(fmsb) ################### ## PRUEBA MODELO ## ################### (1/(1/1.9 + 1/1.9))/2.75 load("E:/TFG/modelf2.Rdata");load("E:/TFG/dataT.RData") partidos <- rbind(read.csv("https://raw.githubusercontent.com/Je ffSackmann/tennis_atp/master/atp_matches_2018.csv"), read.csv("https://raw.githubusercontent.com/Je ffSackmann/tennis_atp/master/atp_matches_2019.csv"), read.csv("https://raw.githubusercontent.com/Je ffSackmann/tennis_atp/master/atp_matches_2020.csv"), read.csv("https://raw.githubusercontent.com/Je ffSackmann/tennis_atp/master/atp_matches_2021.csv"), read.csv("https://raw.githubusercontent.com/Je ffSackmann/tennis_atp/master/atp_matches_2022.csv")) eliminate <- c() for(i in 1:nrow(partidos)){ a <- partidos[i,"score"] if(substr(a,nchar(a)-2,nchar(a)) == "RET" | substr(a,nchar(a)- 2,nchar(a)) == "W/O" | substr(a,1,nchar(a)) == ">" | substr(a,1,nchar(a)) == "0-0 0-0" | substr(a,1,nchar(a)) == "0-3" | substr(a,1,nchar(a)) == "0-3 Played and abandoned" | substr(a,1,nchar(a)) == "Walkover" | substr(a,1,nchar(a)) == "In Progress" | substr(a,1,nchar(a)) == "Def." | substr(a,1,n char(a)) == "Apr-00"){ eliminate <- c(eliminate,i) } } partidos <- partidos[-eliminate,] partidos$tourney_date <- as.Date(as.Date(as.character(partidos$t ourney_date), "%Y%m%d")); partidos <- partidos[,c("surface", "to urney_date", "tourney_level", "winner_name", "loser_name")] # RAFA NADAL - DANIIL MEDVEDEV / Australian Open date <- as.Date("2022-01-17") dd <- data.frame("jugadores" = c("Rafael Nadal","Daniil Medvedev "),"tourney_date" = rep(date,2), 67 "surface" = rep("Hard",2),"tourney_type" = rep( "G",2),"edad" = c(36,25),ht=c(185,198)) dd <- dataT(dd);h2h <- metricas_faltantes(dd,m4b) p1 <- predict(m4b, newdata = data.frame("surtour_4_dif" = (dd[1, "surtour_4"]-dd[2,"surtour_4"]), "age_dif" = (dd[1,"ed ad"]-dd[2,"edad"]), "ht_dif" = (dd[1,"ht" ]-dd[2,"ht"]), "surface" = dd[1,"sur face"], "h2h_6_dif" = h2h[1]- h2h[2], "h2h_3_dif" = h2h[3]- h2h[4], "rf_4_12_dif" = (dd[1 ,"rf_4_12"]-dd[2,"rf_4_12"]), "rf_4_3_dif" = (dd[1, "rf_4_3"]-dd[2,"rf_4_3"])) ,type="response");p2 <- 1-p1 ggplot(dd, aes(x="", y=c(p1,p2), fill=jugadores)) + geom_bar(stat="identity", width=1) + coord_polar("y", start=0) + theme_void() + theme(legend.position="none") + geom_text(aes(y = c(p1-0.5*p1,(p1+p2)-0.5*(p2)), label = jugad ores), color = "white", size=5.5) + geom_text(aes(y = c(0.90*p1-0.5*p1,0.95*(p1+p2)-0.5*(p2)), lab el = c(paste(round(p1*100,2), "%"),paste(round(p2*100,2), "%"))) , color = "white", size=4) + scale_fill_brewer(palette="Set1")+ ggtitle(label = "Rafa Nadal vs Daniil Medvedev", subtitle = "Austali an Open / Grand Slam - Dura") data <- data.frame("edad"=c(40,15), "height" = c(215,170),"surtu r" = c(1,0), "h2h3" = c(1,0),"h2h6" = c(1,0),"rf12" = c(0.15,-0. 15),"rf3" = c(0.15,-0.15)) data <- rbind(data, data.frame("edad"=dd[1,"edad"], "height" = dd[1,"h t"],"surtur" = dd[1,"surtour_4"], "h2h3" = h2h[1],"h2h6" = h2h[3],"rf12" = dd[1,"rf_4_12"],"rf3" = dd[1,"rf_4_3"]), data.frame("edad"=dd[2,"edad"], "height" = dd[2,"h t"],"surtur" = dd[2,"surtour_4"], "h2h3" = h2h[2],"h2h6" = h2h[4],"rf12" = dd[2,"rf_4_12"],"rf3" = dd[2,"rf_4_3"])) colors_border=c( rgb(0.2,0.5,0.5,0.9), rgb(0.8,0.2,0.5,0.9) , rg 68 b(0.7,0.5,0.1,0.9) ) colors_in=c( rgb(0.2,0.5,0.5,0.4), rgb(0.8,0.2,0.5,0.4) , rgb(0. 7,0.5,0.1,0.4) ) # plot with default options: radarchart(data, #custom polygon pcol=colors_border , pfcol=colors_in , plwd=4 , plty= 1, cglcol="grey", cglty=1, axislabcol="grey", caxislabel s=seq(0,20,5), cglwd=0.8, #custom labels vlcex=1.2 ) legend(x=0.7, y=1.4, legend = dd$jugadores, bty = "n", pch=20 , col=colors_in , text.col = "black", cex=1, pt.cex=3) # Novak Djokovic - Carlos Alcaraz date <- as.Date("2022-05-01") dd <- data.frame("jugadores" = c("Novak Djokovic","Carlos Alcara z"),"tourney_date" = rep(date,2), "surface" = rep("Clay",2),"tourney_type" = rep( "M",2),"edad" = c(34,19),ht=c(188,185)) dd <- dataT(dd);h2h <- metricas_faltantes(dd,m4b) p1 <- predict(m4b, newdata = data.frame("surtour_4_dif" = (dd[1, "surtour_4"]-dd[2,"surtour_4"]), "age_dif" = (dd[1,"edad" ]-dd[2,"edad"]), "ht_dif" = (dd[1,"ht"]-d d[2,"ht"]), "surface" = dd[1,"surfac e"], "h2h_6_dif" = h2h[1]-h2h [2], "h2h_3_dif" = h2h[3]-h2h [4], "rf_4_12_dif" = (dd[1,"r f_4_12"]-dd[2,"rf_4_12"]), "rf_4_3_dif" = (dd[1,"rf _4_3"]-dd[2,"rf_4_3"])) ,type="response");p2 <- 1-p1 ggplot(dd, aes(x="", y=c(p1,p2), fill=jugadores)) + geom_bar(stat="identity", width=1) + coord_polar("y", start=0) + theme_void() + theme(legend.position="none") + geom_text(aes(y = c(p1-0.5*p1,(p1+p2)-0.5*(p2)), label = jugad ores), color = "white", size=5.5) + 75 data[c(1,2),1] <- "Djokovic";data[c(21,22),1] <- "Norrie";data[c (7,8),1] <- "Tsitsipas";data[c(3,4),1] <- "Medvedev" data[c(5,6),1] <- "Zverev";data[c(9,10),1] <- "Rublev";data[c(13 ,14),1] <- "Hurkacz";data[c(27,28),1] <- "Shapovalov" ggplot(data, aes(fill=var, y=valor, x=jugador)) + geom_bar(position="dodge", stat="identity") + geom_hline(yinte rcept=15,col="black", size = 1, linetype="dashed") + xlab("Jugadores") + ylab("Ranking") + ggtitle("Ranking real y simulado del top 15") rm(list = ls()) ################################################ ## RESULTADOS JUGADORES DE INTERÉS SIMULACIÓN ## ################################################ library(ggplot2) rtot <- read.csv("C:/Users/luis.nuevo/Documents/TFG/sim.csv")[,- 1] rpo <- read.csv("C:/Users/luis.nuevo/Documents/TFG/rpo.csv")[,-1 ] rtot$dif <- rtot$real-rtot$V6 name = "Miomir Kecmanovic" # Ejemplo de jugador que se esperaba más (comentar resultados 2022) name = "Carlos Alcaraz" # No están los puntos de challenger (com entarlo), "imposible" de preveer subida de nivel de Carlos name = "Casper Ruud" # Ejemplo jugador bien predicho name = "Matteo Berrettini" # Ejemplo de jugador mal predicho caPo <- t(rpo[rpo$ranking...1. == name,]);caPo <- as.numeric(caP o[-1,]) boxplot(caPo, main = paste("Boxplot posiciones",name),xlab=paste ("Posición ranking Simulación = ",rtot[rtot$jugador==name,6]), ylim=c(0,max(rtot[rtot$jugador==name,7]+2,max(caPo))), c ol="orange", border = "brown", ylab = "Ranking", horizontal = F) points(rtot[rtot$jugador==name,6], col = "black",pch=16) points(rtot[rtot$jugador==name,7], col = "black",pch=1) text(x = 1.14,y = (rtot[rtot$jugador==name,7]-0), labels = paste ("Ranking Real = ", rtot[rtot$jugador==name,7]), cex = 0.8) Int <- Hmisc::cut2(caPo, seq(0,309,10)) pos <- data.frame("pos" = caPo,"int" = Int) ggplot(pos, aes(x=pos, y=int)) + geom_bar(stat="identity", fill="#f68060", alpha=.6, width=.4) + coord_flip() + xlab("") + theme_bw()