Relación entre el Año de Descubrimiento y la Longitud Geográfica de Yacimientos de Petróleo y Gas
Grupo 5
2026-07-08
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.
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
Se presenta un extracto (primeros 20 registros) tal como fueron extraídos del dataset, antes de cualquier depuración.
df_pares <- data.frame(x = x_raw, y = y_raw)
df_pares %>%
head(20) %>%
rename(`Año de Descubrimiento (X)` = x,
`Longitud Geográfica (Y)` = y) %>%
gt() %>%
tab_header(
title = md("**Tabla de Pares de Valores**"),
subtitle = md("Valores originales sin depurar")
) %>%
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 | |
| Valores originales sin depurar | |
| Año de Descubrimiento (X) | Longitud Geográfica (Y) |
|---|---|
| 1949 | 16.71667 |
| 2001 | -39.61200 |
| 1966 | -36.88900 |
| 1975 | -36.26200 |
| 1984 | -39.96100 |
| 1986 | -39.74600 |
| 1981 | -36.73400 |
| 2004 | -36.07300 |
| NA | NA |
| NA | -43.47230 |
| 1981 | -40.52400 |
| 1986 | -36.73300 |
| 1982 | -36.56500 |
| 2007 | -38.10900 |
| 1965 | -38.17100 |
| 2000 | -39.85300 |
| 2013 | -42.46900 |
| 2001 | -41.89300 |
| 1979 | -38.97100 |
| 1999 | -58.17800 |
| Autor: Grupo 5 | |
5.Gráfica
Gráfica original
plot(df_pares$x, df_pares$y,
pch = 20,
col = rgb(0.1, 0.4, 0.5, 0.4),
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 (Datos Originales)")
Debido a la complejidad y a la fuerte dispersión de los puntos observados en la gráfica anterior, se procede a aplicar una estrategia de tratamiento de datos antes de proponer un modelo.
5.1 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_pares$y, na.rm = TRUE)
cat("Media global de Longitude (Y):", round(media_y_global, 4), "\n")## Media global de Longitude (Y): -54.6526df_pares$y[is.na(df_pares$y) & !is.na(df_pares$x)] <- media_y_global
cat("Pares disponibles tras relleno:", sum(!is.na(df_pares$x) & !is.na(df_pares$y)), "\n")## Pares disponibles tras relleno: 49355.2 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 (un único X, un único Y). Se conserva además el
número de registros originales (n) que dieron origen a cada
promedio, dato necesario para la depuración posterior.
pares <- df_pares %>%
filter(!is.na(x), !is.na(y)) %>%
group_by(x) %>%
summarise(y = mean(y, na.rm = TRUE), n = n(), .groups = "drop") %>%
arrange(x)
cat("Pares únicos (un X, un Y) para el modelo:", nrow(pares), "\n")## Pares únicos (un X, un Y) para el modelo: 125cat("Rango de años:", min(pares$x), "-", max(pares$x), "\n")## Rango de años: 1869 - 20235.3 Estrategia de depuración
Al analizar los datos agrupados se identificaron valores atípicos (pares con longitudes muy alejadas de la tendencia central) y años con un solo registro original (que no aportan representatividad, pues su valor de Y no proviene de un promedio). La estrategia adoptada consiste en:
- Eliminar pares cuya longitud (Y) supere 2 desviaciones estándar de la media, considerados valores atípicos.
- Conservar únicamente los años con más de un registro
original (
n > 1), para garantizar representatividad.
# Calcular límites para valores atípicos (±2 desviaciones estándar)
media_y <- mean(pares$y)
sd_y <- sd(pares$y)
lim_sup <- media_y + 2 * sd_y
lim_inf <- media_y - 2 * sd_y
cat("Media de Y:", round(media_y, 4), "\n")## Media de Y: -53.2393cat("Desv. estándar de Y:", round(sd_y, 4), "\n")## Desv. estándar de Y: 38.7936cat("Límite superior:", round(lim_sup, 4), "\n")## Límite superior: 24.3479cat("Límite inferior:", round(lim_inf, 4), "\n")## Límite inferior: -130.8266# Filtrar valores atípicos y conservar solo años con más de un registro original
pares_dep <- pares %>%
filter(y >= lim_inf & y <= lim_sup) %>%
filter(n > 1)
cat("\nPares antes de depuración:", nrow(pares), "\n")##
## Pares antes de depuración: 125cat("Pares después de depuración:", nrow(pares_dep), "\n")## Pares después de depuración: 116cat("Pares eliminados (atípicos o con un único registro):", nrow(pares) - nrow(pares_dep), "\n")## Pares eliminados (atípicos o con un único registro): 95.4 Tabla de pares depurados
pares_dep %>%
select(x, y) %>%
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 Depurados**"),
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 Depurados | |
| 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 |
| 1899 | -46.7469 |
| 1901 | -104.9395 |
| 1904 | -112.0510 |
| 1905 | -80.8102 |
| 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 |
| 1920 | -99.7704 |
| 1921 | -100.3496 |
| 1922 | -97.4209 |
| 1923 | -110.0782 |
| 1925 | -93.6454 |
| 1927 | -53.1959 |
| 1928 | -74.9300 |
| 1929 | -79.7388 |
| 1930 | -97.5647 |
| 1931 | -27.5353 |
| 1932 | -76.1102 |
| 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.5 Gráfica simplificada
plot(pares_dep$x, pares_dep$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 (Datos Depurados)")
Con la depuración, el número de puntos se redujo considerablemente respecto a la gráfica original, lo que permite observar con mayor claridad la tendencia de los datos.
6.Conjetura del modelo matemático
Observando la gráfica de los datos depurados, 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. Este modelo tiene la forma:
\[y = a + b_1x + b_2x^2 + b_3x^3\]
7.Cálculo de parámetros
Como se trata de una curva, no se puede aplicar lm
directamente sobre X. Sin embargo, tratando cada potencia de X (\(x\), \(x^2\), \(x^3\)) como una variable independiente
adicional, la ecuación se vuelve lineal en esos términos, por lo que R
puede calcular automáticamente los coeficientes mediante mínimos
cuadrados con lm.
m_poli3 <- lm(y ~ poly(x, 3, raw = TRUE), data = pares_dep)Pendiente e intercepto
b <- coef(m_poli3)
cat("Intercepto (a) :", round(b[1], 6), "\n")## Intercepto (a) : 788115.9cat("Pendiente b1 :", round(b[2], 8), "\n")## Pendiente b1 : -1207.212cat("Pendiente b2 :", round(b[3], 10), "\n")## Pendiente b2 : 0.6157768cat("Pendiente b3 :", round(b[4], 12), "\n")## Pendiente b3 : -0.0001046021cat("\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 = 788115.9 + ( -1207.212 )x + ( 0.6157768 )x² + ( -0.0001046021 )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_dep$x), max(pares_dep$x), length.out = 400)
y_grid <- predict(m_poli3, newdata = data.frame(x = x_grid))
plot(pares_dep$x, pares_dep$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_dep$x, pares_dep$y)
cat("Correlación de Pearson (r):", round(r, 4), "\n")## Correlación de Pearson (r): 0.8285Coeficiente de determinación
En modelos no lineales como el polinómico, el coeficiente de determinación R² no aplica directamente como medida de bondad de ajuste, ya que este indicador fue diseñado para modelos de regresión lineal, donde la razón de cambio (pendiente) entre X y Y es constante. En una curva, esa razón de cambio varía en cada punto, por lo que R² pierde su interpretación. En su lugar, la calidad del ajuste se evalúa visualmente mediante la superposición del modelo con los datos reales, y mediante la correlación de Pearson entre las variables.
10.Restricciones
El dominio de la variable independiente X (año de descubrimiento) corresponde al conjunto de los números enteros: \(X \in \mathbb{Z}\). El dominio de la variable dependiente Y (longitud geográfica) corresponde al intervalo: \(Y \in [-180°, 180°]\).
Dado que el modelo es una curva polinómica de grado 3, existe la posibilidad de que, para valores de X fuera del rango de los datos observados, el valor estimado de Y se salga del dominio \([-180°, 180°]\). Para comprobarlo, se resuelve el polinomio igualándolo a los límites del dominio de Y, y se despeja X:
\[a + b_1x + b_2x^2 + b_3x^3 = 180 \qquad \text{y} \qquad a + b_1x + b_2x^2 + b_3x^3 = -180\]
# Raíces reales donde el modelo predice Y = 180°
raices_sup <- polyroot(c(b[1] - 180, b[2], b[3], b[4]))
raices_sup_reales <- Re(raices_sup)[abs(Im(raices_sup)) < 1e-6]
# Raíces reales donde el modelo predice Y = -180°
raices_inf <- polyroot(c(b[1] + 180, b[2], b[3], b[4]))
raices_inf_reales <- Re(raices_inf)[abs(Im(raices_inf)) < 1e-6]
cat("Valores de X donde el modelo predice Y = 180°:\n")## Valores de X donde el modelo predice Y = 180°:print(round(sort(raices_sup_reales), 0))## [1] 1804cat("\nValores de X donde el modelo predice Y = -180°:\n")##
## Valores de X donde el modelo predice Y = -180°:print(round(sort(raices_inf_reales), 0))## [1] 2101A partir de las raíces anteriores se determina el intervalo de X para el cual la curva se mantiene dentro del dominio válido de Y:
x_amplio <- seq(min(pares_dep$x) - 100, max(pares_dep$x) + 100, by = 1)
y_amplio <- predict(m_poli3, newdata = data.frame(x = x_amplio))
x_validos <- x_amplio[y_amplio >= -180 & y_amplio <= 180]
x_min_valido <- min(x_validos)
x_max_valido <- max(x_validos)
cat("El modelo se mantiene dentro del dominio de Y [-180°, 180°]\n")## El modelo se mantiene dentro del dominio de Y [-180°, 180°]cat("para valores de X comprendidos entre:", x_min_valido, "y", x_max_valido, "\n")## para valores de X comprendidos entre: 1805 y 2101Conclusión de la sección: el modelo sí presenta restricciones. Es válido únicamente para años comprendidos entre 1805 y 2101. Fuera de este intervalo, el polinomio produce valores de longitud que exceden el dominio geográfico real \([-180°, 180°]\), por lo que el modelo no debe usarse para estimar fuera de ese rango.
11.Estimación del modelo
Aprovechando la ecuación del modelo polinómico, se realizan estimaciones dentro del rango válido determinado en la sección anterior (entre 1805 y 2101).
# 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")## Longitud geográfica estimada: -11.107 °cat("¿Dentro del dominio válido? :", anio_estimar >= x_min_valido & anio_estimar <= x_max_valido, "\n\n")## ¿Dentro del dominio válido? : TRUE# 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: -12.2055 °cat("¿Dentro del dominio válido? :", anio_estimar2 >= x_min_valido & anio_estimar2 <= x_max_valido, "\n")## ¿Dentro del dominio válido? : TRUE12.Conclusión
Se presenta a continuación la tabla resumen del modelo, como base para la conclusión.
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),
`Ecuación del modelo` = Ecuacion,
`Rango válido de X` = paste0("[", x_min_valido, ", ", x_max_valido, "]"),
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 | Ecuación del modelo | Rango válido de X |
|---|---|---|---|---|
| Año de Descubrimiento | Longitud Geográfica | 0.83 | y = 788115.87 + (-1207.212419)x + (0.61577678)x² + (-0.0001046021)x³ | [1805, 2101] |
| Autor: Grupo 5 | ||||
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 es:
y = 788115.87 + (-1207.212419)x + (0.61577678)x² + (-0.0001046021)x³
Siendo X el año de descubrimiento del yacimiento y Y la longitud geográfica donde se ubica. El modelo presenta restricciones: es válido únicamente para valores de X comprendidos entre 1805 y 2101, ya que fuera de ese intervalo el modelo produce valores de longitud fuera del dominio real \([-180°, 180°]\).