1. Librerías

suppressMessages(suppressWarnings({
  library(dplyr)
  library(knitr)
  library(kableExtra)
  library(DT)
}))

2. Carga de datos

ruta <- file.choose()
datos_completos <- read.csv(ruta, stringsAsFactors = FALSE)

cat("Filas:", nrow(datos_completos), "| Columnas:", ncol(datos_completos), "\n")
## Filas: 47757 | Columnas: 24
str(datos_completos)
## '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" ...

3. Selección de variables

Variable Dependiente (Y): Años Activos. Se seleccionó como variable dependiente porque representa el tiempo que un pozo ha permanecido en operación. Es el resultado que se desea explicar a partir de otra variable: ¿cuánto tiempo necesita un pozo para alcanzar cierto nivel de producción?

Variable Independiente (X): Producción Acumulada. Se eligió como variable independiente porque representa el volumen total de hidrocarburos extraídos durante toda la vida útil del pozo. Conceptualmente, la producción acumulada es la que se va construyendo con los años de operación, por lo que se espera que los años activos guarden relación con el nivel de producción acumulada alcanzado.

datos <- datos_completos %>%
  mutate(
    CUMULATIVE_PRODUCTION = as.numeric(CUMULATIVE_PRODUCTION),
    YEARS_ACTIVE          = as.numeric(YEARS_ACTIVE)
  ) %>%
  select(CUMULATIVE_PRODUCTION, YEARS_ACTIVE)

# Rellenamiento de celdas faltantes con la media
if (any(is.na(datos$CUMULATIVE_PRODUCTION))) {
  datos$CUMULATIVE_PRODUCTION[is.na(datos$CUMULATIVE_PRODUCTION)] <-
    mean(datos$CUMULATIVE_PRODUCTION, na.rm = TRUE)
}
if (any(is.na(datos$YEARS_ACTIVE))) {
  datos$YEARS_ACTIVE[is.na(datos$YEARS_ACTIVE)] <-
    mean(datos$YEARS_ACTIVE, na.rm = TRUE)
}

# Se descartan registros con valores no positivos
datos <- datos %>%
  filter(CUMULATIVE_PRODUCTION > 0, YEARS_ACTIVE > 0)

nrow(datos)
## [1] 47757
str(datos)
## 'data.frame':    47757 obs. of  2 variables:
##  $ CUMULATIVE_PRODUCTION: num  47225 275063 82624 7544 681006 ...
##  $ YEARS_ACTIVE         : num  55 55 47 20 28 55 20 48 48 55 ...
summary(datos)
##  CUMULATIVE_PRODUCTION  YEARS_ACTIVE 
##  Min.   :     1        Min.   : 1.0  
##  1st Qu.: 13030        1st Qu.:11.0  
##  Median : 51074        Median :19.0  
##  Mean   :144072        Mean   :24.3  
##  3rd Qu.:172967        3rd Qu.:36.0  
##  Max.   :985283        Max.   :89.0

4. Tablas

4.1 Tabla de valores

nrow(datos)
## [1] 47757
condensado <- datos %>%
  mutate(Año = floor(YEARS_ACTIVE)) %>%
  group_by(Año) %>%
  summarise(
    n_valores = n(),
    valores   = paste(format(round(CUMULATIVE_PRODUCTION, 2), big.mark = ","), collapse = ", "),
    .groups   = "drop"
  ) %>%
  arrange(Año)

cat("Grupos (años) en la tabla:", nrow(condensado), "\n")
## Grupos (años) en la tabla: 89
condensado_html <- condensado %>%
  mutate(
    CUMULATIVE_PRODUCTION = paste0(
      "<details><summary>", n_valores, " valor(es)</summary>", valores, "</details>"
    )
  ) %>%
  select(Año, CUMULATIVE_PRODUCTION)

datatable(condensado_html, escape = FALSE, rownames = FALSE,
          colnames = c("Años Activos", "Producción Acumulada (valores)"),
          class = "stripe hover compact",
          options = list(pageLength = 10))
plot(datos$CUMULATIVE_PRODUCTION, datos$YEARS_ACTIVE,
     main = "Nube de puntos (todos los valores, sin agrupar)",
     xlab = "Producción Acumulada (X)",
     ylab = "Años Activos (Y)",
     col  = "#5b6b8c",
     pch  = 19,
     cex  = 0.35)
grid(col = "gray88")

La nube de puntos visualizada en la parte de arriba no permite conjeturar un modelo, por esta razón se optó por realizar una estrategia para depurar los datos y obtener un gráfico más limpio.

Estrategia 1.Generación de valores pares únicas 2.Llenar espacios donde no haya valores 3.Donde se encuentren valores diversos usar indicadores de posición (minimos) 4.Presentar nueva tabla con los minimos de los valores

4.2 Tabla de pares (X, Y) usando el mínimo

tabla_minima <- datos %>%
  mutate(Año = floor(YEARS_ACTIVE)) %>%
  group_by(Año) %>%
  summarise(
    x_minimo = min(CUMULATIVE_PRODUCTION),
    .groups = "drop"
  ) %>%
  arrange(Año) %>%
  rename(y_minimo = Año)

