1 Librerías

library(readr)
library(dplyr)
library(ggplot2)
library(gt)
library(stringr)
library(DT)

cat("Librerías cargadas: readr, dplyr, ggplot2, gt, stringr, DT")
Librerías cargadas: readr, dplyr, ggplot2, gt, stringr, DT

2 Carga de Datos

ruta_archivo <- file.choose()

datos <- read_csv(ruta_archivo, show_col_types = FALSE)

# Rellenamiento de celdas faltantes con la mediana de cada variable (valor de referencia estable)
if (any(is.na(datos$DEPTH_OF_WELL))) {
  datos$DEPTH_OF_WELL[is.na(datos$DEPTH_OF_WELL)] <-
    median(datos$DEPTH_OF_WELL, na.rm = TRUE)
}
if (any(is.na(datos$AVG_PRODUCTION))) {
  datos$AVG_PRODUCTION[is.na(datos$AVG_PRODUCTION)] <-
    median(datos$AVG_PRODUCTION, na.rm = TRUE)
}

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

str(datos[, c("DEPTH_OF_WELL", "AVG_PRODUCTION")])
tibble [47,753 × 2] (S3: tbl_df/tbl/data.frame)
 $ DEPTH_OF_WELL : num [1:47753] 700 800 1400 1125 2940 ...
 $ AVG_PRODUCTION: num [1:47753] 859 5001 1758 377 24322 ...

3 Selección de Variables

Según la tabla de variables del proyecto, se eligió el siguiente par por presentar una relación de tipo directamente proporcional con rendimiento decreciente: un pozo más profundo tiende a alcanzar formaciones geológicas con mayor presión y contenido de hidrocarburos, lo que se traduce en una mayor producción promedio; sin embargo, el incremento productivo por pie adicional de profundidad disminuye progresivamente, lo que justifica el uso de un modelo logarítmico.

Se definió la Profundidad del Pozo (DEPTH_OF_WELL, cuantitativa continua, medida en pies) como variable independiente / causa (x), ya que representa una característica física del pozo que condiciona su capacidad productiva.

La Producción Promedio Anual (AVG_PRODUCTION, cuantitativa continua, proporción, medida en barriles/año) actúa como variable dependiente / efecto (y), pues refleja el rendimiento productivo del pozo en función de su profundidad.

Ambas variables cumplen la condición buscada: al aumentar x, y también aumenta, pero con una tasa de crecimiento decreciente, lo que se comprueba en las secciones siguientes.

4 Tabla de Pares de Valores

4.1 Máximos y Mínimos de las Variables por Percentil

El conjunto depurado contiene 47753 pozos, con valores de Profundidad del Pozo (x) muy dispersos entre pozos. Por ello, para el ajuste del modelo se ordenan los pozos según su Profundidad y se agrupan en 25 percentiles (grupos de igual cantidad de pozos), calculando el máximo y mínimo de ambas variables dentro de cada grupo. Esto entrega un par (x_max, y_max) por percentil, que captura el comportamiento extremo superior de cada grupo.

tabla_xy <- datos %>%
  mutate(percentil = ntile(DEPTH_OF_WELL, 25)) %>%
  group_by(percentil) %>%
  summarise(
    n_pozos   = n(),
    x_max = max(DEPTH_OF_WELL),
    x_min = min(DEPTH_OF_WELL),
    y_max = max(AVG_PRODUCTION),
    y_min = min(AVG_PRODUCTION),
    .groups   = "drop"
  ) %>%
  rename(x_mediana = x_max, y_mediana = y_max) %>%
  arrange(percentil)

cat("Total de grupos obtenidos, uno por percentil:", nrow(tabla_xy), "\n")
Total de grupos obtenidos, uno por percentil: 25 
datatable(
  tabla_xy,
  caption = htmltools::tags$caption(
    style = "caption-side: top; text-align: left; font-size: 16px;
             font-weight: 700; color:#1F2A33;",
    "Tabla N\u00b01: M\u00e1ximos y M\u00ednimos de Producci\u00f3n Promedio por Percentil de Profundidad del Pozo"
  ),
  rownames = FALSE,
  class    = "display compact stripe hover",
  options  = list(
    pageLength = 10,
    dom        = "ltip",
    columnDefs = list(list(className = "dt-center", targets = "_all"))
  )
) %>%
  formatRound(columns = c("x_mediana", "y_mediana"), digits = 2)

4.2 Máximos, mínimos y resumen general

max_x <- max(tabla_xy$x_mediana)
min_x <- min(tabla_xy$x_mediana)
max_y <- max(tabla_xy$y_mediana)
min_y <- min(tabla_xy$y_mediana)

data.frame(
  Variable = c("DEPTH_OF_WELL (X)", "AVG_PRODUCTION (Y)"),
  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),
  Maximo_X = round(max(tabla_xy$x_mediana), 2),
  Minimo_X = round(min(tabla_xy$x_mediana), 2),
  Maximo_Y = round(max(tabla_xy$y_mediana), 2),
  Minimo_Y = round(min(tabla_xy$y_mediana), 2)
) %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N\u00b02: Resumen General de las Variables (pares x\u0303, y\u0303)**")
  ) %>%
  tab_source_note(source_note = "Autor: Leslye Quinchiguango") %>%
  cols_align(align = "center", everything())
