Modelo de Regresión Exponencial

1. Carga de librerías

library(readxl)
## Warning: package 'readxl' was built under R version 4.6.1
library(dplyr)
## Warning: package 'dplyr' was built under R version 4.6.1
## 
## Adjuntando el paquete: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(gt)
## Warning: package 'gt' was built under R version 4.6.1
library(lubridate)
## 
## Adjuntando el paquete: 'lubridate'
## The following objects are masked from 'package:base':
## 
##     date, intersect, setdiff, union

2. Carga de datos

# Ruta exacta del archivo en el equipo del usuario
archivo <- "C:/Users/ASUS/Desktop/modelo_exel/Oil__Gas____Other_Regulated_Wells__Beginning_1860 (1).xlsx"

datos <- read_excel(archivo)
## Warning: Expecting logical in AV11548 / R11548C48: got a date
## Warning: Coercing text to numeric in AG18617 / R18617C33: '42.07'
## Warning: Coercing text to numeric in AI18617 / R18617C35: '42.07'
## Warning: Expecting logical in AV18637 / R18637C48: got '03/27/2007'
## Warning: Expecting logical in AV20141 / R20141C48: got '01/23/2007'
## Warning: Expecting logical in AV23058 / R23058C48: got '10/23/2007'
## Warning: Expecting logical in AV23560 / R23560C48: got '07/23/2008'
## Warning: Coercing text to numeric in AG25297 / R25297C33: '42.07'
## Warning: Coercing text to numeric in AI25297 / R25297C35: '42.07'
## Warning: Expecting logical in AV27121 / R27121C48: got '06/27/2006'
## Warning: Expecting logical in AV28102 / R28102C48: got '06/19/2007'
## Warning: Coercing text to numeric in AP28157 / R28157C42: '0.002'
## Warning: Coercing text to numeric in AG28757 / R28757C33: '42.18'
## Warning: Coercing text to numeric in AI28757 / R28757C35: '42.18'
## Warning: Expecting logical in AV28866 / R28866C48: got '06/27/2006'
## Warning: Expecting logical in AV29797 / R29797C48: got '05/16/2006'
## Warning: Expecting logical in AV29900 / R29900C48: got '06/27/2006'
## Warning: Expecting logical in AV30601 / R30601C48: got '06/27/2006'
## Warning: Expecting logical in AV30658 / R30658C48: got '06/27/2006'
## Warning: Coercing text to numeric in AG31165 / R31165C33: '42.25'
## Warning: Coercing text to numeric in AI31165 / R31165C35: '42.25'
## Warning: Expecting logical in AV33889 / R33889C48: got '05/18/2006'
## Warning: Expecting numeric in A34467 / R34467C1: got '"error" : true'
## Warning: Expecting numeric in A34468 / R34468C1: got '"message" : "Internal
## error"'
## Warning: Expecting numeric in A34469 / R34469C1: got '"status" : 500'
## Warning: Expecting numeric in A34470 / R34470C1: got '}'
cat("Número de registros:", nrow(datos), "\n")
## Número de registros: 34469
## Número de registros: 34469

cat("Número de variables:", ncol(datos), "\n")
## Número de variables: 52
## Número de variables: 52

3. Selección de variables

La variable Año de perforación (Date Spudded) actúa como variable independiente o causa (X), ya que el paso del tiempo es lo que genera que se sigan perforando nuevos pozos. La variable Número acumulado de pozos perforados actúa como variable dependiente o efecto (Y), ya que cada año se suman nuevos pozos sobre la base que ya existía —esto es precisamente lo que caracteriza a un crecimiento exponencial: la variación de Y es proporcional a su propio valor acumulado.

# Extraer el año de perforación desde la fecha, sin importar si
# "Date Spudded" viene como fecha nativa, número de serie de Excel,
# o texto en distintos formatos (mdy, dmy, ymd, etc.)
fecha_bruta <- datos$`Date Spudded`

if (inherits(fecha_bruta, "Date") || inherits(fecha_bruta, "POSIXct")) {
  datos$anio <- as.numeric(format(fecha_bruta, "%Y"))
} else if (is.numeric(fecha_bruta)) {
  datos$anio <- as.numeric(format(as.Date(fecha_bruta, origin = "1899-12-30"), "%Y"))
} else {
  fecha_parseada <- suppressWarnings(
    parse_date_time(fecha_bruta, orders = c("mdY", "dmY", "Ymd", "mdy HMS", "Ymd HMS"))
  )
  datos$anio <- year(fecha_parseada)
}

cat("Registros con Año (Date Spudded):", sum(!is.na(datos$anio)), "\n")
## Registros con Año (Date Spudded): 6781
## Registros con Año (Date Spudded): 11284