cat("Total de pares (x_min, y) obtenidos:", nrow(tabla_minima), "\n")
## Total de pares (x_min, y) obtenidos: 89
datatable(tabla_minima %>% select(y_minimo, x_minimo), rownames = FALSE,
          colnames = c("Años Activos", "Xₘᵢₙ (Producción Acumulada)"),
          class = "stripe hover compact",
          options = list(pageLength = 10)) %>%
  formatRound(columns = c("x_minimo"), digits = 2)

5. Gráfica de Dispersión

plot(tabla_minima$x_minimo, tabla_minima$y_minimo,
     col = "#5b6b8c", pch = 19, cex = 1.1,
     main = "Años Activos en función de la Producción Acumulada (pares agregados por año, mínimo)",
     xlab = "Xₘᵢₙ (Producción Acumulada, barriles)",
     ylab = "Y (Años Activos)",
     cex.main = 0.9, frame.plot = FALSE)
grid(col = "gray88")
box()

6. Conjetura

La gráfica muestra que, a mayor Producción Acumulada, aumentan los Años Activos, aunque el crecimiento se vuelve cada vez más lento. Por ello, se conjetura un modelo de tipo logarítmico.

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

7. Cálculo de Parámetros

x <- tabla_minima$x_minimo
y <- tabla_minima$y_minimo

modelo <- lm(y ~ log(x))
a <- unname(coef(modelo)[1])
b <- unname(coef(modelo)[2])

cat("Modelo ajustado: y =", round(a, 4), "+", round(b, 4), "* ln(x)\n")
## Modelo ajustado: y = -17.898 + 8.3654 * ln(x)
kable(data.frame(Parámetro = c("a", "b"), Valor = round(c(a, b), 4)),
      align = "lr") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
Parámetro Valor
a -17.8980
b 8.3654 
summary(modelo)
## 
## Call:
## lm(formula = y ~ log(x))
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -10.2729  -3.4993   0.5123   2.3308  18.8980 
## 
## Coefficients:
##             Estimate Std. Error t value            Pr(>|t|)    
## (Intercept) -17.8980     1.6088  -11.12 <0.0000000000000002 ***
## log(x)        8.3654     0.1987   42.09 <0.0000000000000002 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 5.622 on 87 degrees of freedom
## Multiple R-squared:  0.9532, Adjusted R-squared:  0.9527 
## F-statistic:  1772 on 1 and 87 DF,  p-value: < 0.00000000000000022

8. Realidad y modelo

x_seq <- seq(min(x), max(x), length.out = 500)
pred  <- predict(modelo, newdata = data.frame(x = x_seq),
                 interval = "confidence", level = 0.95)

plot(x, y, col = "#5b6b8c", pch = 19, cex = 1.1,
     main = "Modelo Logarítmico sobrepuesto a la Realidad",
     xlab = "Xₘᵢₙ (Producción Acumulada, barriles)",
     ylab = "Y (Años Activos)",
     cex.main = 0.9, frame.plot = FALSE)
grid(col = "gray88")
polygon(c(x_seq, rev(x_seq)), c(pred[,"lwr"], rev(pred[,"upr"])),
        col = rgb(0.5, 0.5, 0.5, 0.2), border = NA)
lines(x_seq, pred[,"fit"], col = "#1b2a4a", lwd = 2)
legend("topleft",
       legend = c("Datos (xₘᵢₙ, y)", paste0("y=", round(a,2), " + ", round(b,4), "\u00b7ln(x)"), "I.C. 95%"),
       col = c("#5b6b8c", "#1b2a4a", "gray"),
       pch = c(19, NA, 15), lty = c(NA, 1, NA), lwd = c(NA, 2, NA), bty = "n")
box()

9. Test

El coeficiente de correlación de Pearson, calculado sobre el modelo linealizado.

r_medias <- cor.test(log(x), y)
r_val    <- round(r_medias$estimate, 4)
resultado <- ifelse(abs(r_val) > 0.7, "Aceptado", "Rechazado")

tabla_test <- data.frame(
  Conjunto  = "Pares (xₘᵢₙ, y) agregados por año",
  r         = r_val,
  Criterio  = "|r| > 0.7",
  Resultado = resultado,
  check.names = FALSE
)

kable(tabla_test,
      col.names = c("Conjunto", "r", "Criterio", "Resultado"),
      align = "lccc", format = "html", row.names = FALSE) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE, position = "center", font_size = 14) %>%
  row_spec(0, bold = TRUE, background = "#f2f2f2") %>%
  column_spec(4, bold = TRUE,
              color = ifelse(tabla_test$Resultado == "Aceptado", "#1b2a4a", "#6b6b6b"))
Conjunto r Criterio Resultado
Pares (xₘᵢₙ, y) agregados por año 0.9763 |r| > 0.7 Aceptado

10. Restricciones

Dominios de las variables

tabla_dominios <- data.frame(
  Variable = c("Y (YEARS_ACTIVE)", "X (CUMULATIVE_PRODUCTION)"),
  Dominio  = c("Z+ : Y \u2208 {Z+}", "R+ : X \u2208 (0, +\u221e)")
)

