1 Configuración y Carga de Datos

df <- read.csv("KANSAS_LIMPIO.csv")
str(df)
## 'data.frame':    47757 obs. of  24 variables:
##  $ KID                      : int  1001106903 1001106572 1001106590 1001107343 1001108234 1001106684 1001107377 1001107386 1001107740 1001106710 ...
##  $ DEPTH_OF_WELL            : num  700 800 1400 1125 2940 ...
##  $ CUMULATIVE_PRODUCTION    : num  47225 275063 82624 7544 681006 ...
##  $ AVG_PRODUCTION           : num  859 5001 1758 377 24322 ...
##  $ LATITUDE                 : num  37.1 38.8 37.5 37.8 37.1 ...
##  $ LONGITUDE                : num  -95.9 -95.2 -96.3 -95.7 -101.3 ...
##  $ YEARS_ACTIVE             : num  55 55 47 20 28 55 20 48 48 55 ...
##  $ SECTION                  : num  33 11 34 8 30 4 26 28 11 17 ...
##  $ COUNTY_CODE              : num  125 45 49 207 189 121 49 1 31 121 ...
##  $ STATE_CODE               : int  15 15 15 15 15 15 15 15 15 15 ...
##  $ TOWNSHIP                 : num  33 15 29 26 33 17 30 26 23 16 ...
##  $ RANGE                    : num  14 20 10 16 36 25 12 21 16 24 ...
##  $ PRODUCES_OIL             : num  1 1 1 1 0 1 1 1 1 1 ...
##  $ PRODUCES_GAS             : num  0 0 0 0 1 0 0 0 0 0 ...
##  $ OPERATOR_NAME            : chr  "Horton, John" "Whitlow Energy, Inc." "Suerte Oil Company" "Patterson-Blackford" ...
##  $ FIELD_NAME               : chr  "WAYSIDE-HAVANA" "BALDWIN" "DUNKLEBERGER" "ROSE EAST" ...
##  $ PRODUCING_FORMATION      : chr  "UNKNOWN" "UNKNOWN" "UNKNOWN" "UNKNOWN" ...
##  $ LONGITUDE_LATITUDE_SOURCE: chr  "CENTER_OF_SECTION" "CENTER_OF_SECTION" "CENTER_OF_SECTION" "CENTER_OF_SECTION" ...
##  $ PROD_LEVEL               : chr  "MEDIUM" "HIGH" "MEDIUM" "LOW" ...
##  $ DEPTH_LEVEL              : chr  "SHALLOW" "SHALLOW" "SHALLOW" "SHALLOW" ...
##  $ LIFE_STAGE               : chr  "OLD" "OLD" "OLD" "MATURE" ...
##  $ AVG_PROD_LEVEL           : chr  "LOW" "MEDIUM" "MEDIUM" "LOW" ...
##  $ TOWNSHIP_DIRECTION       : chr  "S" "S" "S" "S" ...
##  $ RANGE_DIRECTION          : chr  "E" "E" "E" "E" ...

2 Extracción y Depuración de Variables

Se estableció YEARS_ACTIVE (años) como variable independiente (x), ya que representa el tiempo total que un pozo ha permanecido en operación y constituye el principal factor temporal que acumula producción.

CUMULATIVE_PRODUCTION (barriles) actúa como variable dependiente (y), puesto que refleja el volumen total de hidrocarburos extraídos durante la vida productiva del pozo.

Esta relación modela el comportamiento de la producción a lo largo del tiempo: a medida que los años activos aumentan, la producción acumulada también se incrementa, aunque con una tasa de crecimiento decreciente, lo cual justifica el uso de un modelo logarítmico para capturar dicha tendencia no lineal.

  • Variable Independiente (X): YEARS_ACTIVE (años activo)
  • Variable Dependiente (Y): CUMULATIVE_PRODUCTION (barriles)
# Extraer variables de interés
datos_raw <- df[, c("YEARS_ACTIVE", "CUMULATIVE_PRODUCTION")]
colnames(datos_raw) <- c("x_raw", "y_raw")

# Eliminar nulos y valores <= 0
datos_raw <- na.omit(datos_raw)
datos_raw <- datos_raw[datos_raw$x_raw > 0 & datos_raw$y_raw > 0, ]

# Eliminar outliers extremos con criterio 3*IQR
for (col in c("x_raw", "y_raw")) {
  Q1 <- quantile(datos_raw[[col]], 0.25)
  Q3 <- quantile(datos_raw[[col]], 0.75)
  IQR_val <- Q3 - Q1
  datos_raw <- datos_raw[datos_raw[[col]] >= (Q1 - 3 * IQR_val) &
                           datos_raw[[col]] <= (Q3 + 3 * IQR_val), ]
}

