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 vs. 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 <- 9.6
cat("X =", round(x0, 4))
## X = 9.6

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(y)
max_y <- max(y)

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, +∞) 9.6 ≤ x → hacia ℝ⁺ x < 9.6 (y estimado < 0)

Aunque el modelo genera valores decimales, los Años Activos solo pueden tomar valores enteros positivos. Por ello, cada resultado se redondea al entero más cercano para obtener una estimación más realista y sin sesgo.

11. Estimación

Se ingresa un valor de Producción Acumulada (X) para estimar los Años Activos (Y) mediante el modelo. El valor debe ser mayor a 9.6; de lo contrario, el sistema muestra un aviso. El resultado se presenta con decimales y también redondeado al entero más cercano.

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. El modelo es válido para valores de X > 9.6, ya que a partir de este límite la ecuación genera valores positivos de Y. Este modelo describe la tendencia general de los datos agrupados por año y permite estimar los Años Activos a partir de la Producción Acumulada, sin representar el comportamiento de un pozo individual.