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
# 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
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
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
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
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"
)
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.
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)
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)
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")
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 %
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.
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
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 | ||||
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.