cat("Registros tras depuración:", nrow(datos_raw), "\n")
## Registros tras depuración: 45134

3 Análisis Gráfico Exploratorio

par(mar = c(5, 5, 4, 2))

plot(datos_raw$x_raw, datos_raw$y_raw,
     main = "Gráfica N°1: Diagrama de Dispersión de la Producción\nAcumulada (bbl) en función de los Años Activo",
     xlab = "Años Activo",
     ylab = "Producción Acumulada (bbl)",
     col  = rgb(0.4, 0.4, 0.4, 0.15),
     pch  = 16,
     cex  = 0.6,
     cex.main = 0.9,
     frame.plot = FALSE)

grid(nx = NULL, ny = NULL, col = "#CCCCCC", lty = "dotted")

4 Aplicación de Binning

Debido a la variabilidad observada en la Gráfica N°1, se implementa la técnica de binning con el objetivo de disminuir el ruido estadístico y visualizar con mayor claridad la tendencia general de los datos.

# Agrupamiento en 20 intervalos de YEARS_ACTIVE
breaks_seq <- seq(min(datos_raw$x_raw), max(datos_raw$x_raw), length.out = 21)
datos_raw$bin <- cut(datos_raw$x_raw, breaks = breaks_seq, include.lowest = TRUE)

datos_model <- datos_raw %>%
  group_by(bin) %>%
  summarise(
    x = mean(x_raw, na.rm = TRUE),
    y = mean(y_raw, na.rm = TRUE),
    conteo = n(),
    .groups = "drop"
  ) %>%
  filter(conteo >= 3)

# Calcular punto medio de cada intervalo para la regresión
limites <- cbind(
  inf = breaks_seq[-length(breaks_seq)],
  sup = breaks_seq[-1]
)
datos_model$x_mid <- (limites[, "inf"] + limites[, "sup"]) / 2

# Etiqueta del intervalo para mostrar en tabla
datos_model$intervalo <- paste0(
  "[", round(limites[, "inf"], 1), " — ", round(limites[, "sup"], 1), "]"
)

x <- datos_model$x_mid
y <- datos_model$y

# Tabla con intervalos
datos_model %>%
  select(intervalo, y, conteo) %>%
  gt() %>%
  tab_header(title = md("**Tabla N°1: Binning — Medias por intervalo (20 bins)**")) %>%
  cols_label(
    intervalo = "Intervalo (Años Activo)",
    y         = "Media Prod. Acumulada (bbl)",
    conteo    = "N"
  ) %>%
  fmt_number(columns = y, decimals = 2) %>%
  cols_align(align = "center", everything())
Tabla N°1: Binning — Medias por intervalo (20 bins)
Intervalo (Años Activo) Media Prod. Acumulada (bbl) N
[1 — 5.4] 19,483.59 6333
[5.4 — 9.8] 41,000.37 3967
[9.8 — 14.2] 65,824.95 7261
[14.2 — 18.6] 96,392.45 5811
[18.6 — 23] 125,957.79 4752
[23 — 27.4] 138,177.65 1956
[27.4 — 31.8] 210,009.43 2132
[31.8 — 36.2] 144,158.39 2286
[36.2 — 40.6] 123,276.19 1817
[40.6 — 45] 118,547.54 2967
[45 — 49.4] 148,479.93 1234
[49.4 — 53.8] 154,788.51 773
[53.8 — 58.2] 168,356.38 1365
[58.2 — 62.6] 240,911.87 1113
[62.6 — 67] 241,190.31 333
[67 — 71.4] 271,622.40 305
[71.4 — 75.8] 298,537.93 276
[75.8 — 80.2] 328,207.29 204
[80.2 — 84.6] 377,396.93 135
[84.6 — 89] 398,635.14 114

5 Conjetura del Modelo de Regresión Logarítmico

La ecuación del modelo es: \(y = a + b \cdot \ln(x)\).

modelo_log <- lm(y ~ log(x))

6 Gráfica del Modelo Logarítmico

Se presenta el ajuste del modelo incluyendo la banda de incertidumbre estadística (Intervalo de Confianza del 95%).

par(mar = c(5, 5, 4, 2))

plot(x, y,
     main = "Gráfica N°2: Modelo Logarítmico de la Producción\nAcumulada (bbl) en función de los Años Activo",
     xlab = "Años Activo",
     ylab = "Producción Acumulada (bbl)",
     col  = "grey40",
     pch  = 16,
     cex  = 1.0,
     cex.main = 0.9,
     frame.plot = FALSE)