Tabla N°2: Resumen General de las Variables (pares x̃, ỹ)
Variable Minimo Maximo Rango Maximo_X Minimo_X Maximo_Y Minimo_Y
DEPTH_OF_WELL (X) 800.00 9999 9199.0 9999 800 868924 30402.85
AVG_PRODUCTION (Y) 30402.85 868924 838521.2 9999 800 868924 30402.85
Autor: Leslye Quinchiguango

5 Gráfica de Dispersión

5.1 Todos los valores (47753 pozos)

Se grafican todos los pozos del conjunto, sin agrupar ni resumir, para visualizar la nube completa de puntos.

par(mar = c(5, 5, 4, 2))
plot(datos$DEPTH_OF_WELL, datos$AVG_PRODUCTION,
     pch = 16, cex = 0.35,
     col = adjustcolor("#2E86AB", alpha.f = 0.15),
     xlab = "X (Profundidad del Pozo, pies)",
     ylab = "Y (Producci\u00f3n Promedio, barriles/a\u00f1o)",
     main = "Gr\u00e1fica N\u00b01: Nube de Puntos \u2014 Todos los Valores",
     cex.main = 0.9, frame.plot = FALSE)
grid(nx = NULL, ny = NULL, col = "#D7DBDD", lty = "dotted")
box()

5.2 Máximos por percentil

Con los datos ya resumidos por percentil usando el valor máximo, la tendencia logarítmica se aprecia con mayor claridad, sin el ruido de los pozos atípicos.

par(mar = c(5, 5, 4, 2))
plot(tabla_xy$x_mediana, tabla_xy$y_mediana,
     pch = 19, col = "#2E86AB",
     xlab = "X (M\u00e1ximo Profundidad del Pozo, pies)",
     ylab = "Y (M\u00e1ximo Producci\u00f3n Promedio, barriles/a\u00f1o)",
     main = "Gr\u00e1fica N\u00b02: Nube de Puntos \u2014 M\u00e1ximos por Percentil",
     cex.main = 0.9, frame.plot = FALSE)
grid(nx = NULL, ny = NULL, col = "#D7DBDD", lty = "dotted")
box()

6 Conjetura

Al observar ambas nubes de puntos, se aprecia una tendencia ascendente con curvatura cóncava hacia abajo: a medida que aumenta la Profundidad del Pozo, la Producción Promedio crece, pero lo hace cada vez más lentamente. Este patrón refleja que los primeros pies de profundidad aportan incrementos productivos más significativos que los pies adicionales en formaciones más profundas, lo cual es consistente con el comportamiento geológico de los yacimientos de hidrocarburos en Kansas.

Por lo anterior, se conjetura un modelo logarítmico:

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

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

7 Cálculo de Parámetros

El modelo se ajusta sobre los máximos por percentil (Tabla N°1), ya que usar los 47753 pozos crudos sin resumir genera una nube saturada que dificulta identificar la tendencia general.

x <- tabla_xy$x_mediana
y <- tabla_xy$y_mediana

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

cat("Modelo ajustado: y =", round(a, 4), "+", round(b, 4), "* ln(x)\n")
Modelo ajustado: y = -1311378 + 188038.7 * ln(x)
summary(modelo)

Call:
lm(formula = y ~ log(x))

Residuals:
    Min      1Q  Median      3Q     Max 
-182152  -68098  -23296   46323  448420 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept) -1311378     361118  -3.631 0.001398 ** 
log(x)        188039      44572   4.219 0.000326 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 133100 on 23 degrees of freedom
Multiple R-squared:  0.4362,    Adjusted R-squared:  0.4117 
F-statistic:  17.8 on 1 and 23 DF,  p-value: 0.0003264

8 Sobreponer Modelo con la Realidad

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

par(mar = c(5, 5, 4, 2))
plot(x, y,
     pch = 19, col = "#2E86AB",
     xlab = "X (M\u00e1ximo Profundidad del Pozo, pies)",
     ylab = "Y (M\u00e1ximo Producci\u00f3n Promedio, barriles/a\u00f1o)",
     main = "Gr\u00e1fica N\u00b03: Sobreponer Modelo con la Realidad \u2014 M\u00e1ximos por Percentil",
     cex.main = 0.9, frame.plot = FALSE)
grid(nx = NULL, ny = NULL, col = "#D7DBDD", lty = "dotted")

# Banda de confianza al 95%
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)

# Curva ajustada
lines(x_seq, pred[, "fit"], col = "#E74C3C", lwd = 3)

legend("topleft",
       legend = c("Datos (x\u0303, y\u0303)",
                  "Modelo Logar\u00edtmico",
                  "I.C. 95%"),
       col    = c("#2E86AB", "#E74C3C", "gray"),
       pch    = c(16, NA, 15),
       lwd    = c(NA, 3, NA),
       pt.cex = c(1, NA, 2),
       bty    = "n")