4. Tabla de pares de valores

Paso 1 — Conteo de pozos perforados por año

conteo <- datos %>%
  filter(!is.na(anio)) %>%
  group_by(anio) %>%
  summarise(n_pozos = n(), .groups = "drop") %>%
  arrange(anio)

cat("Años distintos con actividad registrada:", nrow(conteo), "\n")
## Años distintos con actividad registrada: 132
## Años distintos con actividad registrada: 134

Paso 2 — Cálculo del acumulado (Y)

A diferencia de un dato faltante que se rellena con la media (como en el modelo polinómico), aquí Y se construye a partir de X: es la suma progresiva (cumsum) de los pozos perforados hasta cada año.

conteo <- conteo %>%
  mutate(acumulado = cumsum(n_pozos))

pares <- data.frame(x = conteo$anio, y = conteo$acumulado)

cat("Pares únicos para el modelo:", nrow(pares), "\n")
## Pares únicos para el modelo: 132
## Pares únicos para el modelo: 134

cat("Rango de años:", min(pares$x), "-", max(pares$x), "\n")
## Rango de años: 1870 - 2026
## Rango de años: 1870 - 2026

Tabla de pares

pares %>%
  rename(`Año (X)` = x,
         `N° Acumulado de Pozos (Y)` = y) %>%
  gt() %>%
  tab_header(
    title    = md("**Tabla de Pares de Valores**"),
    subtitle = md("Año de Perforación y Crecimiento Acumulado de Pozos")
  ) %>%
  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 Perforación y Crecimiento Acumulado de Pozos
Año (X) N° Acumulado de Pozos (Y)
1870 1
1880 2
1886 4
1888 5
1890 8
1892 9
1897 10
1898 11
1901 12
1902 14
1903 17
1904 20
1905 21
1906 23
1907 24
1908 29
1909 34
1910 41
1911 46
1912 48
1913 52
1914 56
1915 68
1916 79
1917 82
1918 87
1920 91
1922 94
1923 98
1924 105
1925 117
1926 122
1927 129
1928 140
1929 154
1930 165
1931 172
1932 176
1933 181
1934 186
1935 195
1936 208
1937 216
1938 219
1939 222
1940 237
1941 241
1942 242
1943 246
1944 250
1945 252
1946 258
1947 266
1948 270
1949 275
1950 289
1951 306
1952 333
1953 347
1954 360
1955 368
1956 380
1957 406
1958 421
1959 438
1960 456
1961 479
1962 532
1963 549
1964 582
1965 646
1966 726
1967 836
1968 923
1969 988
1970 1041
1971 1101
1972 1167
1973 1281
1974 1513
1975 1752
1976 2006
1977 2231
1978 2407
1979 2622
1980 2856
1981 3195
1982 3558
1983 3873
1984 4163
1985 4324
1986 4416
1987 4511
1988 4584
1989 4674
1990 4741
1991 4816
1992 4897
1993 4937
1994 4979
1995 5011
1996 5048
1997 5081
1998 5098
1999 5119
2000 5149
2001 5173
2002 5197
2003 5217
2004 5262
2005 5392
2006 5578
2007 5760
2008 5948
2009 6030
2010 6133
2011 6206
2012 6276
2013 6354
2014 6433
2015 6445
2016 6463
2017 6487
2018 6520
2019 6612
2020 6648
2021 6673
2022 6703
2023 6708
2024 6739
2025 6775
2026 6781
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 Perforación (X)",
     ylab = "N° Acumulado de Pozos (Y)",
     main = "Relación entre el Año y el Crecimiento Acumulado de Pozos")

La nube de puntos muestra una curva que se acelera con el tiempo, característica típica de un proceso de crecimiento exponencial, no de una relación lineal ni polinómica.

6. Conjetura del modelo matemático

Observando la gráfica de dispersión, se propone un Modelo de Regresión Exponencial, ya que los datos muestran un crecimiento acelerado y sostenido, en el cual el ritmo de aumento de Y es proporcional a su propio valor. Este modelo tiene la forma:

\[y = a \cdot e^{bx}\]

Para ajustarlo mediante mínimos cuadrados se linealiza aplicando logaritmo natural a ambos lados:

\[\ln(y) = \ln(a) + bx\]

m_exp   <- lm(log(y) ~ x, data = pares)
sum_reg <- summary(m_exp)

7. Cálculo de parámetros

Intercepto y tasa de crecimiento

coefs <- coef(m_exp)

a <- exp(coefs[1])   # parámetro de escala
b <- coefs[2]         # tasa de crecimiento exponencial