kable(tabla_dominios, col.names = c("Variable", "Dominio"), align = "lc") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE, position = "center", font_size = 14) %>%
  column_spec(1, bold = TRUE, width = "6cm") %>%
  row_spec(0, bold = TRUE, background = "#f2f2f2")
Variable Dominio
Y (YEARS_ACTIVE) Z+ : Y ∈ {Z+}
X (CUMULATIVE_PRODUCTION) R+ : X ∈ (0, +∞)

¿Existen valores de X que, utilizando la ecuación del modelo, nos den valores fuera del dominio de Y?

Y representa los Años Activos, mientras que X (Producción Acumulada) es la variable independiente. Para identificar cuándo Y sale de su dominio (\(Y \leq 1\)), se iguala la ecuación a \(Y = 1\) y se despeja X.

Despeje para X:

\[1 = a + b\cdot\ln(X) \;\Rightarrow\; \ln(X) = -\frac{a}{b} \;\Rightarrow\; X = e^{-a/b}\]

x0 <- exp(-a / b)
cat("X =", round(x0, 4))
## X = 8.4955

El valor obtenido representa el límite a partir del cual el modelo comienza a generar valores de Y fuera de su dominio (\(Y \leq 1\)). Con base en este resultado, se establecieron los rangos en los que el modelo es válido y aquellos en los que deja de ser aplicable.

Restricciones del modelo

min_y <- min(tabla_minima$y_minimo)
max_y <- max(tabla_minima$y_minimo)

tabla_restricciones <- data.frame(
  Variable          = c("Y (YEARS_ACTIVE)", "X (CUMULATIVE_PRODUCTION)"),
  Dominio   = c("Z+ : Y \u2208 {Z+}", "R+ : X \u2208 (0, +\u221e)"),
  Rango_valido_modelo = c(paste0(round(min_y, 2), " \u2264 y \u2264 ", round(max_y, 2)),
                        paste0(round(x0, 2), " \u2264 x \u2192 hacia \u211d\u207a")),
  Rango_invalido    = c("y \u2264 0", paste0("x < ", round(x0, 2), " (y estimado < 0)"))
)

kable(tabla_restricciones,
      col.names = c("Variable", "Dominio (te\u00f3rico)",
                    "Rango v\u00e1lido del modelo", "Rango inv\u00e1lido"),
      align = "lccc", escape = TRUE) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE, position = "center", font_size = 13.5) %>%
  column_spec(1, bold = TRUE, width = "4.5cm") %>%
  column_spec(2:4, width = "3.7cm") %>%
  row_spec(0, bold = TRUE, background = "#f2f2f2")
Variable Dominio (teórico) Rango válido del modelo Rango inválido
Y (YEARS_ACTIVE) Z+ : Y ∈ {Z+} 1 ≤ y ≤ 89 y ≤ 0
X (CUMULATIVE_PRODUCTION) R+ : X ∈ (0, +∞) 8.5 ≤ x → hacia ℝ⁺ x < 8.5 (y estimado < 0)

Nota sobre decimales: el dominio real de Y (Años Activos) son los números enteros positivos (\(\mathbb{Z}^+\)); sin embargo, al ser \(y = a + b\cdot\ln(x)\) una ecuación logarítmica —y por tanto continua—, el modelo siempre entrega un valor de Y con decimales. Como YEARS_ACTIVE es en la práctica un conteo entero (no una duración continua con una fracción de periodo “en curso”), no existe una razón para sesgar la estimación siempre hacia arriba; por eso toda estimación de Y obtenida con el modelo debe aproximarse al entero más cercano (redondeo normal, función round()), que es la opción estadísticamente neutral y no introduce un sesgo sistemático.

11. Estimación

Ingresa un valor de Producción Acumulada (X) para estimar los Años Activos (Y) usando la ecuación del modelo \(y = a + b\cdot\ln(x)\), respetando el dominio de X (\(\mathbb{R}^+\): número real positivo) y el umbral \(x_0 =\) 8.5 a partir del cual Y deja de ser negativo (ver sección 10). Si el valor ingresado no es válido, produce un Y negativo, o está fuera del rango observado en los datos, se muestra un aviso. El resultado se presenta con decimales y también aproximado al entero más cercano (redondeo normal), ya que Y (Años Activos) solo admite valores enteros positivos.

Calculadora de Estimación

Modelo: y = -17.8980 + 8.365358 · ln(x)


12. Conclusión

Entre los Años Activos y la Producción Acumulada existe una relación de tipo logarítmica, cuya ecuación matemática es

\[y = -17.898 + 8.3654 \cdot \ln(x)\]

Siendo Y (Años Activos) la variable dependiente y X (Producción Acumulada) la variable independiente; no se identificaron restricciones adicionales para el modelo, ya que para cualquier valor de X > 0 la ecuación genera un valor de Y dentro de su dominio. Además, el ajuste obtenido con los datos agregados (Tabla 4.2) muestra una correlación positiva muy fuerte, lo que permite aceptar el modelo.