En base al dataset extraído de Kaggle, nombrado como “F1 Races Results dataset 1950 to 2024” se hará la aplicación del modelo de Regresión Lineal Simple, considerando dos hipótesis sobre los datos que conforman este dataset.
Antes de continuar con la temática central, es pertinente realizar una explicación sobre la Regresión Lineal Simple.
La regresión lineal es un modelo matemático que describe la relación entre varias variables. La tarea de la regresión consiste en predecir un parámetro (Y) a partir de un parámetro conocido X. En esencia, es como encontrar la mejor línea recta que conecta estos dos puntos.
No es posible trazar una línea recta que pase por todos los puntos de un gráfico si estos se encuentran ordenados de manera caótica. Por lo tanto, sólo se determina la ubicación óptima de esta línea mediante una regresión lineal. Algunos puntos seguirán distanciados de la recta, pero esta distancia debe ser mínima.
\[ Y=\beta_{0}+\beta _{1}X+\varepsilon \]
Variable Independiente (X): Es la que explica o predice, es decir, las variaciones en X ayudan a entender por qué Y cambia. Esta también se considera como el punto donde la línea de regresión cruza el eje Y.
Variable Dependiente (Y): Es lo que se quiere **predecir o explicar*, es el resultado principal que se quiere entender, explicar o predecir en el estudio. Es el “efecto” que es interesante analizar en relación con uno o más “causas” potenciales.
β₀ = Beta cero (Intercepto): Es el valor de Y cuando X = 0, considerado como El valor predeterminado de Y, Lo que Y “vale” antes de que X entre en acción, es decir, la parte fija de Y.
β₁ = Beta uno (Pendiente): Indica cuánto cambia Y por cada unidad que cambia X, y define la magnitud de la relación entre variables.
ε = Error aleatorio: Define la diferencia entre lo predicho y lo real, representa todo lo que el modelo NO puede explicar.
Es necesario tener en cuenta el coeficiente de determinación y el valor P.
R-cuadrado “R²” (coeficiente de determinación):
Valor-p:
Para la aplicación y hacerla de manera más práctica y organizada se pensó en una serie de pasos para concretar una regresión válida, esto se hará acorde a dos hipótesis:
H₀ (Hipótesis Nula): No existe relación significativa entre el año del Gran Premio y el tiempo de vuelta rápida.
H₁ (Hipótesis Alternativa): Existe una relación negativa significativa entre el año del Gran Premio y el tiempo de vuelta rápida.
str(fastest_laps_updated)
## 'data.frame': 1108 obs. of 6 variables:
## $ Grand.Prix: chr "Great Britain" "Monaco" "Indianapolis 500" "Switzerland" ...
## $ Driver : chr "Nino Farina " "Juan Manuel Fangio " "Johnnie Parsons " "Nino Farina " ...
## $ Car : chr "Alfa Romeo" "Alfa Romeo" "Kurtis Kraft Offenhauser" "Alfa Romeo" ...
## $ Time : chr "1:50.600" "1:51.000" "" "2:41.600" ...
## $ year : int 1950 1950 1950 1950 1950 1950 1950 1951 1951 1951 ...
## $ Code : chr "FAR" "FAN" "PAR" "FAR" ...
head(fastest_laps_updated)
## Grand.Prix Driver Car Time year
## 1 Great Britain Nino Farina Alfa Romeo 1:50.600 1950
## 2 Monaco Juan Manuel Fangio Alfa Romeo 1:51.000 1950
## 3 Indianapolis 500 Johnnie Parsons Kurtis Kraft Offenhauser 1950
## 4 Switzerland Nino Farina Alfa Romeo 2:41.600 1950
## 5 Belgium Nino Farina Alfa Romeo 4:34.100 1950
## 6 France Juan Manuel Fangio Alfa Romeo 2:35.600 1950
## Code
## 1 FAR
## 2 FAN
## 3 PAR
## 4 FAR
## 5 FAR
## 6 FAN
| GRAND PRIX | PILOTO | EQUIPO | TIEMPO | AÑO | CÓDIGO | TIEMPO (SEG) | |
|---|---|---|---|---|---|---|---|
| 1 | Great Britain | Nino Farina | Alfa Romeo | 1:50.600 | 1950 | FAR | 110.60 |
| 2 | Monaco | Juan Manuel Fangio | Alfa Romeo | 1:51.000 | 1950 | FAN | 111.00 |
| 4 | Switzerland | Nino Farina | Alfa Romeo | 2:41.600 | 1950 | FAR | 161.60 |
| 5 | Belgium | Nino Farina | Alfa Romeo | 4:34.100 | 1950 | FAR | 274.10 |
| 6 | France | Juan Manuel Fangio | Alfa Romeo | 2:35.600 | 1950 | FAN | 155.60 |
| 7 | Italy | Juan Manuel Fangio | Alfa Romeo | 2:00.000 | 1950 | FAN | 120.00 |
| 8 | Switzerland | Juan Manuel Fangio | Alfa Romeo | 2:51.100 | 1951 | FAN | 171.10 |
| 9 | Indianapolis 500 | Lee Wallard | Kurtis Kraft Offenhauser | 1:07.260 | 1951 | WAL | 67.26 |
| 10 | Belgium | Juan Manuel Fangio | Alfa Romeo | 4:22.100 | 1951 | FAN | 262.10 |
| 11 | France | Juan Manuel Fangio | Alfa Romeo | 2:27.800 | 1951 | FAN | 147.80 |
plot(datosf1$tiemposegs ~ datosf1$year,
main = "Relación: Año vs Tiempo de Vuelta",
xlab = "Año del Gran Premio",
ylab = "Tiempo de Vuelta (segundos)",
col = "blue",
pch = 19,
cex = 0.7)
cor.test(datosf1$tiemposegs,datosf1$year)
##
## Pearson's product-moment correlation
##
## data: datosf1$tiemposegs and datosf1$year
## t = -11.883, df = 1105, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.3878428 -0.2833147
## sample estimates:
## cor
## -0.3366153
Teniendo presente la siguiente tabla de correlación de Pearson, se
puede hacer el análisis de esto:
Evidentemente, se tiene una correlación media-baja, pero puntuando en que se trata de una relación inversa.
El valor-P también define que es altamente significativo y la relación no es por casualidad, sino que existe evidencia sólida de que la correlación es real
Para este apartado se hará un modelo lineal para así
establecer el coeficiente de determinación:
modeloh1<- lm(datosf1$tiemposegs ~ datosf1$year)
summary(modeloh1)
##
## Call:
## lm(formula = datosf1$tiemposegs ~ datosf1$year)
##
## Residuals:
## Min 1Q Median 3Q Max
## -81.83 -24.44 -9.10 9.29 475.36
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2321.4140 186.6843 12.44 <2e-16 ***
## datosf1$year -1.1134 0.0937 -11.88 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 63.46 on 1105 degrees of freedom
## Multiple R-squared: 0.1133, Adjusted R-squared: 0.1125
## F-statistic: 141.2 on 1 and 1105 DF, p-value: < 2.2e-16
| Concepto | Valor |
|---|---|
| Coeficiente de Determinación (R²) | 0.1133 |
| Porcentaje Explicado | 11.3 % |
| R² Ajustado | 0.1125 |
| Interpretación | Porcentaje de variación en el tiempo de vuelta explicado por el año |
| Concepto | Resultado |
|---|---|
| Valor-p obtenido | < 2.2e-16 |
| Umbral de significancia | 0.05 (5%) |
| ¿Es estadísticamente significativo? | SÍ |
El valor-p obtenido en el modelo es menor que 0.05, esto indica que se rechaza la hipótesis nula, o sea que existe evidencia estadísticamente significativa de que la relación entre año y tiempo de vuelta NO es producto del azar.
Entonces se puede confiar en que la relación observada es real y no una coincidencia.
En este apartado se sacan los parámetros que se usarán para la formulación de la ecuación:
param1<-summary(modeloh1)
coeficientes<-coef(modeloh1)
beta01<-coeficientes[1]
beta11<-coeficientes[2]
tablaparam<-data.frame(
"Parámetro" = c("β₀: Intersección", "β₁: Pendiente (año)"),
"Símbolo" = c("β₀", "β₁"),
"Valor Estimado" = c(
round(beta01, 4),
round(beta11, 4)
),
"Error Estándar" = c(
round(param1$coefficients[1, 2], 4),
round(param1$coefficients[2, 2], 4)
),
"Interpretación" = c(
"Tiempo de vuelta cuando el año es 0",
"Cambio en tiempo por cada aumento de 1 año"
)
)
kable(tablaparam, caption = "PARÁMETROS DEL MODELO DE REGRESIÓN LINEAL") %>%
kable_styling(
bootstrap_options = c("striped", "hover", "condensed"),
full_width = TRUE
) %>%
row_spec(0, bold = TRUE, color = "white", background = "#3498DB") %>%
column_spec(3, bold = TRUE, color = "#E74C3C")
| Parámetro | Símbolo | Valor.Estimado | Error.Estándar | Interpretación | |
|---|---|---|---|---|---|
| (Intercept) | β₀: Intersección | β₀ | 2321.4140 | 186.6843 | Tiempo de vuelta cuando el año es 0 |
| datosf1$year | β₁: Pendiente (año) | β₁ | -1.1134 | 0.0937 | Cambio en tiempo por cada aumento de 1 año |
- Teniendo ya los parámetros definidos, se pueden hacer
predicciones para años específicos:
ecuacionh1 <- data.frame(
"Componente" = c(
"Ecuación Teórica",
"Ecuación Aplicada",
"Parámetros Estimados",
"Ecuación Final"
),
"Descripción" = c(
"Y = β₀ + β₁X + ε",
"Tiempo (segs) = β₀ + β₁ × Año + Error",
paste("β₀ =", round(beta01, 2), ", β₁ =", round(beta11, 4)),
paste("**Tiempo = ", round(beta01, 1), " + (", round(beta11, 4), " × Año)**")
)
)
kable(ecuacionh1, caption = "ECUACIÓN DE REGRESIÓN LINEAL ESTIMADA") %>%
kable_styling(
bootstrap_options = c("striped", "hover"),
full_width = FALSE
) %>%
row_spec(0, bold = TRUE, color = "white", background = "#2C3E50") %>%
row_spec(4, bold = TRUE, background = "#FDEBD0")
| Componente | Descripción |
|---|---|
| Ecuación Teórica | Y = β₀ + β₁X + ε |
| Ecuación Aplicada | Tiempo (segs) = β₀ + β₁ × Año + Error |
| Parámetros Estimados | β₀ = 2321.41 , β₁ = -1.1134 |
| Ecuación Final | Tiempo = 2321.4 + ( -1.1134 × Año) |
añopredict<-c(1970, 1990, 2010, 2020, 2025, 2030)
prediccion<-beta01+beta11*añopredict
tablapredict<-data.frame(
"Año" = añopredict,
"Ecuación" = paste(
round(beta01, 1), "+ (", round(beta11, 4), "×", añopredict, ")"
),
"Tiempo Predicho" = paste(round(prediccion, 1), "segundos"),
"Mejora vs 1970" = c(
"Referencia",
paste("+", round(prediccion[1] - prediccion[2], 1), "segundos"),
paste("+", round(prediccion[1] - prediccion[3], 1), "segundos"),
paste("+", round(prediccion[1] - prediccion[4], 1), "segundos"),
paste("+", round(prediccion[1] - prediccion[5], 1), "segundos"),
paste("+", round(prediccion[1] - prediccion[6], 1), "segundos")
)
)
kable(tablapredict, caption = "PREDICCIONES DE TIEMPOS DE VUELTA") %>%
kable_styling(
bootstrap_options = c("striped", "hover", "condensed"),
full_width = TRUE
) %>%
row_spec(0, bold = TRUE, color = "white", background = "#E74C3C") %>%
row_spec(6, bold = TRUE, background = "#FDEBD0")
| Año | Ecuación | Tiempo.Predicho | Mejora.vs.1970 |
|---|---|---|---|
| 1970 | 2321.4 + ( -1.1134 × 1970 ) | 127.9 segundos | Referencia |
| 1990 | 2321.4 + ( -1.1134 × 1990 ) | 105.7 segundos |
|
| 2010 | 2321.4 + ( -1.1134 × 2010 ) | 83.4 segundos |
|
| 2020 | 2321.4 + ( -1.1134 × 2020 ) | 72.3 segundos |
|
| 2025 | 2321.4 + ( -1.1134 × 2025 ) | 66.7 segundos |
|
| 2030 | 2321.4 + ( -1.1134 × 2030 ) | 61.1 segundos |
|
Este sería el gráfico con la pendiente:
plot(datosf1$tiemposegs ~ datosf1$year,
main = "PREDICCIONES: Evolución de Tiempos de Vuelta en F1",
xlab = "Año del Gran Premio",
ylab = "Tiempo de Vuelta (segundos)",
col = "red", pch = 19, cex = 0.6,)
abline(modeloh1, col = "blue", lwd = 2)
Con esto, los equipos de F1 podrían usar este modelo para:
Establecer objetivos de rendimiento a largo plazo.
Evaluar la tasa de mejora tecnológica del equipo vs competidores.
Planificar desarrollos futuros basados en tendencias históricas.
H₀ (Hipótesis Nula): No existen diferencias significativas en tiempos de vuelta entre los equipos.
H₁ (Hipótesis Alternativa):Existen diferencias significativas en los tiempos entre al menos dos equipos.
equipos <- head(sort(table(datosf1$Car), decreasing = TRUE), 5)
equipostop <- names(head(sort(table(datosf1$Car), decreasing = TRUE), 5))
tablaequipos <- data.frame(
Numero=c(1,2,3,4,5),
Equipo = names(equipos),
Frecuencia = as.numeric(equipos)
)
tablaequipos %>%
kbl(caption = "Top 5 Equipos Más Frecuentes",
col.names = c("Numero","Equipo", "Frecuencia"),
align = c("c", "c","c")) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE,
position = "center") %>%
row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
| Numero | Equipo | Frecuencia |
|---|---|---|
| 1 | Ferrari | 258 |
| 2 | Mercedes | 98 |
| 3 | McLaren Mercedes | 92 |
| 4 | Williams Renault | 70 |
| 5 | Red Bull Racing Renault | 35 |
datosfiltr$Equipo_num <- as.numeric(factor(datosfiltr$Car))
set.seed(123)
equipo_jitter <- as.numeric(factor(datosfiltr$Car)) + runif(nrow(datosfiltr), -0.2, 0.2)
plot(datosfiltr$tiemposegs ~ equipo_jitter,
main = "Tiempos de Vuelta por Equipo",
xlab = "Equipo",
ylab = "Tiempo de Vuelta (segundos)",
xaxt = "n", # Quitar eje x automático
col = as.numeric(factor(datosfiltr$Car)),
pch = 19,
cex = 0.7)
cor.test(datosfiltr$tiemposegs,datosfiltr$Equipo_num)
##
## Pearson's product-moment correlation
##
## data: datosfiltr$tiemposegs and datosfiltr$Equipo_num
## t = -3.2843, df = 551, p-value = 0.001087
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.21940976 -0.05583152
## sample estimates:
## cor
## -0.1385656
Se tiene una correlación débil (baja), pero puntuando en que se trata de una correlación inversa.
El valor-P también define que es significativo y la relación no es por casualidad, sino que las diferencias entre equipos son estadísticamente significativas.
Se realizará un modelo lineal para así determinar el
coeficiente de determinación:
modeloh2<- lm(datosfiltr$tiemposegs ~ datosfiltr$Equipo_num)
summary(modeloh2)
##
## Call:
## lm(formula = datosfiltr$tiemposegs ~ datosfiltr$Equipo_num)
##
## Residuals:
## Min 1Q Median 3Q Max
## -42.09 -20.46 -9.71 3.14 500.27
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 110.430 4.479 24.653 < 2e-16 ***
## datosfiltr$Equipo_num -5.599 1.705 -3.284 0.00109 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 56.54 on 551 degrees of freedom
## Multiple R-squared: 0.0192, Adjusted R-squared: 0.01742
## F-statistic: 10.79 on 1 and 551 DF, p-value: 0.001087
| Concepto | Valor |
|---|---|
| Coeficiente de Determinación (R²) | 0.0192 |
| Porcentaje Explicado | 1.9 % |
| R² Ajustado | 0.0174 |
| Interpretación | El equipo explica solo el 1.9% de la variación en tiempos de vuelta |
El coeficiente de determinación (R² = 0.0192) indica que únicamente el 1.9% de la variabilidad en los tiempos de vuelta puede ser explicada por las diferencias entre equipos.
Esto significa que aunque exista una relación estadísticamente significativa, la influencia del equipo sobre el rendimiento en pista es muy limitada en términos prácticos.
resumenvalorp2 <- summary(modeloh2)
valorp2 <- resumenvalorp2$coefficients[2, 4]
significancia <- ifelse(valorp2 < 0.05, "SÍ", "NO")
tablavalorp2 <- data.frame(
"Concepto" = c(
"Valor-p obtenido",
"Umbral de significancia",
"¿Es estadísticamente significativo?"
),
"Resultado" = c(
"0.001087",
"0.05 (5%)",
significancia
)
)
kable(tablavalorp2, caption = "ANÁLISIS DEL VALOR-p - HIPÓTESIS 2") %>%
kable_styling(
bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE,
position = "center",
) %>%
row_spec(0, bold = TRUE, color = "beige", background = "#E74C3C") %>%
row_spec(3, bold = TRUE)
| Concepto | Resultado |
|---|---|
| Valor-p obtenido | 0.001087 |
| Umbral de significancia | 0.05 (5%) |
| ¿Es estadísticamente significativo? | SÍ |
| Concepto | Valor |
|---|---|
| Valor-p | 0.001087 |
| Grados de libertad (entre grupos) | 4 |
| Grados de libertad (dentro del grupo) | 548 |
| ¿Diferencias significativas? | SÍ |
| Conclusión | Se rechaza H0 |
Existe solo un 0.11% de probabilidad de observar diferencias en tiempos de vuelta entre equipos como las encontradas en el estudio, si en realidad no existieran diferencias verdaderas.
Con esto se revela que, en efecto, hay diferencias entre los equipos respecto a las vueltas rápidas.
Se aprecian diferencias significativas en los tiempos de vuelta entre al menos algunos de los equipos analizados en la Fórmula 1.
param2 <- lm(tiemposegs ~ Car, data = datosfiltr)
coeficientes2 <- summary(param2)$coefficients
# Crear tabla de coeficientes
tablaparam2 <- data.frame(
"Parámetro" = rownames(coeficientes2),
"Estimación" = round(coeficientes2[,1], 4),
"Error Estándar" = round(coeficientes2[,2], 4),
"Valor-t" = round(coeficientes2[,3], 4),
"Valor-p" = round(coeficientes2[,4], 4),
"Significativo" = ifelse(coeficientes2[,4] < 0.05, "SÍ", "NO")
)
tablaparam2$Parámetro <- gsub("Car", "Equipo: ", tablaparam2$Parámetro)
tablaparam2$Parámetro[1] <- "Intercepto (β₀)"
tablaparam2 %>%
kbl(caption = "PARÁMETROS DEL MODELO DE REGRESIÓN LINEAL") %>%
kable_styling(
bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE,
position = "center"
) %>%
row_spec(0, bold = TRUE, color = "white", background = "#2C3E50") %>%
row_spec(which(tablaparam2$Significativo == "SÍ"), bold = TRUE, background = "#D4EFDF")
| Parámetro | Estimación | Error.Estándar | Valor.t | Valor.p | Significativo | |
|---|---|---|---|---|---|---|
| (Intercept) | Intercepto (β₀) | 109.1767 | 3.5021 | 31.1746 | 0.0000 | SÍ |
| CarMcLaren Mercedes | Equipo: McLaren Mercedes | -23.3183 | 6.8308 | -3.4137 | 0.0007 | SÍ |
| CarMercedes | Equipo: Mercedes | -20.6139 | 6.6748 | -3.0883 | 0.0021 | SÍ |
| CarRed Bull Racing Renault | Equipo: Red Bull Racing Renault | -15.4132 | 10.1328 | -1.5211 | 0.1288 | NO |
| CarWilliams Renault | Equipo: Williams Renault | -20.9458 | 7.5808 | -2.7630 | 0.0059 | SÍ |
ecuacionh2 <- data.frame(
"Componente" = c(
"Ecuación Teórica",
"Ecuación Aplicada",
"Parámetros Estimados",
"Ecuación Final"
),
"Descripción" = c(
"Y = β₀ + β₁X + ε",
"Tiempo (segs) = β₀ + β₁ × Equipo + Error",
paste("β₀ =", round(beta02, 2), ", β₁ =", round(beta21, 4)),
paste("**Tiempo = ", round(beta02, 1), " + (", round(beta21, 4), " × Equipo)**")
)
)
kable(ecuacionh2, caption = "ECUACIÓN DE REGRESIÓN LINEAL ESTIMADA") %>%
kable_styling(
bootstrap_options = c("striped", "hover"),
full_width = FALSE
) %>%
row_spec(0, bold = TRUE, color = "white", background = "#4E188B") %>%
row_spec(4, bold = TRUE, background = "#FACB8E")
| Componente | Descripción |
|---|---|
| Ecuación Teórica | Y = β₀ + β₁X + ε |
| Ecuación Aplicada | Tiempo (segs) = β₀ + β₁ × Equipo + Error |
| Parámetros Estimados | β₀ = 110.43 , β₁ = -5.5989 |
| Ecuación Final | Tiempo = 110.4 + ( -5.5989 × Equipo) |
predicciones_simples <- aggregate(tiemposegs ~ Car, data = datosfiltr, mean)
predicciones_simples <- predicciones_simples[order(predicciones_simples$tiemposegs), ]
names(predicciones_simples) <- c("Equipo", "Tiempo_Predicho")
predicciones_simples %>%
kbl(caption = "Predicciones de Tiempos de Vuelta por Equipo") %>%
kable_styling(
bootstrap_options = c("striped", "hover", "condensed"),
full_width = FALSE,
position = "center"
) %>%
row_spec(0, bold = TRUE, color = "white", background = "#2C3E50") %>%
row_spec(1, bold = TRUE, background = "#D4EFDF")
| Equipo | Tiempo_Predicho | |
|---|---|---|
| 2 | McLaren Mercedes | 85.85830 |
| 5 | Williams Renault | 88.23090 |
| 3 | Mercedes | 88.56277 |
| 4 | Red Bull Racing Renault | 93.76343 |
| 1 | Ferrari | 109.17665 |
Este sería el gráfico con la pendiente:
datosfiltr$equiponum <- as.numeric(factor(datosfiltr$Car))
plot(tiemposegs ~ equiponum, data = datosfiltr,
main = "Relación entre Equipo y Tiempo de Vuelta",
xlab = "Equipo (codificado numéricamente)",
ylab = "Tiempo de Vuelta (segundos)",
col = "blue", pch = 19, cex = 0.7)
abline(lm(tiemposegs ~ equiponum, data = datosfiltr),
col = "red", lwd = 2)
legend("topright", legend = "Recta de regresión",
col = "red", lwd = 2, lty = 1)
Se puede concluir que existe una clara estratificación en el rendimiento de los equipos, donde McLaren Mercedes se posiciona como el equipo más rápido.
Se observa una diferencia notable de aproximadamente 23 segundos entre el equipo más rápido (McLaren Mercedes) y el más lento (Ferrari), lo que representa una ventaja competitiva considerable en el contexto de la Fórmula 1.