Usar Run All (Code → Run Region → Run All), no Knit, porque el chunk de carga usa file.choose().

1. Librerías

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

2. Carga de datos

ruta_archivo <- file.choose()
datos_completos <- read.csv(ruta_archivo, 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

Nota importante — por qué se recurre a la agregación: al analizar el dataset pozo por pozo (sin agrupar), la correlación entre estas dos variables es débil (r ≈ 0.38 al aplicar el logaritmo sobre X). Esto ocurre porque cada pozo individual está sujeto a muchos factores adicionales que introducen ruido — la formación geológica, el operador, el campo petrolero, las prácticas de completación, interrupciones de operación, etc. Ese ruido individual oculta la tendencia central que sí existe entre ambas variables. La estrategia de este documento consiste en agrupar los pozos por cada año exacto de actividad y trabajar con la media de cada grupo, lo cual filtra el ruido caso a caso y deja ver con claridad el patrón subyacente.

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 con claridad: cada pozo individual está sujeto a demasiado ruido propio, y los puntos se amontonan sin dejar ver ninguna tendencia. Por esta razón se optó por realizar una estrategia de agregación para obtener un gráfico más limpio.

Estrategia
  1. Agrupar los pozos por cada año exacto de actividad (floor(YEARS_ACTIVE))
  2. Calcular la media de X (Producción Acumulada) y de Y (Años Activos) dentro de cada grupo, obteniendo un único par (x̄, ȳ) por año
  3. Usar estos pares agregados, en lugar de los pozos individuales, para conjeturar y ajustar el modelo logarítmico

4.2 Tabla de pares (X, Y) usando la media

tabla_media <- datos %>%
  mutate(Año = floor(YEARS_ACTIVE)) %>%
  group_by(Año) %>%
  summarise(
    n_pozos = n(),
    x_medio = mean(CUMULATIVE_PRODUCTION),
    y_medio = mean(YEARS_ACTIVE),
    .groups = "drop"
  ) %>%
  arrange(Año)

cat("Total de pares (x\u0304, y\u0304) obtenidos:", nrow(tabla_media), "\n")
## Total de pares (x̄, ȳ) obtenidos: 89
datatable(tabla_media %>% select(Año, n_pozos, x_medio, y_medio), rownames = FALSE,
          colnames = c("Año", "Pozos en el grupo", "X̄ (Producción Acumulada)", "Ȳ (Años Activos)"),
          class = "stripe hover compact",
          options = list(pageLength = 10)) %>%
  formatRound(columns = c("x_medio", "y_medio"), digits = 2)

4.3 Máximos, mínimos y resumen general

max_x <- max(tabla_media$x_medio); min_x <- min(tabla_media$x_medio)
max_y <- max(tabla_media$y_medio); min_y <- min(tabla_media$y_medio)

data.frame(
  Variable = c("X̄ (Producción Acumulada)", "Ȳ (Años Activos)"),
  Minimo   = round(c(min_x, min_y), 2),
  Maximo   = round(c(max_x, max_y), 2),
  Rango    = round(c(max_x - min_x, max_y - min_y), 2),
  Mediana  = round(c(median(tabla_media$x_medio), median(tabla_media$y_medio)), 2)
) %>%
  kable(col.names = c("Variable", "Mínimo", "Máximo", "Rango", "Mediana"),
        align = "lcccc") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE, position = "center", font_size = 14) %>%
  row_spec(0, bold = TRUE, background = "#f2f2f2")
Variable Mínimo Máximo Rango Mediana
X̄ (Producción Acumulada)
7417.8

5. Gráfica de Dispersión

plot(tabla_media$x_medio, tabla_media$y_medio,
     col = "#5b6b8c", pch = 19, cex = 1.1,
     main = "Años Activos en función de la Producción Acumulada (pares agregados por año)",
     xlab = "X̄ (Producción Acumulada, barriles)",
     ylab = "Ȳ (Años Activos)",
     cex.main = 0.9, frame.plot = FALSE)
grid(col = "gray88")
box()

6. Conjetura

La nube de puntos muestra una tendencia creciente y cóncava: a mayor Producción Acumulada, mayores son los Años Activos, pero el crecimiento es rápido al inicio y se aplana progresivamente. En otras palabras: los primeros barriles de producción acumulada “cuestan” pocos años de operación, mientras que alcanzar niveles de producción cada vez más altos exige incrementos de tiempo cada vez mayores. Este comportamiento es consistente con la curva de declinación típica de un yacimiento petrolero, donde la tasa de producción disminuye con el tiempo. Por lo anterior, se conjetura el modelo:

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

con pendiente \(b > 0\) (relación directamente proporcional a tasa decreciente).

7. Cálculo de Parámetros

