Relación entre el Año de Descubrimiento y la Longitud Geográfica de Yacimientos de Petróleo y Gas
Grupo 5
2026-07-06
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
Datos originales
A continuación se presentan los primeros registros tal como fueron extraídos del dataset, antes de cualquier depuración.
df_raw <- data.frame(
`Año de Descubrimiento (X)` = x_raw,
`Longitud Geográfica (Y)` = y_raw,
check.names = FALSE
)
head(df_raw, 20) %>%
gt() %>%
tab_header(
title = md("**Tabla de Datos Antes del Relleno**"),
subtitle = md("Valores originales sin imputar (media/mediana)")
) %>%
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 Datos Antes del Relleno | |
| Valores originales sin imputar (media/mediana) | |
| 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 | |
Gráfica original
plot(df_raw$`Año de Descubrimiento (X)`, df_raw$`Longitud Geográfica (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)")
Paso 1 — Todos los datos
df_raw2 <- data.frame(x = x_raw, y = y_raw)
cat("Total de registros originales:", nrow(df_raw2), "\n")## Total de registros originales: 8334Datos originales antes del relleno
A continuación se muestran los primeros registros
antes de aplicar el relleno de valores faltantes con la
media aritmética o la mediana. Se observan los valores NA
en los casos donde no existe dato de Longitud (Y).
head(df_raw2, 20) %>%
rename(`Año de Descubrimiento (X)` = x,
`Longitud Geográfica (Y)` = y) %>%
gt() %>%
tab_header(
title = md("**Tabla de Datos Antes del Relleno**"),
subtitle = md("Valores originales sin imputar (media/mediana)")
) %>%
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 Datos Antes del Relleno | |
| Valores originales sin imputar (media/mediana) | |
| 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 | |
Paso 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_raw2$y, na.rm = TRUE)
cat("Media global de Longitude (Y):", round(media_y_global, 4), "\n")## Media global de Longitude (Y): -54.6526df_raw2$y[is.na(df_raw2$y) & !is.na(df_raw2$x)] <- media_y_global
cat("Pares disponibles tras relleno:", sum(!is.na(df_raw2$x) & !is.na(df_raw2$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_raw2 %>%
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 - 2023Estrategia de depuración
Al analizar los datos agrupados se identificaron valores atípicos (pares con longitudes muy alejadas de la tendencia central) y pares únicos (años con un solo registro que no aportan información suficiente sobre la dispersión). 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 para garantizar representatividad.
- De ser necesario, se considerará trabajar el modelo por partes si la gráfica depurada revela comportamientos distintos en diferentes tramos del tiempo.
# 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
pares_dep <- pares %>%
filter(y >= lim_inf & y <= lim_sup)
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: 123cat("Valores atípicos eliminados:", nrow(pares) - nrow(pares_dep), "\n")## Valores atípicos eliminados: 2Tabla de pares depurados
pares_dep %>%
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 |
| 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 |
| 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
Se presenta la distribución de los pares depurados para identificar visualmente la tendencia y justificar el modelo propuesto.
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")
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. Sin embargo, la dispersión observada sugiere que un modelo de mayor grado o trabajado por tramos podría ajustarse mejor a los datos. 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_dep)
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) : 767401.1cat("Pendiente b1 :", round(b[2], 8), "\n")## Pendiente b1 : -1174.213cat("Pendiente b2 :", round(b[3], 10), "\n")## Pendiente b2 : 0.5982986cat("Pendiente b3 :", round(b[4], 12), "\n")## Pendiente b3 : -0.0001015235cat("\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 = 767401.1 + ( -1174.213 )x + ( 0.5982986 )x² + ( -0.0001015235 )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.7887Coeficiente 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. 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 a valores enteros positivos en el rango histórico de exploración petrolera. El dominio de la variable dependiente Y (longitud geográfica) abarca todos los números reales en el intervalo [-180°, 180°].
Dado que el dominio de Y son todos los reales dentro de ese intervalo y la función polinómica está definida para cualquier valor de X, no existen restricciones matemáticas que impidan evaluar el modelo. Cualquier año que se ingrese como X producirá un valor válido de Y.
11.Estimación del modelo
Aprovechando la ecuación del modelo polinómico, realizamos estimaciones para años 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.0227 °# 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.6635 °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),
`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 | Ecuación de la recta |
|---|---|---|---|
| Año de Descubrimiento | Longitud Geográfica | 0.79 | y = 767401.07 + (-1174.213338)x + (0.59829862)x² + (-0.0001015235)x³ |
| Autor: Grupo 5 | |||
12.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 = 767401.07 + (-1174.213338)x + (0.59829862)x² + (-0.0001015235)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.79, 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.