TRABAJO EN CLASE
Pinta Luis, Ochoa Santiago
2024-01-16
INTRODUCCIÓN
La Southwestern University (SWU), una destacada institución estatal ubicada en Stephenville, Texas, se erige como una potencia académica y deportiva en la región. Con una matrícula de aproximadamente 20,000 estudiantes, la universidad desempeña un papel crucial en la vida de la pequeña ciudad, superando en número a los residentes permanentes durante las estaciones de otoño y primavera. Reconocida por su excelencia en el fútbol americano, la SWU forma parte de la conferencia de los Once Grandes y constantemente figura entre las principales universidades en las clasificaciones deportivas. En un esfuerzo por consolidar su posición en el ámbito deportivo, la SWU contrató al legendario Bo Pitterno como entrenador en jefe en 2005. Aunque la consecución del codiciado primer puesto en las clasificaciones se mantenía esquiva, la asistencia a los juegos de fútbol en casa experimentó un crecimiento constante desde su llegada. Este aumento se tradujo no solo en una mayor participación de los aficionados, sino también en un incremento significativo en la venta de boletos por temporada. Éxito planteó nuevos desafíos para la SWU, específicamente en relación con la capacidad de su estadio, construido en 1953 con 54,000 asientos. Este informe explorará la evolución de la asistencia a los juegos durante los últimos seis años y abordará la solicitud del entrenador Pitterno de expandir el estadio o incluso construir uno nuevo. Además, se examinarán las preocupaciones administrativas, incluida la propuesta de Pitterno de agregar dormitorios exclusivos para atletas como parte de cualquier expansión. El presidente de la SWU, el Dr. Marty Starr, ha encargado a su vicepresidente la tarea de desarrollar un pronóstico que determine cuándo la instalación existente alcanzará su capacidad máxima. Además, se buscará proyectar los ingresos, considerando un precio promedio por boleto de $20 en el año 2011 y anticipando un aumento anual del 5% en los precios en los años venideros.
DESCRIPCIÓN DE LAS VARIABLES
JUEGO: Número de partidos disputados por año de las universidades de Estados Unidos.
AÑO: Año en las que se disputaron los partidos.
ASISTENCIA: Cantidad de personas que asistieron al partido.
OPONENTE: Equipo rival con las que se enfrentaron en los partidos.
DESARROLLO
Carga de la base de datos
library(readxl)
juego_futbol <- read_excel("C:/6to SEMESTRE/METODO CUANTITATIVO/juego_futbol.xlsx")
juego_futbol## # A tibble: 30 × 4
## Juego Año Asistencia Oponente
## <dbl> <dbl> <dbl> <chr>
## 1 1 2005 34200 Baylor
## 2 2 2005 39800 Texas
## 3 3 2005 38200 LSU
## 4 4 2005 26900 Arkansas
## 5 5 2005 35100 USC
## 6 1 2006 36100 Oklahoma
## 7 2 2006 40200 Nebraska
## 8 3 2006 39100 UCLA
## 9 4 2006 25300 Nevada
## 10 5 2006 36200 Obio State
## # ℹ 20 more rowsNOMBRE DE LAS VARIABLES DE LA BASE DE DATOS
# nombres de las variables
names(juego_futbol)## [1] "Juego" "Año" "Asistencia" "Oponente"TIPO DE CLASE DE LAS VARIABLES DE LA BASE DE DATOS
# Comprobar el tipo de clase de cada variable
clases <- sapply(juego_futbol, class)
clases## Juego Año Asistencia Oponente
## "numeric" "numeric" "numeric" "character"LIMPIEZA DE LA BASE DE DATOS
# Eliminar filas con valores faltantes
juegos <- na.omit(juego_futbol)
# Verificar el resultado
head(juegos)## # A tibble: 6 × 4
## Juego Año Asistencia Oponente
## <dbl> <dbl> <dbl> <chr>
## 1 1 2005 34200 Baylor
## 2 2 2005 39800 Texas
## 3 3 2005 38200 LSU
## 4 4 2005 26900 Arkansas
## 5 5 2005 35100 USC
## 6 1 2006 36100 OklahomaANÁLISIS DESCRIPTIVO
Descripción teórica:
Concepto y Fórmula:
Interpretación:
juegos1 <- juegos[, c("Asistencia")]
summary(juegos1)## Asistencia
## Min. :25300
## 1st Qu.:35950
## Median :40000
## Mean :39730
## 3rd Qu.:45475
## Max. :50100Interpretación
La asistencia a los juegos de fútbol en la Southwestern University (SWU).
Min (Mínimo): 25,300: La asistencia mínima registrada a lo largo del período analizado fue de 25,300 personas. Esto significa que, al menos en un evento, la cantidad de espectadores fue de 25,300.
1st Qu (Primer cuartil - 25%): 35,950: El primer cuartil indica que el 25% de los eventos tuvieron una asistencia de hasta 35,950 personas. Es un valor que muestra la dispersión de los datos en la parte inferior.
*Median (Mediana): 40,000: La mediana, o el valor que se encuentra en el medio cuando los datos se ordenan de menor a mayor, es de 40,000. Esto significa que la mitad de los eventos tuvo una asistencia inferior a este valor y la otra mitad tuvo una asistencia superior.
Mean (Media): 39,730: La media aritmética, o promedio, de la asistencia es de 39,730 personas. Este valor es influenciado por todos los eventos y puede ser afectado por valores extremos (outliers).
3rd Qu (Tercer cuartil - 75%): 45,475: El tercer cuartil indica que el 75% de los eventos tuvieron una asistencia de hasta 45,475 personas. Es un valor que muestra la dispersión de los datos en la parte superior.
Max (Máximo): 50,100: La asistencia máxima registrada a lo largo del período fue de 50,100 personas. Este es el valor más alto observado y representa el tope superior de la distribución de la asistencia.
Ofrecen una visión general de la variabilidad en la asistencia a los juegos de fútbol en la SWU, desde el mínimo hasta el máximo, y cómo se distribuyen los datos en diferentes partes del rango total.
GRÁFICA DE DISPERSION
plot(juegos$Asistencia, col = "red",main = "Gráfica de dispersón", xlab = "Frecuencia", ylab = "Asistencias")
# Línea para unir los puntos
plot(juegos$Asistencia, col = "blue", type = "l",main = "Gráfica de datos reales", xlab = "Frecuencia", ylab = "Asistencias")
RAMDON FOREST
library(ggplot2)
library(randomForest)## randomForest 4.7-1.1## Type rfNews() to see new features/changes/bug fixes.##
## Attaching package: 'randomForest'## The following object is masked from 'package:ggplot2':
##
## margin# Cargar datos
juego_futbol <- read_excel("C:/6to SEMESTRE/METODO CUANTITATIVO/juego_futbol.xlsx")
# Entrenar el modelo de Random Forest
set.seed(123) # Establecer semilla para reproducibilidad
modelo_rf <- randomForest(Asistencia ~ Juego + Año + Oponente, data = juego_futbol)
# Crear nuevos datos para el año 2011
nuevos_datos_2011 <- data.frame(
Juego = c(1, 2, 3, 4, 5),
Año = rep(2011, 5),
Oponente = c("Alaska", "Florida", "LSU", "Texas", "Montana")
)
# Hacer predicciones para el año 2011
predicciones_2011 <- predict(modelo_rf, nuevos_datos_2011)
predicciones_2011## 1 2 3 4 5
## 42579.64 43194.65 43790.94 38512.49 42400.45# Unir datos reales y predicciones
datos_prediccion <- data.frame(
Año = factor(c(juego_futbol$Año, nuevos_datos_2011$Año)),
Asistencia = c(juego_futbol$Asistencia, predicciones_2011)
)
datos_prediccion## Año Asistencia
## 1 2005 34200.00
## 2 2005 39800.00
## 3 2005 38200.00
## 4 2005 26900.00
## 5 2005 35100.00
## 6 2006 36100.00
## 7 2006 40200.00
## 8 2006 39100.00
## 9 2006 25300.00
## 10 2006 36200.00
## 11 2007 35900.00
## 12 2007 46500.00
## 13 2007 43100.00
## 14 2007 27900.00
## 15 2007 39200.00
## 16 2008 41900.00
## 17 2008 46100.00
## 18 2008 43900.00
## 19 2008 30100.00
## 20 2008 40500.00
## 21 2009 42500.00
## 22 2009 48200.00
## 23 2009 44200.00
## 24 2009 33900.00
## 25 2009 47800.00
## 26 2010 46900.00
## 27 2010 50100.00
## 28 2010 45900.00
## 29 2010 36300.00
## 30 2010 49900.00
## 31 2011 42579.64
## 32 2011 43194.65
## 33 2011 43790.94
## 34 2011 38512.49
## 35 2011 42400.45# Crear el gráfico
ggplot(datos_prediccion, aes(x = Año, y = Asistencia, group = 1)) +
geom_point(aes(color = Año), size = 3) + # Puntos para datos reales
geom_line(linetype = "dashed") + # Línea para predicciones
labs(title = "Asistencias Reales y Predicciones",
x = "Año",
y = "Asistencia") +
theme_minimal()
Como se observa en la gráfica las predicciones para el 2011, disminuyen comparado a las de 2010, y las asitencias obtenidas por los jugadores se podría decir que es algo estable igual que años más anteriores, en este caso para ese año no hubo buenas asistencias en el equipo.
plot(datos_prediccion$Asistencia, col = "red", type = "l",main = "Gráfica de Predicción", xlab = "Frecuencia", ylab = "Asistencias")
Los nuevos puntos igual indican las asitencias bajas comparado al año anterior, por lo cual se puede decir que el equipo no obtuvo buenos resultados.
SEGUNDO MÉTODO
# Importar la base de datos
juego <- read_excel("C:/6to SEMESTRE/METODO CUANTITATIVO/juego_futbol.xlsx")
# Crear la base de datos solo con el año 2011 para predecir
juego1 <- data.frame(Juego= c(1:5),Año=c(2011,2011,2011,2011,2011),Asistencia =
c("","","","",""),Oponente=c("","","","",""))
# Unir las dos bases de datos para predecir
juego_p <- rbind(juego,juego1)
# Entrenamiento
tr <- juego_p[1:35,]
# Convertir a numerica la variable Asistencia
tr$Asistencia <- as.numeric(tr$Asistencia)
#bosque aleatorio
rf <- randomForest(Asistencia~.,data = tr,importance=T,mtry=2,na.action = na.omit, ntree=35)
#Semilla
set.seed(1234)
#Prediccion
Prediccion <- predict(rf,tr)
Prediccion## 1 2 3 4 5 6 7 8
## 35465.71 39922.95 38260.00 29385.43 35801.52 36917.81 38694.10 39900.33
## 9 10 11 12 13 14 15 16
## 29329.24 35638.86 39235.95 43613.00 41366.05 31343.33 38098.48 41888.90
## 17 18 19 20 21 22 23 24
## 45310.00 43689.14 34203.67 38746.19 44511.95 46371.57 45145.86 36952.57
## 25 26 27 28 29 30 31 32
## 42738.38 45694.57 46206.33 46262.10 37498.81 43297.33 44265.10 45421.62
## 33 34 35
## 45227.38 37848.24 42558.76final <- data.frame("Juego" = juego_p$Juego, "Año" = juego_p$Año, "Asistencia"= juego_p$Asistencia,
"AsisPrediccion" = Prediccion,"Oponente" =juego_p$Oponente)
View(final)plot(final$AsisPrediccion, col = "blue", type = "l",main = "Gráfica de Predicción", xlab = "Frecuencia", ylab = "Asistencias")
asis <- final$AsisPrediccion
año <- final$Año
plot(año, asis, type = "o", pch = 16, col = "blue",
main = "Gráfico de Asistencias Predichas",
xlab = "Año", ylab = "Asistencias")
Como se puede observar en el modelo 2, las predicciones son algo más adecuados y se puede decir que las asistencias para el año 2011 mejoraron solomente un poco y el equipo obtuvo buenos unos resultados o encuentros moderados.
SERIE TEMPORAL
library(forecast)## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoojuego <- read_excel("C:/6to SEMESTRE/METODO CUANTITATIVO/juego_futbol.xlsx")
# Convertir a serie de tiempo la Asistencia hasta el 2010
s_juego <- ts(juego$Asistencia, start = 2005, end = c(2010,5), frequency = 5)
s_juego## Time Series:
## Start = c(2005, 1)
## End = c(2010, 5)
## Frequency = 5
## [1] 34200 39800 38200 26900 35100 36100 40200 39100 25300 36200 35900 46500
## [13] 43100 27900 39200 41900 46100 43900 30100 40500 42500 48200 44200 33900
## [25] 47800 46900 50100 45900 36300 49900#Pronosticar la Asistencia para el 2011 con un nivel de confianza del 96%
pronostics <- forecast(s_juego,h = 5,level = 0.96)
pronostics## Point Forecast Lo 96 Hi 96
## 2011.00 47324.53 42441.36 52207.71
## 2011.20 53511.72 47913.50 59109.95
## 2011.40 50484.76 45092.27 55877.24
## 2011.60 38446.40 34127.59 42765.21
## 2011.80 49127.07 43725.53 54528.60# Grafico de la serie de tiempo con el pronostico
autoplot(pronostics, main = "Gráfica de los pronósticos", ylab = "Asistencia", xlab = "Año")
CONCLUSIÓN
Dado las predicciones para el año 2011, el equipo tuvo diferentes encuentros y por lo que las predicción indica que no obtuvo buenos resultados en el primer moodelo comparado al año 2010, se podría decir que el equipo tuvo encuentros con bajas asistencias.
En el modelo 2 se puede decir que el equipo obtuvo unas asistencias adecuadas que favorecen al equipo.
El tercer modelo para hacer comparación de que tanto fueron buenos los resultados obtenidos se utilizo una serie temporal, donde comparado a los dos modelos anteriores se puede decir que sigue las mismas tendencias de predicción