x <- tabla_media$x_medio
y <- tabla_media$y_medio

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 = -279.9145 + 26.6939 * 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 -279.9145
b 26.6939 
summary(modelo)
## 
## Call:
## lm(formula = y ~ log(x))
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -32.784  -9.943   3.105   9.445  43.028 
## 
## Coefficients:
##             Estimate Std. Error t value            Pr(>|t|)    
## (Intercept) -279.914     21.178  -13.22 <0.0000000000000002 ***
## log(x)        26.694      1.736   15.38 <0.0000000000000002 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 13.48 on 87 degrees of freedom
## Multiple R-squared:  0.731,  Adjusted R-squared:  0.7279 
## F-statistic: 236.4 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 = "Ȳ (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̄, ȳ)", 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 \(\ln(x)\), debe superar 0.7 en valor absoluto para aceptar el modelo logarítmico.

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̄, ȳ) 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̄, ȳ) agregados por año 0.855 |r| > 0.7 Aceptado

Sobre los pares (x̄, ȳ), \(r =\) 0.855, muy por encima del umbral de 0.7, por lo que el modelo logarítmico se acepta para describir la tendencia central de la relación entre la Producción Acumulada y los Años Activos.

Importante — alcance del modelo: este ajuste tan alto corresponde a las medias agregadas por año, no a pozos individuales. Promediar dentro de cada grupo elimina la variabilidad propia de cada pozo, lo cual siempre aumenta el valor de r. Por eso el modelo debe interpretarse como una descripción de la tendencia general de la cohorte de pozos (cuánto tiempo necesita, en promedio, un grupo de pozos para alcanzar cierto nivel de producción acumulada), y no como una herramienta para predecir con esta misma precisión los años activos de un pozo puntual.

10. Restricciones

tabla_restricciones <- data.frame(
  Variable          = c("X (CUMULATIVE_PRODUCTION)", "Y (YEARS_ACTIVE)"),
  Dominio_teorico   = c("R+ : X \u2208 (0, +\u221e)", "Z+ : Y \u2208 {Z+}"),
  Rango_teorico     = c("R = { x \u2208 \u211d | 0.05 \u2264 x \u2264 37,309,517 }",
                        "R = { x \u2208 \u2115 | 1 \u2264 x \u2264 100 }"),
  Rango_valido_agg  = c(paste0(round(min_x, 2), " \u2264 x\u0304 \u2264 ", round(max_x, 2)),
                        paste0(round(min_y, 2), " \u2264 y\u0304 \u2264 ", round(max_y, 2))),
  Rango_invalido    = c("x \u2264 0", "y \u2264 0")
)

kable(tabla_restricciones,
      col.names = c("Variable", "Dominio (te\u00f3rico)", "Rango (te\u00f3rico)",
                    "Rango v\u00e1lido observado (agregado)", "Rango inv\u00e1lido"),
      align = "lcccc", 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:5, width = "3.7cm") %>%
  row_spec(0, bold = TRUE, background = "#f2f2f2")
Variable Dominio (teórico) Rango (teórico) Rango válido observado (agregado) Rango inválido
X (CUMULATIVE_PRODUCTION) R+ : X ∈ (0, +∞) R = { x ∈ ℝ &#124; 0.05 ≤ x ≤ 37,309,517 } 7417.8 ≤ x̄ ≤ 635580.91
    x ≤ 0

El dominio y rango teóricos provienen de la Tabla de Variables del dataset: CUMULATIVE_PRODUCTION es una magnitud de razón que toma valores reales no negativos, y YEARS_ACTIVE es una magnitud discreta de razón (número natural) acotada entre 1 y 100 años. La condición \(x > 0\) es, además, matemáticamente necesaria para que \(\ln(x)\) esté definido; como la Producción Acumulada es siempre una cantidad física positiva, esta condición se cumple en la práctica.

El rango válido observado es más angosto que el rango teórico porque corresponde a los valores efectivamente presentes en los datos agregados (Tabla 4.2) usados para ajustar el modelo. El modelo logarítmico es confiable dentro de ese rango observado — 7,417.8 a 635,580.9 barriles de producción acumulada —; fuera de él (extrapolación), las estimaciones deben tomarse con cautela.

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). Si el valor ingresado no es válido, o está fuera del rango observado en los datos, se muestra un aviso.

Calculadora de Estimación

Modelo: y = -279.9145 + 26.693906 · 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 = -279.9145 + 26.6939 \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 coeficiente de correlación de Pearson obtenido con los datos agregados (Tabla 4.2) fue r = 0.855, lo que indica una correlación positiva muy fuerte y permite aceptar el modelo.

Importante: este ajuste tan alto corresponde a las medias agregadas por año, no a pozos individuales — a nivel de pozo individual (datos originales, sin agrupar) el ruido propio de cada operación reduce la correlación a r ≈ 0.38. El modelo debe interpretarse, por tanto, como una descripción de la tendencia general de la cohorte de pozos, más que como una herramienta para predecir con esta misma precisión el comportamiento de un pozo puntual.