Modelo de Regresión Exponencial


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: 8334
cat("Número de variables:", ncol(datos), "\n")
## Número de variables: 23

3.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 condiciona directamente cuándo puede comenzar su producción. La variable Production start year (año de inicio de producción) actúa como variable dependiente o efecto (Y), ya que no es posible iniciar la producción sin haber descubierto previamente el yacimiento.

Nota: Este modelo usa la transformación \(\ln(Y) \sim X\) (exponencial), a diferencia del modelo potencial que usa \(\ln(Y) \sim \ln(X)\). Ambos modelos aplican a las mismas variables pero con diferente estructura matemática.

extraer_anio <- function(v) as.numeric(sub("^(\\d{4}).*", "\\1", as.character(v)))

x_raw <- as.numeric(datos$`Discovery year`)
y_raw <- extraer_anio(datos$`Production start year`)

cat("Registros con Discovery year:", sum(!is.na(x_raw)), "\n")
## Registros con Discovery year: 4935
cat("Registros con Production start year:", sum(!is.na(y_raw)), "\n")
## Registros con Production start year: 2233
cat("Pares completos (ambos con dato):", sum(!is.na(x_raw) & !is.na(y_raw)), "\n")
## Pares completos (ambos con dato): 1889
cat("X sin Y:", sum(!is.na(x_raw) & is.na(y_raw)), "\n")
## X sin Y: 3046
cat("Y sin X:", sum(is.na(x_raw) & !is.na(y_raw)), "\n")
## Y sin X: 344

