Ejercicios de estadística aplicada al deporte. Grupo AL
Carlos Javier Camacho Marchante, Andrés Felipe Cárdenas Sandoval, Juan Luis Toledo Gómez.
2 de marzo del 2024.
{r setup, include=FALSE} knitr::opts_chunk$set(echo = TRUE)
Enlace al vídeo en YouTube con la explicación de los 3 primeros problemas: https://youtu.be/aGru_1Yocr4
Enlace al vídeo en YouTube con la explicación de los problemas 4, 5 y 6: https://youtu.be/5L-oUAT5weI
Enlace al vídeo en YouTube con la explicación de los problemas 7, 8 y 9: https://youtu.be/pYP4Hs__wFc
Enlace al vídeo en YouTube con la presentación del Banco de datos: https://youtu.be/96ys4SPEgV4
Ejercicio 1: Probabilidad
Sabemos que el ex-piloto venezolano de F1 Pastor Maldonado era muy rápido, pero sufría siendo consistente y evitando incidentes. La probabilidad de que Maldonado tenga un incidente está representada por \(INC\), y la probabilidad de que quede entre los 10 primeros y por lo tanto entre en los puntos está representada por \(PUN\). Viendo las estadísticas reales de su trayectoria en la F1, sabemos que \(P(INC)=0.417\), \(P(INC \cup PUN) = 0.532\) y \(P(INC \cap PUN)=0.031\):
- Calcula la probabilidad de que Maldonado entre en los puntos:
\(P(INC \cup PUN) = P(INC) + P(PUN) - P(INC \cap PUN)\). Despejando nos queda \(P(PUN) = P(INC \cup PUN) + P(INC \cap PUN) - P(INC)\), que resulta en que \(P(PUN) = 0.532 + 0.031 - 0.417\). Por lo tanto, la probabilidad de que Maldonado puntúe en un Gran Premio es \(P(PUN) = 0.146\).
- Calcula la probabilidad de que Maldonado entre en los puntos sabiendo que ha tenido un incidente:
\(P(PUN/INC) = \frac{P(PUN \cap INC)}{P(INC)} = \frac{0.031}{0.417} = 0.074\)
- Calcula la probabilidad de que Maldonado entre tenga un incidente sabiendo que ha entrado en los puntos:
\(P(INC/PUN) = \frac{P(INC \cap PUN)}{P(PUN)} = \frac{0.031}{0.146} = 0.212\)
- ¿Son independientes que Maldonado tenga un incidente de que entre en los puntos?.
Para que sean sucesos independientes, debe cumplirse que \(P(PUN \cap INC)=0.031\) debe ser igual a \(P(PUN)P(INC)=0.146*0.417=0.061\). Al no ser igual, deducimos que no son sucesos independientes, y por lo tanto uno afecta al otro. También se puede saber viendo que \(P(PUN/INC)=0.074\) y \(P(PUN)=0.146\) no dan el mismo valor.
Ejercicio 2: Variable aleatoria
En la NBA se juntan los jugadores de más alto nivel del baloncesto mundial. Tomando una muestra de 5 jugadores, tenemos las siguientes probabilidades de que X número de jugadores de esa muestra hayan sido All-Star alguna vez en su carrera: \(P(X=0)=0.5\), \(P(X=1)=0.2\), \(P(X=2)=0.13\), \(P(X=3)=0.09\), \(P(X=4)=0.05\), \(P(X=5)=0.03\).
- Calcula la probabilidad de que más de un jugador haya sido All-Star.
\(P(X > 1)\) = \(P(X = 2)\) + \(P(X = 3)\) + \(P(X = 4)\) + \(P(X = 5)\) =
sum (0.13,0.09,0.05,0.03)## [1] 0.3- Calcula la probabilidad de que haya más de 3 All-Star sabiendo que hay más de uno.
\(P(X> 3/X>1)\frac{P(X>3)}{P(X>1)}=\frac{1-P(X\leq3)}{1-P(X\leq1)}\)=0.2666667
- Calcula la media de jugadores All-Star en activo.
Media = \((0*0.5)+(1*0.2)+(2*0.13)+(3*0.09)+(4*0.05)+(5*0.03)\) =
sum (0,0.2,0.26,0.27,0.2,0.15)## [1] 1.08- Calcula la varianza de jugadores All-Star en activo.
Media = \((0-1.08)^2*0.5+(1-1.08)^2*0.2+(2-1.08)^2*0.13+(3-1.08)^2*0.09+(4-1.08)^2*0.05+(5-1.08)^2*0.03\) =
sum ((0-1.08)^2*0.5,(1-1.08)^2*0.2,(2-1.08)^2*0.13,(3-1.08)^2*0.09,(4-1.08)^2*0.05,(5-1.08)^2*0.03)## [1] 1.9136***
Ejercicio 3: Distribuciones de probabilidad
Veamos la representación de una variable aleatoria generada:
datosVari <- rnorm(1000)media <- mean(datosVari)
desviacion_estandar <- sd(datosVari)hist(datosVari, main = "Histograma de la distribución normal estándar",
xlab = "Valor", ylab = "Frecuencia")
boxplot(datosVari, main = "Diagrama de Caja y Bigotes", ylab = "Valor")
cat("Media:", media, "\n")## Media: 0.0310544cat("Desviación Estándar:", desviacion_estandar, "\n")## Desviación Estándar: 1.001242Calculamos las siguientes probabilidades:
\(P(X\leq 1)\)=
pnorm (1)## [1] 0.8413447\(P(X = 2)\) = 0 (recordemos que es una distribución normal, por lo que la probabilidad de que tenga un valor en concreto es 0).
\(P(-1 \leq X \leq 1)\)=
pnorm(1) - pnorm(-1)## [1] 0.6826895Calculamos el cuantil del 75% de la distribución:
quantile(datosVari, 0.75)## 75%
## 0.6963967Ejercicio 4: Distribución binomial
El equipo checo Viktoria Plzeň está en los cuartos de final de la UEFA Conference League, con una gran actuación grupal. Tomamos como referencia el goleador del equipo Tomas Chory, que tiene una probabilidad de marcar gol cada vez que tira a portería de 0.15. Tomando este dato, suponemos que en la vuelta del partido contra la Fiorentina podrá disparar 8 veces.
¿Cuál es la probabilidad de que marque un hat-trick? (Probabilidad de que marque exactamente 3 goles)
dbinom (3, 8, 0.15)## [1] 0.0838603¿Cuál es la probabilidad de que marque al menos un gol?
1-dbinom(0, 8, 0.15)## [1] 0.7275095Sabiendo que ha marcado más de un gol, ¿Cuál es la probabilidad de que haya metido dos goles?
X = probabilidad de que Chory marque gol. \((P(X=2) \cap P(X>=1))/P(X>=1)\) \(P(X=2)/P(X>=1)\)
(dbinom(2, 8, 0.15))/(1-pbinom(0, 8, 0.15))## [1] 0.3265995¿Cuál es la probabilidad de que en un partido meta entre 2 y 4 goles? \(P(2 <= X <= 4)\) \(P(X<=4) - P (X<=1)\)
(pbinom(4, 8, 0.15))-(pbinom(1, 8, 0.15))## [1] 0.3399631Ejercicio 5: Contraste de hipótesis
Un famoso programa de televisión quiere hacer un estudio de la estatura media de una población. La televisión ha escogido a 1000 personas entre 18 y 45 años. La estatura media de esta muestra ha salido que es de 173cm con desviación tipica 18cm.
¿Cuál es el intervalo de confianza del 95% para la altura media?
xbarra=173
sigma=18
n=1000
alpha=0.05 #es 1-nivel de confianza
xbarra-qnorm(1-alpha/2)*sigma/sqrt(n)## [1] 171.8844xbarra+qnorm(1-alpha/2)*sigma/sqrt(n)## [1] 174.1156El estudio asegura que la altura media está entre 172 y 174. ¿Con qué nivel de confianza puede afirmar eso?
Tomamos X=172 \(172 = 173-Zα/2 * (18/sqrt(1000))\) \(Zα/2 = (173-172)/(18/sqrt(1000))\)
(173-172)/(18/sqrt(1000))## [1] 1.756821\(P(Z<=Zα/2) = 1-(α/2)\) \(P(Z<1.756821) = pnorm(1.756821)\)
pnorm(1.756821)## [1] 0.9605258\(1-(α/2)=0.9605258\) \(α/2 = 1-0.9605258\) \(α=2*0.0394742\) \(α=0.0789484\) Nivel de confianza= 1-α = 1-0.0789484 = 0.9210516 El nivel de confianza es de un 92.11%
Ejercicio 6: Contraste de hipótesis
En una ciudad de Alemania se estudia la contaminación de dos componetes quimicos, se sabe que la tasa de contaminación tiene aproximadamente la misma desviacion estándar, siendo σ= σ2= 4 kg/m2.Estudiando la cuidad se prueban dos muestras aleatorias de n1=30 y n2=20.Como medias muestrales de la tasa de contaminación tenemos que X̄1= 20 kg/m2 y X̄2=27 kg/m2,Tambien se sabe que por estudio previo de los datos siguen distribuciones normales.
Construir un intervalo de confianza bilateral del 99% para diferencia entre las medias de tasa de contaminación.
- Una vez tenemos todos los datos seguimos la formula siguiente: zs = ((¯x1−x¯2)−d0)/√(σ2/n1)+(σ2/n2)
¯x1−x¯2 +- zα/2*√(σ2/n1)+(σ2/n2)
Y tambien P(z<=zα/2)=1-α/2= 0.995
qnorm(0.995)## [1] 2.575829(20-27)-qnorm(0.995)*(sqrt((8/20)+(8/20)))## [1] -9.303892(20-27)+qnorm(0.995)*(sqrt((8/20)+(8/20)))## [1] -4.696108(-9.303892,-4.696108) seria el intervalo de confianza al 99% para la diferencia de las tasas de contaminación.
Probar la hipotesis de que los dos componentes quimicos tienen la misma cantidad de contaminación por metro cuadrado promedia.Utilizar α=0,05. Siguiendo la formula de contraste: zs = ((¯x1−x¯2)−d0)/√(σ2/n1)+(σ2/n2)
(20-27)/(sqrt((8/20)+(8/20)))## [1] -7.826238Como nuestra Región critica esta comprendida entre z<zα/2 y z>zα/2 que si lo miramos en las tablas seria zα/2=1,96 y como nuestro resultado es -7.826238 esto nos diría que son distintas al 95%.
Ejercicio 7:
Por unos problemas no hemos podido hacer el 7, lo sentimos.
Ejercicio 8: Anova
En un estudio con jugadores de varios equipos de fútbol que estarán en las finales de torneos europeos, se ha querido medir la potencia de disparo (en km/h) de varios de los delanteros de cada equipo.
Atalanta B.C.: 84.3, 86.5, 91.2, 89.6, 82.1, 92.9, 90.0 Real Madrid C.F.: 91.2, 84.6, 88.8, 80.1, 90.2, 81.4, 84.8 Olympiakos F.C.: 87.9, 92.1, 84.1, 94.8, 85.9, 87.0, 89.9
¿Cuál será el valor estadístico? ¿Cuál será el p-valor? ¿Cuál será el límite de confianza superior e inferior del 90% de la potencia de disparo de los jugadores del Olympiakos F.C.? Haz un diagrama de cajas con los valores de potencia de tiro.
Atalanta = c (84.3, 86.5, 91.2, 89.6, 82.1, 92.9, 90.0)
RealMadrid = c (91.2, 84.6, 88.8, 80.1, 90.2, 81.4, 84.8)
Olympiakos = c (87.9, 92.1, 84.1, 94.8, 85.9, 87.0, 89.9)
estudiados = c (Atalanta, RealMadrid, Olympiakos)
equipos = factor(rep(c("Atalanta B.C.", "Real Madrid C.F.", "Olympiakos F.C."), c(7,7,7)))
summary(aov(estudiados~equipos))## Df Sum Sq Mean Sq F value Pr(>F)
## equipos 2 32.89 16.44 1.035 0.375
## Residuals 18 285.93 15.88El p-valor sería 0.375
conf_int <- t.test(Olympiakos, conf.level = 0.90)$conf.int
conf_int## [1] 86.08841 91.54016
## attr(,"conf.level")
## [1] 0.9El límite de confianza inferior al 90% es de 86.08841 km/h y el superior de 91.54016 km/h.
boxplot(estudiados~equipos, main = "Potencia de disparo de los equipos", xlab = "Equipo", ylab = "Potencia (km/h)",
col = c("darkblue", "red", "white"))
Ejercicio 9: Regresión lineal
A lo largo del pasado año 2023, una inmobiliaria en Albacete ha tenido mucho éxito este año y se han hecho multimillonarios con las ventas de propiedades realizadas. Vamos a tomar una muestra de 10 ventas, y vamos a tomar como variables los m2 de la propiedad y el precio de la misma.
m2=c(300,226,189,548,412,333,275,210,488,197)
precio=c(86000,70000,57500,115000,101700,94340,81500,63900,108000,60100)Los 2 vectores están relacionados (el primer elemento del primer vector está relacionado con el primer elemento del segundo).
Vamos a considerar los metros cuadrados como variable X y el precio como variable Y. Ahora vamos a calcular n, “x barra” e “y barra”.
n=10
x_barra = mean (m2)
y_barra = mean (precio)Ahora utilizamos la función lm(y~x) para calcular los parámetros de la recta.
lm(formula = precio~m2)##
## Call:
## lm(formula = precio ~ m2)
##
## Coefficients:
## (Intercept) m2
## 33487.9 158.3La recta que nos sale es: Y=33487.9 + 158.3*x
La interpretación de este resultado es que por cada metro cuadrado que es más grande una propiedad, su precio se incrementa en promedio 158.3 euros.
Banco de Datos: Datos sobre fumadores en el Reino Unido
Tenemos datos de 1691 personas en el Reino Unido sobre si fuman o no, y sus características como su estado civil, si son hombre o mujer, etc. Extraeremos ciertos datos para representarlos en gráficas, y así tener una mejor visión de la población.
A continuación, cargaremos varios datos necesarios para representarlos.
smoking <- read.csv("C:/Users/ikeji/Downloads/smoking.csv")
total <- nrow(smoking)
numHombres <- sum(smoking$gender=="Male")
numMujeres <- sum(smoking$gender=="Female")
numMujeresFuman <- sum(smoking$gender=="Female")
hombresFuman <- subset(smoking, gender == "Male" & smoke == "Yes")
numHombresFuman <- nrow(hombresFuman)
mujeresFuman <- subset(smoking, gender == "Female" & smoke == "Yes")
numMujeresFuman <- nrow(mujeresFuman)
hombresNoFuman <- subset(smoking, gender == "Male" & smoke == "No")
numHombresNoFuman <- nrow(hombresNoFuman)
mujeresNoFuman <- subset(smoking, gender == "Female" & smoke == "No")
numMujeresNoFuman <- nrow(mujeresNoFuman)Haremos un gráfico para distribuir la población en 4 partes: Hombres que fuman y que no lo hacen, y mujeres que fuman y que no lo hacen.
gr1 <- c(numHombresFuman, numHombresNoFuman, numMujeresFuman, numMujeresNoFuman)
porcentajes <- round((gr1 / sum(gr1)) * 100, 1)
categorias_con_porcentajes <- paste(c("Hombres que fuman", "Hombres que no fuman", "Mujeres que fuman", "Mujeres que no fuman"), "(", porcentajes, "%)", sep = "")
pie(gr1, labels = categorias_con_porcentajes, main = "Distribución de fumadores y no fumadores por género")
Gracias al gráfico, vemos que no hay muchas diferencias entre los grupos de hombres y mujeres, ya que tienen porcentajes similares en cuanto a fumar y no fumar.
Ahora veremos el porcentaje de fumadores que están divorciados, casados, separados, solteros y viudos. Para ello, cargaremos los datos necesarios y generaremos un gráfico.
library(ggplot2)
smokers <- smoking[smoking$smoke == "Yes", ]
percentage_marital <- prop.table(table(smokers$marital_status)) * 100
df <- data.frame(marital_status = names(percentage_marital), percentage = as.numeric(percentage_marital))
df$marital_status <- factor(df$marital_status, levels = c("Divorced", "Married", "Separated", "Single", "Widowed"))
ggplot(df, aes(x = marital_status, y = percentage, fill = marital_status)) +
geom_bar(stat = "identity") +
labs(title = "Porcentaje de fumadores según estado civil",
x = "Estado Civil",
y = "Porcentaje de fumadores")
Se puede ver que un gran porcentaje de fumadores estan casados o solteros. Sin embargo, esto puede ser porque el estudio tenga más datos de gente casada y soltera que de gente divorciada, separada o viuda.
Vamos a comprobarlo a continuación:
gDiv <- subset(smoking, marital_status == "Divorced")
gCas <- subset(smoking, marital_status == "Married")
gSep <- subset(smoking, marital_status == "Separated")
gSol <- subset(smoking, marital_status == "Single")
gViu <- subset(smoking, marital_status == "Widowed")
fumDiv <- subset(smoking, smoke == "Yes" & marital_status == "Divorced")
fumCas <- subset(smoking, smoke == "Yes" & marital_status == "Married")
fumSep <- subset(smoking, smoke == "Yes" & marital_status == "Separated")
fumSol <- subset(smoking, smoke == "Yes" & marital_status == "Single")
fumViu <- subset(smoking, smoke == "Yes" & marital_status == "Widowed")
nFDiv <- nrow(fumDiv)
nFCas <- nrow(fumCas)
nFSep <- nrow(fumSep)
nFSol <- nrow(fumSol)
nFViu <- nrow(fumViu)
nDiv <- nrow(gDiv)
nCas <- nrow(gCas)
nSep <- nrow(gSep)
nSol <- nrow(gSol)
nViu <- nrow(gViu)
porcDiv <- (nFDiv/nDiv)*100
porcCas <- (nFCas/nCas)*100
porcSep <- (nFSep/nSep)*100
porcSol <- (nFSol/nSol)*100
porcViu <- (nFViu/nViu)*100Ahora, mostramos los resultados:
Porcentaje de divorciados que son fumadores: 36.0%
Porcentaje de casados que son fumadores: 17.6%
Porcentaje de separados que son fumadores: 32.4%
Porcentaje de solteros que son fumadores: 37.0%
Porcentaje de viudos que son fumadores: 17.9%
Como podemos ver, hay un gran porcentaje de solteros, divorciados y separados que son fumadores. Esto puede indicar que las relaciones entre alguien que fuma y alguien que no lo hace no suelen darse, y si se dan, no llegan a buen puerto en un alto porcentaje de ocasiones. En general, es más difícil tener una relación sentimental si fumas a si no lo haces.
Ahora, vamos a plantear una hipótesis, para después comprobar si es verdadera o no.
Hipótesis inicial: la renta de una persona no afecta a la probabilidad de que esta fume o viceversa.
Para comprobar si esa hipótesis es cierta, estudiaremos con datos el porcentaje de fumadores por cada grupo de ingresos:
fumadores1 <- subset(smoking, smoke == "Yes" & gross_income == "Under 2,600")
numfum1 <- nrow(fumadores1)
gente1 <- subset(smoking, gross_income == "Under 2,600")
numgen1 <- nrow(gente1)
porc1 <- (numfum1/numgen1)*100
fumadores2 <- subset(smoking, smoke == "Yes" & gross_income == "2,600 to 5,200")
numfum2 <- nrow(fumadores2)
gente2 <- subset(smoking, gross_income == "2,600 to 5,200")
numgen2 <- nrow(gente2)
porc2 <- (numfum2/numgen2)*100
fumadores3 <- subset(smoking, smoke == "Yes" & gross_income == "5,200 to 10,400")
numfum3 <- nrow(fumadores3)
gente3 <- subset(smoking, gross_income == "5,200 to 10,400")
numgen3 <- nrow(gente3)
porc3 <- (numfum3/numgen3)*100
fumadores4 <- subset(smoking, smoke == "Yes" & gross_income == "10,400 to 15,600")
numfum4 <- nrow(fumadores4)
gente4 <- subset(smoking, gross_income == "10,400 to 15,600")
numgen4 <- nrow(gente4)
porc4 <- (numfum4/numgen4)*100
fumadores5 <- subset(smoking, smoke == "Yes" & gross_income == "15,600 to 20,800")
numfum5 <- nrow(fumadores5)
gente5 <- subset(smoking, gross_income == "15,600 to 20,800")
numgen5 <- nrow(gente5)
porc5 <- (numfum5/numgen5)*100
fumadores6 <- subset(smoking, smoke == "Yes" & gross_income == "20,800 to 28,600")
numfum6 <- nrow(fumadores6)
gente6 <- subset(smoking, gross_income == "20,800 to 28,600")
numgen6 <- nrow(gente6)
porc6 <- (numfum6/numgen6)*100
fumadores7 <- subset(smoking, smoke == "Yes" & gross_income == "28,600 to 36,400")
numfum7 <- nrow(fumadores7)
gente7 <- subset(smoking, gross_income == "28,600 to 36,400")
numgen7 <- nrow(gente7)
porc7 <- (numfum7/numgen7)*100
fumadores8 <- subset(smoking, smoke == "Yes" & gross_income == "Above 36,400")
numfum8 <- nrow(fumadores8)
gente8 <- subset(smoking, gross_income == "Above 36,400")
numgen8 <- nrow(gente8)
porc8 <- (numfum8/numgen8)*100Con esto, el porcentaje de fumadores en cada grupo de ingresos es:
Menos de 2.600£: 27.1%
Entre 2.600£ y 5.200£: 24.9%
Entre 5.200£ y 10.400£: 27.0%
Entre 10.400£ y 15.600£: 31.0%
Entre 15.600£ y 20.800£: 23.9%
Entre 20.800£ y 28.600£: 24.5%
Entre 28.600£ y 36.400£: 11.4%
Más de 36.400£: 16.9%
Esto nos muestra que los grupos que más porcentaje de fumadores tienen van desde los menos de 2.600£ a los 15.600£, con lo que se puede afirmar que la renta de una persona SÍ afecta a la probabilidad de que esta fume o viceversa. La hipótesis inicial que habíamos planteado queda descartada.
A continuación, veremos gráficos para demostrar la nueva hipótesis (La renta de una persona sí afecta a la probabilidad de que esta fume o viceversa). Para ello, dividiremos a la población en 2 grupos generales: renta baja (de menos de 2.600£ a 15.600£) y renta alta (de 15.600£ a más de 36.400£).
genteBajo <- numgen1 + numgen2 + numgen3 + numgen4
genteAlto <- numgen5 + numgen6 + numgen7 + numgen8
fumadoresBajo <- numfum1 + numfum2 + numfum3 + numfum4
fumadoresAlto <- numfum5 + numfum6 + numfum7 + numfum8
noFumadoresBajo <- (numgen1-numfum1) + (numgen2-numfum2) + (numgen3-numfum3) + (numgen4-numfum4)
noFumadoresAlto <- (numgen5-numfum5) + (numgen6-numfum6) + (numgen7-numfum7) + (numgen8-numfum8)
datosBajo <- c(fumadoresBajo, noFumadoresBajo)
datosAlto <- c(fumadoresAlto, noFumadoresAlto)
porcBajo <- round((datosBajo / sum(datosBajo)) * 100, 1)
porcAlto <- round((datosAlto / sum(datosAlto)) * 100, 1)
catBajo <- paste(c("Fumadores", "No fumadores"), "(", porcBajo, "%)", sep = "")
catBajo$colours <- c("yellow", "lightyellow")## Warning in catBajo$colours <- c("yellow", "lightyellow"): Realizando coercion
## de LHD a una listacatAlto <- paste(c("Fumadores", "No fumadores"), "(", porcAlto, "%)", sep = "")
catAlto$colours <- c("red", "pink")## Warning in catAlto$colours <- c("red", "pink"): Realizando coercion de LHD a
## una listapie(datosBajo, labels = catBajo, main = "Porcentaje de fumadores y no fumadores con renta BAJA", col = catBajo$colours)
pie(datosAlto, labels = catAlto, main = "Porcentaje de fumadores y no fumadores con renta ALTA", col = catAlto$colours)
Aquí se puede apreciar que hay una diferencia apreciable entre el porcentaje de fumadores de rentas bajas y rentas altas. Por lo tanto, hemos negado de forma correcta la primera hipótesis.