cat("Parámetro a (escala)         :", format(a, scientific = TRUE), "\n")
## Parámetro a (escala)         : 9.228605e-44
## Parámetro a (escala)         : 1.576400e-45

cat("Parámetro b (tasa de crecimiento):", round(b, 6), "\n")
## Parámetro b (tasa de crecimiento): 0.053771
## Parámetro b (tasa de crecimiento): 0.056092

cat("\nEcuación del modelo:\n")
## 
## Ecuación del modelo:
cat("y = ", format(a, scientific = TRUE), " * e^(", round(b, 6), " x )\n", sep = "")
## y = 9.228605e-44 * e^(0.053771 x )
## y = 1.576400e-45 * e^(0.056092 x)

8. Comparación del modelo con la realidad

x_grid <- seq(min(pares$x), max(pares$x), length.out = 400)
y_grid <- exp(predict(m_exp, 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 Perforación (X)",
     ylab = "N° Acumulado de Pozos (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")

9. Test de Pearson

Correlación lineal (sobre el modelo linealizado)

r  <- cor(pares$x, log(pares$y))
r2 <- sum_reg$r.squared * 100

cat("Correlación de Pearson (r):", round(r, 4), "\n")
## Correlación de Pearson (r): 0.9788
## Correlación de Pearson (r): 0.9724

cat("Coeficiente de determinación (R²%):", round(r2, 2), "%\n")
## Coeficiente de determinación (R²%): 95.8 %
## Coeficiente de determinación (R²%): 94.56 %

Coeficiente de determinación

El coeficiente de determinación (R²) indica qué porcentaje de la variación en el logaritmo del número acumulado de pozos (Y) es explicado por el año de perforación (X). Un valor de 94.56% significa que el modelo exponencial explica casi la totalidad del comportamiento de la variable dependiente — un ajuste mucho más fuerte que el que suele obtenerse con un modelo lineal simple sobre datos de crecimiento.

10. Estimación del modelo

Aprovechando la ecuación del modelo exponencial, realizamos estimaciones para años futuros fuera del rango de los datos originales.

# Estimación para el año 2030
anio_estimar <- 2030
acumulado_estimado <- exp(predict(m_exp, newdata = data.frame(x = anio_estimar)))

cat("Estimación para el año", anio_estimar, ":\n")
## Estimación para el año 2030 :
cat("N° acumulado de pozos estimado:", round(acumulado_estimado, 0), "\n\n")
## N° acumulado de pozos estimado: 23455
## Estimación para el año 2030 :
## N° acumulado de pozos estimado: 44588

# Estimación para el año 2035
anio_estimar2 <- 2035
acumulado_estimado2 <- exp(predict(m_exp, newdata = data.frame(x = anio_estimar2)))

cat("Estimación para el año", anio_estimar2, ":\n")
## Estimación para el año 2035 :
cat("N° acumulado de pozos estimado:", round(acumulado_estimado2, 0), "\n")
## N° acumulado de pozos estimado: 30691
## Estimación para el año 2035 :
## N° acumulado de pozos estimado: 59023

Tabla resumen del modelo

Ecuacion <- paste0(
  "y = ", format(a, scientific = TRUE),
  " * e^(", round(b, 6), "x)"
)

Tabla_resumen <- data.frame(
  `Variable Independiente`        = "Año de Perforación",
  `Variable Dependiente`          = "N° Acumulado de Pozos",
  `Test Pearson`                  = round(r, 2),
  `Coeficiente de determinación`  = round(r2, 2),
  `Ecuación del modelo`           = Ecuacion,
  check.names = FALSE
)

Tabla_resumen %>%
  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 Coeficiente de determinación Ecuación del modelo
Año de Perforación N° Acumulado de Pozos 0.98 95.8 y = 9.228605e-44 * e^(0.053771x)
Autor: Grupo 5

11. Conclusión

Entre el año de perforación (X) y el número acumulado de pozos de petróleo y gas (Y) existe una relación exponencial cuya ecuación matemática es:

\[y = 1.5764 \times 10^{-45} \cdot e^{0.056092x}\]

Siendo X el año de perforación y Y el número total de pozos perforados acumulados hasta ese año. Con una correlación de Pearson de 0.97 y un coeficiente de determinación de 94.56%, el modelo refleja de forma muy precisa cómo la actividad de perforación de pozos de petróleo y gas en el estado de Nueva York ha crecido de manera sostenida y acelerada a lo largo de más de 150 años (1870–2026), un patrón propio de la expansión progresiva de una industria extractiva a medida que se descubren y explotan nuevos yacimientos.