4.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,
         `Año de Inicio de Producción (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) Año de Inicio de Producción (Y)
1949 1951
2001 2009
1966 1969
1975 1979
1984 1987
1986 1998
1981 1981
2004 2005
NA NA
NA NA
1981 1985
1986 2002
1982 1987
2007 NA
1965 1965
2000 2010
2013 2020
2001 NA
1979 1983
1999 2021
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 = "Año de Inicio de Producción (Y)",
     main = "Relación entre el Año de Descubrimiento y el Año de Inicio de Producción (Datos Originales)")

Debido a la dispersión de los puntos observados, se procede a aplicar una estrategia de tratamiento de datos antes de proponer el modelo.

5.1 Descarte de pares incompletos

Un modelo exponencial ajusta en escala \(\ln(y)\) vs. \(x\): cualquier valor artificial (como rellenar Y faltante con la media global) introduce puntos falsos que no siguen la relación real entre las variables. Si muchos años X distintos no tienen dato real de Y, rellenarlos todos con el mismo valor genera una banda plana que distorsiona la tendencia y hunde la correlación. Por eso no se rellenan los faltantes: se descartan los registros que no tengan ambos valores.

df_pares <- df_pares %>%
  filter(is.na(y) | y > 0) %>%
  filter(is.na(x) | x > 0) %>%
  filter(!is.na(x), !is.na(y))

cat("Pares completos reales (ambos datos presentes):", nrow(df_pares), "\n")
## Pares completos reales (ambos datos presentes): 1889

5.2 Agrupación de múltiples Y por X

Cuando un mismo año de descubrimiento (X) tiene múltiples años de inicio de producción (Y), se calcula la media aritmética para obtener un único par representativo.

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 para el modelo:", nrow(pares), "\n")
## Pares únicos para el modelo: 98
cat("Rango de años:", min(pares$x), "-", max(pares$x), "\n")
## Rango de años: 1905 - 2023

5.3 Estrategia de depuración

Se utiliza el método IQR (Rango Intercuartílico) para identificar y eliminar valores atípicos, más robusto que la desviación estándar. Se eliminan además los años con un único registro original.

\[LI = Q_1 - 1.5 \times IQR \qquad LS = Q_3 + 1.5 \times IQR\]

Q1      <- quantile(pares$y, 0.25)
Q3      <- quantile(pares$y, 0.75)
IQR_val <- Q3 - Q1
lim_inf <- Q1 - 1.5 * IQR_val
lim_sup <- Q3 + 1.5 * IQR_val

cat("Q1:", round(Q1, 2), "\n")
## Q1: 1966.48
cat("Q3:", round(Q3, 2), "\n")
## Q3: 2008.54
cat("IQR:", round(IQR_val, 2), "\n")
## IQR: 42.06
cat("Límite inferior:", round(lim_inf, 2), "\n")
## Límite inferior: 1903.39
cat("Límite superior:", round(lim_sup, 2), "\n")
## Límite superior: 2071.62
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: 98
cat("Pares después de depuración:", nrow(pares_dep), "\n")
## Pares después de depuración: 85
cat("Pares eliminados:", nrow(pares) - nrow(pares_dep), "\n")
## Pares eliminados: 13

5.4 Tabla de pares depurados

pares_dep %>%
  select(x, y) %>%
  rename(`Año de Descubrimiento (X)`       = x,
         `Año de Inicio de Producción (Y)` = y) %>%
  mutate(`Año de Inicio de Producción (Y)` = round(`Año de Inicio de Producción (Y)`, 2)) %>%
  gt() %>%
  tab_header(
    title    = md("**Tabla de Pares Depurados**"),
    subtitle = md("Año de Descubrimiento y Año de Inicio de Producción")
  ) %>%
  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 Año de Inicio de Producción
Año de Descubrimiento (X) Año de Inicio de Producción (Y)
1918 1921.00
1927 1940.50
1928 1944.50
1932 1935.50
1937 1963.50
1938 1966.00
1941 1949.50
1944 1944.00
1945 1947.00
1946 1973.33
1948 1951.25
1949 1955.14
1951 1966.57
1952 1958.86
1953 1964.00
1954 1966.44
1955 1977.08
1956 1973.14
1957 1968.83
1958 1975.19
1959 1972.62
1960 1980.92
1961 1982.13
1962 1974.85
1963 1972.91
1964 1977.53
1965 1984.88
1966 1980.67
1967 1989.28
1968 1986.30
1969 1990.54
1970 1986.76
1971 1992.09
1972 1988.59
1973 1996.82
1974 1996.90
1975 1993.76
1976 1998.35
1977 1997.77
1978 1995.83
1979 1998.60
1980 1995.50
1981 1993.96
1982 1998.61
1983 1999.94
1984 1998.90
1985 2002.50
1986 2000.74
1987 2000.71
1988 2001.15
1989 2005.10
1990 2005.74
1991 2002.04
1992 2007.58
1993 2004.67
1994 2005.00
1995 2003.85
1996 2004.48
1997 2005.50
1998 2004.70
1999 2007.71
2000 2010.47
2001 2008.81
2002 2012.04
2003 2013.70
2004 2013.96
2005 2015.52
2006 2015.71
2007 2016.16
2008 2015.51
2009 2017.67
2010 2019.69
2011 2020.10
2012 2023.00
2013 2022.81
2014 2021.02
2015 2020.25
2016 2021.93
2017 2023.10
2018 2023.79
2019 2022.68
2020 2025.07
2021 2022.50
2022 2027.60
2023 2023.67
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 = "Año de Inicio de Producción (Y)",
     main = "Relación entre el Año de Descubrimiento y el Año de Inicio de Producción")

6.Conjetura del modelo matemático

Observando la gráfica de los datos depurados, se propone un Modelo de Regresión Exponencial, ya que los datos presentan un crecimiento continuo donde la tasa de cambio es proporcional al valor actual de Y. Este modelo tiene la forma:

\[y = a \cdot e^{b \cdot x}\]

A diferencia del modelo potencial (\(y = a \cdot x^b\)), en el modelo exponencial la variable independiente X aparece en el exponente, lo que implica un crecimiento que se acelera de forma constante.

7.Cálculo de parámetros

Para ajustar el modelo exponencial se aplica la transformación logarítmica únicamente sobre Y:

\[\ln(y) = \ln(a) + b \cdot x\]

log_y <- log(pares_dep$y)
m_exp <- lm(log_y ~ x, data = pares_dep)

Pendiente e intercepto

coefs  <- coef(m_exp)
b_coef <- coefs[2]
a_coef <- exp(coefs[1])

cat("Intercepto (a) :", round(a_coef, 6), "\n")
## Intercepto (a) : 806.2442
cat("Pendiente  (b) :", round(b_coef, 8), "\n")
## Pendiente  (b) : 0.00045697
cat("\nEcuación del modelo:\n")
## 
## Ecuación del modelo:
cat("y =", round(a_coef, 4), "* exp(", round(b_coef, 6), "* x)\n")
## y = 806.2442 * exp( 0.000457 * x)

8.Comparación del modelo con la realidad

x_grid <- seq(min(pares_dep$x), max(pares_dep$x), length.out = 400)
y_grid <- a_coef * exp(b_coef * 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 = "Año de Inicio de Producción (Y)",
     main = "Superposición: Modelo Exponencial y Datos Reales")

lines(x_grid, y_grid, col = "firebrick3", lwd = 3)

legend("topleft",
       legend = c("Datos reales", "Modelo exponencial"),
       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")

La línea del modelo sale casi recta porque X son años (números en el orden de los miles) y el exponente b tiene que ser diminuto para que la ecuación tenga sentido con esos valores. Entonces, aunque X se mueve bastante (de 1918 a 2023), el producto b·x apenas cambia en ese rango. Y como la curvatura de una exponencial solo se nota cuando el exponente recorre un tramo amplio, acá terminás viendo solo un pedacito muy chico y achatado de la curva completa — matemáticamente sigue siendo una exponencial, solo que a esta escala se parece mucho a una recta. —

9.Test de Pearson

Correlación lineal

r <- cor(pares_dep$x, log(pares_dep$y))
cat("Correlación de Pearson (r):", round(r, 4), "\n")
## Correlación de Pearson (r): 0.9692

Coeficiente de determinación

En modelos no lineales como el exponencial, el coeficiente de determinación R² no aplica directamente como medida de bondad de ajuste. La calidad del ajuste se evalúa visualmente mediante la superposición y mediante la correlación de Pearson entre X y \(\ln(Y)\).

10.Restricciones

El dominio de la variable independiente X (año de descubrimiento) y la variable dependiente Y (año de inicio de producción) corresponden a valores enteros positivos. Dado que \(y = a \cdot e^{b \cdot x}\) siempre produce valores positivos, el modelo no presenta restricciones matemáticas dentro del dominio operativo.

cat("Dominio operativo válido de X:", min(pares_dep$x), "a", max(pares_dep$x), "\n")
## Dominio operativo válido de X: 1918 a 2023
cat("Valores de Y predichos siempre positivos: TRUE\n")
## Valores de Y predichos siempre positivos: TRUE
cat("Restricción matemática: No existe\n")
## Restricción matemática: No existe

11.Estimación del modelo

anio_estimar <- 2025
y_estimado   <- a_coef * exp(b_coef * anio_estimar)
cat("Estimación para el año", anio_estimar, ":\n")
## Estimación para el año 2025 :
cat("Año de inicio de producción estimado:", round(y_estimado, 2), "\n\n")
## Año de inicio de producción estimado: 2033.96
anio_estimar2 <- 2030
y_estimado2   <- a_coef * exp(b_coef * anio_estimar2)
cat("Estimación para el año", anio_estimar2, ":\n")
## Estimación para el año 2030 :
cat("Año de inicio de producción estimado:", round(y_estimado2, 2), "\n")
## Año de inicio de producción estimado: 2038.62

12.Conclusión

Ecuacion <- paste0(
  "y = ", round(a_coef, 4),
  " * exp(", round(b_coef, 6), " * x)"
)

data.frame(
  `Variable Independiente` = "Año de Descubrimiento",
  `Variable Dependiente`   = "Año de Inicio de Producción",
  `Test Pearson`           = round(r, 2),
  `Ecuación del modelo`    = Ecuacion,
  `Rango válido de X`      = paste0("[", min(pares_dep$x), ", ", max(pares_dep$x), "]"),
  check.names = FALSE
) %>%
  gt() %>%
  tab_header(
    title    = md("**Tabla N°1**"),
    subtitle = md("**Resumen del modelo de regresión exponencial**")
  ) %>%
  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 exponencial
Variable Independiente Variable Dependiente Test Pearson Ecuación del modelo Rango válido de X
Año de Descubrimiento Año de Inicio de Producción 0.97 y = 806.2442 * exp(0.000457 * x) [1918, 2023]
Autor: Grupo 5

Entre el año de descubrimiento (X) y el año de inicio de producción (Y) existe una relación exponencial cuya ecuación matemática es:

y = 806.2442 * exp(0.000457 * x)

Siendo X el año de descubrimiento del yacimiento y Y el año estimado de inicio de producción. El modelo no presenta restricciones matemáticas ya que la función exponencial siempre produce valores positivos. Con una correlación de Pearson de 0.97, el modelo refleja que a medida que los años de descubrimiento avanzan, el inicio de producción también tiende a adelantarse, evidenciando la mejora sostenida en los tiempos de desarrollo de los yacimientos petroleros a nivel mundial.