grid(nx = NULL, ny = NULL, col = "#CCCCCC", lty = "dotted")

# Secuencia suave
x_seq <- seq(min(x), max(x), length.out = 500)

pred_log <- predict(modelo_log,
                    newdata  = data.frame(x = x_seq),
                    interval = "confidence",
                    level    = 0.95)

# Intervalo de confianza
polygon(c(x_seq, rev(x_seq)),
        c(pred_log[, "lwr"], rev(pred_log[, "upr"])),
        col    = rgb(0.5, 0.5, 0.5, 0.2),
        border = NA)

# Línea ajustada
lines(x_seq, pred_log[, "fit"], col = "grey20", lwd = 3)

legend("topleft",
       legend = c("Datos promediados (binning)", "Modelo Logarítmico", "I.C. 95%"),
       col    = c("grey40", "grey20", "grey70"),
       pch    = c(16, NA, 15),
       lwd    = c(NA, 3, NA),
       pt.cex = c(1, NA, 2),
       bty    = "n")

7 Test de Bondad del Modelo

7.1 Coeficiente de correlación del modelo linealizado

r <- cor(log(x), y, use = "complete.obs")
cat("El coeficiente de correlación es: ", round(r, 4))
## El coeficiente de correlación es:  0.8321

7.2 Coeficiente de determinación

r2 <- summary(modelo_log)$r.squared
cat("El coeficiente de determinación (R²) es: ", round(r2, 4))
## El coeficiente de determinación (R²) es:  0.6924

8 Ecuación del Modelo

a_bin <- coef(modelo_log)[1]
b_bin <- coef(modelo_log)[2]

if (b_bin >= 0) {
  ecuacion <- paste0("y = ", round(a_bin, 4), " + ", round(b_bin, 4), " ln(x)")
} else {
  ecuacion <- paste0("y = ", round(a_bin, 4), " - ", abs(round(b_bin, 4)), " ln(x)")
}

cat("La ecuación estimada del modelo es:\n\n", ecuacion)
## La ecuación estimada del modelo es:
## 
##  y = -175782.8778 + 101902.2243 ln(x)

9 Tabla Resumen del Modelo

tabla_resumen <- data.frame(
  Variable     = c("YEARS_ACTIVE", "CUMULATIVE_PRODUCTION"),
  Tipo         = c("Independiente (x)", "Dependiente (y)"),
  R            = c("", round(r, 4)),
  R2           = c("", round(r2, 4)),
  Intercepto_a = c("", round(a_bin, 4)),
  Pendiente_b  = c("", round(b_bin, 4)),
  Ecuacion     = c("", ecuacion)
)

tabla_resumen %>%
  gt() %>%
  tab_header(title = md("**Tabla N°2: Resumen del Modelo de Regresión Logarítmica**")) %>%
  tab_source_note(source_note = "Dataset: Pozos Petroleros de Kansas") %>%
  cols_align(align = "center", everything())
Tabla N°2: Resumen del Modelo de Regresión Logarítmica
Variable Tipo R R2 Intercepto_a Pendiente_b Ecuacion
YEARS_ACTIVE Independiente (x)
CUMULATIVE_PRODUCTION Dependiente (y) 0.8321 0.6924 -175782.8778 101902.2243 y = -175782.8778 + 101902.2243 ln(x)
Dataset: Pozos Petroleros de Kansas

10 Cálculo de Estimaciones

¿Cuál es la Producción Acumulada estimada para un pozo con 30 años activo?

x_test <- 30
y_est  <- predict(modelo_log, newdata = data.frame(x = x_test))

cat("Para", x_test, "años activo, la Producción Acumulada estimada es:",
    round(y_est, 2), "barriles")
## Para 30 años activo, la Producción Acumulada estimada es: 170806.7 barriles

11 Conclusiones

Entre los Años Activo y la Producción Acumulada (bbl) existe una relación de tipo logarítmica, con un coeficiente de determinación R² = 0.69, lo que indica un ajuste moderado del modelo.

La ecuación estimada es: \(y = -1.7578288\times 10^{5} + 1.0190222\times 10^{5} \cdot \ln(x)\).

El modelo presenta como única condición matemática que x > 0, lo cual se cumple naturalmente en el contexto de pozos petroleros, ya que todos tienen al menos 1 año de actividad, por lo que no existen restricciones prácticas dentro del rango analizado.