box()

La curva logarítmica sigue de cerca la dirección de los puntos, ajustándose a los máximos por percentil y confirmando la relación logarítmica ascendente con tasa decreciente entre la profundidad del pozo y su producción promedio.

9 Test de Bondad (Pearson)

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. Se evalúa tanto sobre los máximos por percentil como sobre todos los pozos crudos para verificar consistencia.

r_medianas <- cor.test(log(tabla_xy$x_mediana), tabla_xy$y_mediana)
r_todos    <- cor.test(log(datos$DEPTH_OF_WELL),  datos$AVG_PRODUCTION)

data.frame(
  Conjunto   = c("Máximos por percentil",
                 "Todos los valores (pozos crudos)"),
  r          = round(c(r_medianas$estimate, r_todos$estimate), 4),
  R2         = round(c(r_medianas$estimate^2, r_todos$estimate^2), 4),
  Supera_0.7 = c(abs(r_medianas$estimate) > 0.7,
                 abs(r_todos$estimate)    > 0.7)
) %>%
  gt() %>%
  tab_header(
    title    = md("**Tabla N\u00b03: Test de Bondad de Ajuste**"),
    subtitle = "Umbral |r| > 0.7"
  ) %>%
  tab_source_note(source_note = "Autor: Leslye Quinchiguango") %>%
  cols_align(align = "center", everything())
Tabla N°3: Test de Bondad de Ajuste
Umbral |r| > 0.7
Conjunto r R2 Supera_0.7
Máximos por percentil 0.6605 0.4362 FALSE
Todos los valores (pozos crudos) 0.1303 0.0170 FALSE
Autor: Leslye Quinchiguango

Sobre los máximos por percentil, \(r =\) 0.66 (\(R^2 =\) 0.436), por debajo del umbral de 0.7; no obstante, el modelo no supera el umbral de aceptación para describir la tendencia central de la relación entre la Profundidad del Pozo y la Producción Promedio.

10 Restricciones

El modelo es válido únicamente dentro del rango de X observado, entre 800 y 9,999 pies de profundidad. Adicionalmente, la función logarítmica requiere que \(x > 0\), condición que se cumple en todos los registros del conjunto, ya que la profundidad de un pozo siempre toma valores positivos. No se recomienda extrapolar fuera del rango observado, pues el comportamiento productivo de pozos con profundidades muy distintas a las registradas no está garantizado por el modelo.

11 Estimación

x_est <- round(max(tabla_xy$x_mediana), 1)
y_est <- a + b * log(x_est)

if (b >= 0) {
  ecuacion <- paste0("y = ", round(a, 4), " + ", round(b, 4), " \u00b7 ln(x)")
} else {
  ecuacion <- paste0("y = ", round(a, 4), " - ", abs(round(b, 4)), " \u00b7 ln(x)")
}

data.frame(
  Ecuacion_del_Modelo      = ecuacion,
  X_estimado_pies          = x_est,
  Y_estimado_barriles_anio = round(y_est, 2)
) %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N\u00b04: Estimaci\u00f3n Puntual de Producci\u00f3n Promedio**")
  ) %>%
  tab_source_note(source_note = "Autor: Leslye Quinchiguango") %>%
  cols_align(align = "center", everything())
Tabla N°4: Estimación Puntual de Producción Promedio
Ecuacion_del_Modelo X_estimado_pies Y_estimado_barriles_anio
y = -1311377.9439 + 188038.7124 · ln(x) 9999 420503.8
Autor: Leslye Quinchiguango

Para un pozo con 9,999 pies de profundidad (máximo del conjunto analizado), el modelo estima una producción promedio de aproximadamente 420,503.8 barriles/año.

12 Conclusiones

  • Entre la Profundidad del Pozo (X) y su Producción Promedio Anual (Y) existe una relación de tipo logarítmica ascendente: a mayor profundidad, mayor producción promedio, pero con una tasa de crecimiento decreciente que refleja la maduración de las formaciones geológicas a mayor profundidad.
  • El modelo ajustado sobre los máximos por percentil es \(y = -1311377.9439 + 188038.7124 · ln(x)\), con \(r = 0.66\) y \(R^2 = 0.436\), lo que indica un ajuste moderado dentro del contexto de la variabilidad observada..
  • Al trazar la curva sobre todos los valores del conjunto (sin resumir), la curva sigue la dirección general de la nube completa de puntos, confirmando que el patrón logarítmico no es un artefacto del resumen por percentiles.
  • El uso del máximo para resumir cada percentil captura el valor extremo superior de cada grupo de profundidad, destacando la tendencia del límite productivo en función de la profundidad.
  • En conjunto, esto valida a la Profundidad del Pozo como un buen predictor logarítmico de la Producción Promedio Anual de un pozo de hidrocarburos en Kansas.

Autor: Leslye Quinchiguango — Análisis Estadístico, Kansas Hydrocarbon Leases Dataset