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
if (any(is.na(datos$DEPTH_OF_WELL))) {
  datos$DEPTH_OF_WELL[is.na(datos$DEPTH_OF_WELL)] <-
    mean(datos$DEPTH_OF_WELL, na.rm = TRUE)
}
if (any(is.na(datos$AVG_PRODUCTION))) {
  datos$AVG_PRODUCTION[is.na(datos$AVG_PRODUCTION)] <-
    mean(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 Mediana de la variable Y por percentil de X

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 la media de ambas variables dentro de cada grupo para obtener una representación central de cada percentil. Esto entrega un único par (x̃, ỹ) por percentil.

tabla_xy <- datos %>%
  mutate(percentil = ntile(DEPTH_OF_WELL, 25)) %>%
  group_by(percentil) %>%
  summarise(
    n_pozos   = n(),
    x_media = mean(DEPTH_OF_WELL),
    y_media = mean(AVG_PRODUCTION),
    .groups   = "drop"
  ) %>%
  rename(x_mediana = x_media, y_mediana = y_media) %>%
  arrange(percentil)

cat("Total de pares (x\u0303, y\u0303) obtenidos, uno por percentil:", nrow(tabla_xy), "\n")

Total de pares (x̃, ỹ) 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: Pares (x\u0303, y\u0303) \u2014 Mediana 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),
  Media    = round(c(mean(tabla_xy$x_mediana),
                     mean(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())

Variable	Minimo	Maximo	Rango	Media
Tabla N°2: Resumen General de las Variables (pares x̃, ỹ)
DEPTH_OF_WELL (X)	623.35	7723.73	7100.38	3553.87
AVG_PRODUCTION (Y)	1430.15	16462.41	15032.26	6540.42
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 Pares (x̃, ỹ) por percentil

Con los datos ya resumidos por percentil, 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\u0303 (Mediana Profundidad del Pozo, pies)",
     ylab = "Y\u0303 (Mediana Producci\u00f3n Promedio, barriles/a\u00f1o)",
     main = "Gr\u00e1fica N\u00b02: Nube de Puntos \u2014 Pares (x\u0303, y\u0303)",
     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 pares (x̃, ỹ) por percentil (Tabla N°1), ya que usar los 47753 pozos crudos sin resumir le daría peso excesivo a los pozos atípicos con profundidades o producciones extremas.

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 = -14615.36 + 2637.666 * ln(x)

summary(modelo)


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

Residuals:
    Min      1Q  Median      3Q     Max 
-3856.1 -2934.9  -928.1  1811.0  8314.3 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)  
(Intercept)   -14615       9510  -1.537   0.1380  
log(x)          2638       1182   2.231   0.0357 *
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 3676 on 23 degrees of freedom
Multiple R-squared:  0.1779,    Adjusted R-squared:  0.1422 
F-statistic: 4.979 on 1 and 23 DF,  p-value: 0.0357

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\u0303 (Mediana Profundidad del Pozo, pies)",
     ylab = "Y\u0303 (Mediana Producci\u00f3n Promedio, barriles/a\u00f1o)",
     main = "Gr\u00e1fica N\u00b03: Sobreponer Modelo con la Realidad \u2014 Pares (x\u0303, y\u0303)",
     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 pares (x̃, ỹ) 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 pares (x̃, ỹ) 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("Pares (x\u0303, y\u0303) 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())

Conjunto	r	R2	Supera_0.7
Tabla N°3: Test de Bondad de Ajuste
Umbral \|r\| > 0.7
Pares (x̃, ỹ) por percentil	0.4218	0.1779	FALSE
Todos los valores (pozos crudos)	0.1303	0.0170	FALSE
Autor: Leslye Quinchiguango

Sobre los pares (x̄, ȳ), \(r =\) 0.422 (\(R^2 =\) 0.178), 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 623 y 7,724 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(mean(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())

Ecuacion_del_Modelo	X_estimado_pies	Y_estimado_barriles_anio
Tabla N°4: Estimación Puntual de Producción Promedio
y = -14615.3613 + 2637.6664 · ln(x)	3553.9	6949.67
Autor: Leslye Quinchiguango

Para un pozo con 3,553.9 pies de profundidad (media del conjunto analizado), el modelo estima una producción promedio de aproximadamente 6,949.67 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 las medias por percentil es \(y = -14615.3613 + 2637.6664 · ln(x)\), con \(r = 0.422\) y \(R^2 = 0.178\), 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 de la media para resumir cada percentil sintetiza el comportamiento central de cada grupo de profundidad, dando un ajuste representativo del conjunto.
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

Regresión Logarítmica: Producción Promedio en función de la Profundidad del Pozo

Leslye Quinchiguango

2026-07-21