Relación entre el Año de Descubrimiento y la Longitud Geográfica de Yacimientos de Petróleo y Gas
Grupo 5
2026-07-01
Modelo de Regresión Polinómica
1.Carga de librerías
library(readxl)
library(dplyr)
library(gt)2.Carga de datos
datos <- read_excel("dataset_mundial_petro.xlsx")
cat("Número de registros:", nrow(datos), "\n")## Número de registros: 8334cat("Número de variables:", ncol(datos), "\n")## Número de variables: 233.Selección de variables
La variable Discovery year (año de descubrimiento) actúa como variable independiente o causa (X), ya que el año en que se descubre un yacimiento determina en qué zona geográfica se realizó la exploración. La variable Longitude (longitud geográfica) actúa como variable dependiente o efecto (Y), ya que la ubicación longitudinal de los yacimientos está influenciada por los ciclos históricos y geopolíticos de exploración petrolera a nivel mundial.
# Extraer variables de interés
x_raw <- as.numeric(datos$`Discovery year`)
y_raw <- as.numeric(datos$Longitude)
cat("Registros con Discovery year:", sum(!is.na(x_raw)), "\n")## Registros con Discovery year: 4935cat("Registros con Longitude:", sum(!is.na(y_raw)), "\n")## Registros con Longitude: 7537cat("Pares completos (ambos con dato):", sum(!is.na(x_raw) & !is.na(y_raw)), "\n")## Pares completos (ambos con dato): 4641cat("X sin Y:", sum(!is.na(x_raw) & is.na(y_raw)), "\n")## X sin Y: 294cat("Y sin X:", sum(is.na(x_raw) & !is.na(y_raw)), "\n")## Y sin X: 28964.Tabla de pares de valores
Paso 1 — Todos los datos
df_raw <- data.frame(x = x_raw, y = y_raw)
cat("Total de registros originales:", nrow(df_raw), "\n")## Total de registros originales: 8334Paso 2 — Relleno de valores faltantes
Los registros que tienen X pero no tienen Y se rellenan con la media aritmética global de Y, que es la mejor estimación cuando no se dispone del dato real.
media_y_global <- mean(df_raw$y, na.rm = TRUE)
cat("Media global de Longitude (Y):", round(media_y_global, 4), "\n")## Media global de Longitude (Y): -54.6526# Rellenar Y faltantes con la media global
df_raw$y[is.na(df_raw$y) & !is.na(df_raw$x)] <- media_y_global
cat("Pares disponibles tras relleno:", sum(!is.na(df_raw$x) & !is.na(df_raw$y)), "\n")## Pares disponibles tras relleno: 4935Paso 3 — Agrupación de múltiples Y por X
Cuando un mismo año (X) tiene múltiples longitudes (Y), se calcula la media aritmética de todos esos Y para obtener un único par representativo.
pares <- df_raw %>%
filter(!is.na(x), !is.na(y)) %>%
group_by(x) %>%
summarise(y = mean(y, na.rm = TRUE), .groups = "drop") %>%
arrange(x)
cat("Pares únicos para el modelo:", nrow(pares), "\n")## Pares únicos para el modelo: 125cat("Rango de años:", min(pares$x), "-", max(pares$x), "\n")## Rango de años: 1869 - 2023Tabla de pares
pares %>%
rename(`Año de Descubrimiento (X)` = x,
`Longitud Geográfica (Y)` = y) %>%
mutate(`Longitud Geográfica (Y)` = round(`Longitud Geográfica (Y)`, 4)) %>%
gt() %>%
tab_header(
title = md("**Tabla de Pares de Valores**"),
subtitle = md("Año de Descubrimiento y Longitud Geográfica")
) %>%
tab_source_note(source_note = "Autor: Grupo 5") %>%
cols_align(align = "center", columns = everything()) %>%
tab_options(
table.border.top.color = "black",
table.border.bottom.color = "black",
table.border.top.style = "solid",
table.border.bottom.style = "solid",
column_labels.font.weight = "bold",
column_labels.border.top.color = "black",
column_labels.border.bottom.color = "black",
column_labels.border.bottom.width = px(2),
heading.border.bottom.color = "black",
heading.border.bottom.width = px(2),
table_body.hlines.color = "grey",
table_body.border.bottom.color = "black"
)| Tabla de Pares de Valores | |
| Año de Descubrimiento y Longitud Geográfica | |
| Año de Descubrimiento (X) | Longitud Geográfica (Y) |
|---|---|
| 1869 | -81.1545 |
| 1887 | -120.3586 |
| 1889 | -104.4832 |
| 1890 | 25.5667 |
| 1899 | -46.7469 |
| 1901 | -104.9395 |
| 1902 | -91.6143 |
| 1904 | -112.0510 |
| 1905 | -80.8102 |
| 1906 | -108.5609 |
| 1908 | 24.1320 |
| 1909 | -65.1795 |
| 1910 | -118.6501 |
| 1911 | -119.7239 |
| 1912 | -78.9868 |
| 1914 | -94.7827 |
| 1915 | -97.5110 |
| 1916 | -96.3902 |
| 1917 | -107.2199 |
| 1918 | -94.5553 |
| 1919 | -119.4530 |
| 1920 | -99.7704 |
| 1921 | -100.3496 |
| 1922 | -97.4209 |
| 1923 | -110.0782 |
| 1924 | -118.3772 |
| 1925 | -93.6454 |
| 1926 | -101.9522 |
| 1927 | -53.1959 |
| 1928 | -74.9300 |
| 1929 | -79.7388 |
| 1930 | -97.5647 |
| 1931 | -27.5353 |
| 1932 | -76.1102 |
| 1933 | -62.2591 |
| 1934 | 43.1930 |
| 1935 | -88.3248 |
| 1936 | -90.5222 |
| 1937 | -86.7212 |
| 1938 | -57.6879 |
| 1939 | -68.6410 |
| 1940 | -69.0887 |
| 1941 | -63.9294 |
| 1942 | -87.6575 |
| 1943 | -94.1861 |
| 1944 | -73.2791 |
| 1945 | -74.9884 |
| 1946 | -67.6844 |
| 1947 | -106.3878 |
| 1948 | -56.2014 |
| 1949 | -95.5411 |
| 1950 | -90.7631 |
| 1951 | -99.0192 |
| 1952 | -92.3924 |
| 1953 | -87.0251 |
| 1954 | -84.0192 |
| 1955 | -83.3799 |
| 1956 | -81.2610 |
| 1957 | -83.7155 |
| 1958 | -71.7962 |
| 1959 | -66.5756 |
| 1960 | -77.9652 |
| 1961 | -38.0788 |
| 1962 | -68.1975 |
| 1963 | -58.9798 |
| 1964 | -47.6465 |
| 1965 | -38.0495 |
| 1966 | -48.4943 |
| 1967 | -24.0001 |
| 1968 | -42.6327 |
| 1969 | -49.6160 |
| 1970 | -37.4139 |
| 1971 | -21.3941 |
| 1972 | -16.1785 |
| 1973 | -50.8687 |
| 1974 | -23.7429 |
| 1975 | -16.8435 |
| 1976 | -76.0603 |
| 1977 | -59.7735 |
| 1978 | -31.7067 |
| 1979 | -41.3217 |
| 1980 | -47.9180 |
| 1981 | -39.8525 |
| 1982 | -21.0103 |
| 1983 | -29.3466 |
| 1984 | -39.5066 |
| 1985 | -44.5174 |
| 1986 | -22.0576 |
| 1987 | -18.4606 |
| 1988 | -27.9513 |
| 1989 | 7.1355 |
| 1990 | 5.9354 |
| 1991 | -22.0110 |
| 1992 | -12.4867 |
| 1993 | -28.1336 |
| 1994 | -40.9822 |
| 1995 | -25.9760 |
| 1996 | -34.0524 |
| 1997 | -2.2996 |
| 1998 | -15.8990 |
| 1999 | -17.3036 |
| 2000 | 21.5589 |
| 2001 | -8.5892 |
| 2002 | -8.1713 |
| 2003 | -17.0716 |
| 2004 | -24.3896 |
| 2005 | -15.9556 |
| 2006 | -14.9397 |
| 2007 | -3.5778 |
| 2008 | -51.6520 |
| 2009 | -74.8394 |
| 2010 | 2.2130 |
| 2011 | 11.0168 |
| 2012 | -7.5526 |
| 2013 | -12.8655 |
| 2014 | 7.1889 |
| 2015 | -15.9569 |
| 2016 | -38.5953 |
| 2017 | -41.4956 |
| 2018 | -5.3741 |
| 2019 | -2.7491 |
| 2020 | -20.1708 |
| 2021 | -11.9346 |
| 2022 | -6.6244 |
| 2023 | -4.7329 |
| Autor: Grupo 5 | |
5.Gráfica
plot(pares$x, pares$y,
pch = 20,
col = rgb(0.1, 0.4, 0.5, 0.6),
xlab = "Año de Descubrimiento (X)",
ylab = "Longitud Geográfica (Y)",
main = "Relación entre el Año de Descubrimiento y la Longitud Geográfica")
6.Conjetura del modelo matemático
Observando la gráfica de dispersión, se propone un Modelo de Regresión Polinómica de grado 3, ya que los datos presentan una tendencia curvilínea con cambios de dirección a lo largo del tiempo, lo cual no puede ser capturado por un modelo lineal simple. Este modelo tiene la forma:
\[y = a + b_1x + b_2x^2 + b_3x^3\]
m_poli3 <- lm(y ~ poly(x, 3, raw = TRUE), data = pares)
sum_reg <- summary(m_poli3)7.Cálculo de parámetros
Pendiente e intercepto
b <- coef(m_poli3)
cat("Intercepto (a) :", round(b[1], 6), "\n")## Intercepto (a) : 827082.2cat("Pendiente b1 :", round(b[2], 8), "\n")## Pendiente b1 : -1263.596cat("Pendiente b2 :", round(b[3], 10), "\n")## Pendiente b2 : 0.6429203cat("Pendiente b3 :", round(b[4], 12), "\n")## Pendiente b3 : -0.0001089489cat("\nEcuación del modelo:\n")##
## Ecuación del modelo:cat("y =", round(b[1], 2),
"+ (", round(b[2], 6), ")x",
"+ (", round(b[3], 8), ")x²",
"+ (", round(b[4], 10), ")x³\n")## y = 827082.2 + ( -1263.596 )x + ( 0.6429204 )x² + ( -0.0001089489 )x³8.Comparación del modelo con la realidad
Se realiza la superposición del modelo ajustado sobre los datos reales para evaluar visualmente qué tan bien representa la curva polinómica el comportamiento observado.
x_grid <- seq(min(pares$x), max(pares$x), length.out = 400)
y_grid <- predict(m_poli3, newdata = data.frame(x = x_grid))
plot(pares$x, pares$y,
pch = 20,
col = rgb(0.1, 0.4, 0.5, 0.6),
xlab = "Año de Descubrimiento (X)",
ylab = "Longitud Geográfica (Y)",
main = "Superposición: Modelo Polinómico y Datos Reales")
lines(x_grid, y_grid, col = "firebrick3", lwd = 3)
legend("topright",
legend = c("Datos reales", "Modelo polinómico"),
col = c(rgb(0.1, 0.4, 0.5, 0.6), "firebrick3"),
pch = c(20, NA),
lty = c(NA, 1),
lwd = c(NA, 3),
bty = "n")
9.Test de Pearson
Correlación lineal
r <- cor(pares$x, pares$y)
r2 <- sum_reg$r.squared * 100
cat("Correlación de Pearson (r):", round(r, 4), "\n")## Correlación de Pearson (r): 0.6967cat("Coeficiente de determinación (R²%):", round(r2, 2), "%\n")## Coeficiente de determinación (R²%): 53.87 %Coeficiente de determinación
El coeficiente de determinación (R²) indica qué porcentaje de la variación en la longitud geográfica (Y) es explicado por el año de descubrimiento (X). Un valor de 53.87% significa que el modelo explica ese porcentaje del comportamiento de la variable dependiente.
10.Estimación del modelo
Aprovechando la ecuación del modelo polinómico, realizamos estimaciones para años específicos fuera del rango de los datos originales.
# Estimación para el año 2025
anio_estimar <- 2025
longitud_estimada <- predict(m_poli3, newdata = data.frame(x = anio_estimar))
cat("Estimación para el año", anio_estimar, ":\n")## Estimación para el año 2025 :cat("Longitud geográfica estimada:", round(longitud_estimada, 4), "°\n\n")## Longitud geográfica estimada: -10.1087 °# Estimación para el año 2030
anio_estimar2 <- 2030
longitud_estimada2 <- predict(m_poli3, newdata = data.frame(x = anio_estimar2))
cat("Estimación para el año", anio_estimar2, ":\n")## Estimación para el año 2030 :cat("Longitud geográfica estimada:", round(longitud_estimada2, 4), "°\n")## Longitud geográfica estimada: -10.8157 °Tabla resumen del modelo
Ecuacion <- paste0(
"y = ", round(b[1], 2),
" + (", round(b[2], 6), ")x",
" + (", round(b[3], 8), ")x²",
" + (", round(b[4], 10), ")x³"
)
Tabla_resumen <- data.frame(
`Variable Independiente` = "Año de Descubrimiento",
`Variable Dependiente` = "Longitud Geográfica",
`Test Pearson` = round(r, 2),
`Coeficiente de determinación`= round(r2, 2),
`Ecuación de la recta` = Ecuacion,
check.names = FALSE
)
Tabla_resumen %>%
gt() %>%
tab_header(
title = md("**Tabla N°1**"),
subtitle = md("**Resumen del modelo de regresión polinómica**")
) %>%
tab_source_note(source_note = md("Autor: Grupo 5")) %>%
cols_align(align = "center", columns = everything()) %>%
tab_options(
table.border.top.color = "black",
table.border.bottom.color = "black",
table.border.top.style = "solid",
table.border.bottom.style = "solid",
column_labels.font.weight = "bold",
column_labels.border.top.color = "black",
column_labels.border.bottom.color = "black",
column_labels.border.bottom.width = px(2),
heading.border.bottom.color = "black",
heading.border.bottom.width = px(2),
table_body.hlines.color = "grey",
table_body.border.bottom.color = "black"
)| Tabla N°1 | ||||
| Resumen del modelo de regresión polinómica | ||||
| Variable Independiente | Variable Dependiente | Test Pearson | Coeficiente de determinación | Ecuación de la recta |
|---|---|---|---|---|
| Año de Descubrimiento | Longitud Geográfica | 0.7 | 53.87 | y = 827082.17 + (-1263.595825)x + (0.64292035)x² + (-0.0001089489)x³ |
| Autor: Grupo 5 | ||||
11.Conclusión
Entre el año de descubrimiento (X) y la longitud geográfica (Y) existe una relación polinómica de tercer grado cuya ecuación matemática es:
y = 827082.17 + (-1263.595825)x + (0.64292035)x² + (-0.0001089489)x³
Siendo X el año de descubrimiento del yacimiento y Y la longitud geográfica donde se ubica. Con una correlación de Pearson de 0.7 y un coeficiente de determinación de 53.87%, el modelo refleja cómo la exploración petrolera ha variado geográficamente a lo largo del tiempo, mostrando desplazamientos hacia diferentes zonas longitudinales en distintas épocas históricas.