Regresión Lineal: Producción Promedio vs. Producción Acumulada (Media)

1 Librerías

library(readr)      # lectura del csv
library(dplyr)       # manipulación de datos
library(ggplot2)      # gráficos
library(gt)          # tablas con diseño premium
library(stringr)      # manejo de texto
library(DT)           # tabla interactiva paginada
library(MASS)         # regresión lineal robusta (rlm)

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

Librerías cargadas: readr, dplyr, ggplot2, gt, stringr, DT, MASS

2 Carga de Datos

## DATASET ##
# Archivo con las variables AVG_PRODUCTION y CUMULATIVE_PRODUCTION.
nombre_archivo <- "oil_and_gas_leases_data.csv.csv"

# 1) Si el archivo existe tal cual en la carpeta de trabajo actual, se usa directamente.
if (file.exists(nombre_archivo)) {
  ruta_archivo <- nombre_archivo

# 2) Si no, se busca cualquier .csv cuyo nombre contenga "oil_and_gas" en la
#    carpeta de trabajo actual (por si el nombre real difiere un poco).
} else {
  candidatos <- list.files(pattern = "oil_and_gas.*\\.csv$", ignore.case = TRUE, full.names = TRUE)
  if (length(candidatos) >= 1) {
    ruta_archivo <- candidatos[1]

  # 3) Si sigue sin encontrarse y la sesión es interactiva (RStudio, no Knit),
  #    se abre una ventana para elegir el archivo manualmente.
  } else if (interactive()) {
    ruta_archivo <- file.choose()

  # 4) Si nada de lo anterior funcionó (p. ej. al hacer Knit sin el archivo
  #    presente), se detiene con un mensaje claro en vez de un error críptico.
  } else {
    stop(
      "No se encontro el archivo '", nombre_archivo, "' en la carpeta de trabajo actual (",
      getwd(), "). Copia el CSV a esa carpeta, o edita 'nombre_archivo' en este chunk ",
      "con la ruta completa (ej: 'C:/Users/Hp/Downloads/oil_and_gas_leases_data.csv.csv')."
    )
  }
}

cat("Archivo cargado:", ruta_archivo, "\n")

Archivo cargado: ./oil_and_gas_leases_data (1).csv 

datos <- read_csv(ruta_archivo, show_col_types = FALSE)

# Rellenamiento de celdas faltantes (NA) con la media de cada variable numérica de interés
if (any(is.na(datos$AVG_PRODUCTION))) {
  datos$AVG_PRODUCTION[is.na(datos$AVG_PRODUCTION)] <- mean(datos$AVG_PRODUCTION, na.rm = TRUE)
}
if (any(is.na(datos$CUMULATIVE_PRODUCTION))) {
  datos$CUMULATIVE_PRODUCTION[is.na(datos$CUMULATIVE_PRODUCTION)] <- mean(datos$CUMULATIVE_PRODUCTION, na.rm = TRUE)
}

# Se descartan pozos con valores no positivos (no tienen sentido físico y
# además impiden aplicar logaritmos si se necesitaran como respaldo)
datos <- datos %>%
  filter(AVG_PRODUCTION > 0, CUMULATIVE_PRODUCTION > 0)

## Estructura de los datos
str(datos[, c("AVG_PRODUCTION", "CUMULATIVE_PRODUCTION")])

tibble [47,757 × 2] (S3: tbl_df/tbl/data.frame)
 $ AVG_PRODUCTION       : num [1:47757] 859 5001 1758 377 24322 ...
 $ CUMULATIVE_PRODUCTION: num [1:47757] 47225 275063 82624 7544 681006 ...

3 Selección de Variables

Según la Tabla de Variables del proyecto, se eligió el siguiente par por ser conceptualmente directamente proporcional: un pozo con mayor producción promedio (ritmo de extracción) tiende a acumular, en total, una mayor cantidad de hidrocarburos.

Se definió la Producción Promedio Anual (AVG_PRODUCTION, cuantitativa continua, proporción, medida en barriles/año) como variable independiente / causa (x), ya que representa el ritmo al que un pozo extrae hidrocarburos.

La Producción Acumulada (CUMULATIVE_PRODUCTION, cuantitativa continua, proporción, medida en barriles) actúa como variable dependiente / efecto (y), pues refleja la cantidad total de hidrocarburos extraídos a lo largo de la vida del pozo.

Ambas variables cumplen la condición buscada: al aumentar x, y también aumenta de forma sostenida, lo que se comprueba en las secciones siguientes.

4 Tabla de Pares de Valores

4.1 Media de la variable Y por percentil de X

El dataset depurado contiene 47757 pozos, con valores de Producción Promedio (x) muy dispersos y sin repetirse exactamente entre pozos. Trabajar con los 47757 pares crudos genera una nube saturada y ruidosa (se muestra completa en la siguiente sección). Por ello, para el ajuste del modelo se ordenan los pozos según su Producción Promedio y se agrupan en 25 percentiles (grupos de igual cantidad de pozos), calculando la media de ambas variables dentro de cada grupo. Esto entrega un único par (x̄, ȳ) por percentil, que resume el comportamiento típico de los pozos de cada tramo.

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

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

Total de pares (x̄, ȳ) 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°1: Pares (x̄, ȳ) — Media de Producción Acumulada por Percentil de Producción Promedio"
  ),
  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_media", "y_media"), digits = 2)

4.2 Máximos, mínimos y resumen general

max_x <- max(tabla_xy$x_media)
min_x <- min(tabla_xy$x_media)
max_y <- max(tabla_xy$y_media)
min_y <- min(tabla_xy$y_media)

resumen_general <- data.frame(
  Variable = c("AVG_PRODUCTION (X)", "CUMULATIVE_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_media), mean(tabla_xy$y_media)), 2)
)

resumen_general %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N°2: Resumen General de las Variables (pares x̄, ȳ)**")
  ) %>%
  tab_source_note(source_note = "Autor: Valeska Araujo") %>%
  cols_align(align = "center", everything())

Tabla N°2: Resumen General de las Variables (pares x̄, ȳ)
Variable	Minimo	Maximo	Rango	Media
AVG_PRODUCTION (X)	67.14	47125.88	47058.75	6540.58
CUMULATIVE_PRODUCTION (Y)	966.50	566564.83	565598.33	144091.74
Autor: Valeska Araujo

5 Gráfica de Dispersión

5.1 Todos los valores (nube completa, 47757 pozos)

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

par(mar = c(5, 5, 4, 2))
plot(datos$AVG_PRODUCTION, datos$CUMULATIVE_PRODUCTION,
     pch = 16, cex = 0.35,
     col = adjustcolor("#2E86AB", alpha.f = 0.15),
     xlab = "X (Producción Promedio Anual)", ylab = "Y (Producción Acumulada)",
     main = "Gráfica N°1: Nube de Puntos — 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 (media), la tendencia ascendente se aprecia con mayor claridad, sin el ruido de los pares crudos.

par(mar = c(5, 5, 4, 2))
plot(tabla_xy$x_media, tabla_xy$y_media, pch = 19, col = "#2E86AB",
     xlab = "X̄ (Media Producción Promedio Anual)", ylab = "Ȳ (Media Producción Acumulada)",
     main = "Gráfica N°2: Nube de Puntos — Pares (x̄, ȳ)",
     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 y prácticamente recta: a medida que aumenta la Producción Promedio Anual, la Producción Acumulada crece de forma sostenida y proporcional en todo el rango de X, sin cambios bruscos de patrón que obliguen a segmentar el análisis por partes.

Por lo tanto, se conjetura un modelo lineal simple, directamente proporcional: \[y = a + bx\]

con pendiente \(b > 0\) (relación directamente proporcional / ascendente).

7 Cálculo de Parámetros

El modelo se ajusta sobre los pares (x̄, ȳ) por percentil (Tabla N°1). Como estos promedios pueden verse afectados por pozos con producciones extremas dentro de cada tramo, se usa regresión lineal robusta (MASS::rlm, M-estimación de Huber) en lugar de mínimos cuadrados ordinarios: esta técnica da menos peso a los puntos que se alejan del patrón general, logrando que la recta siga de cerca a la mayoría de los 25 pares, sin dejarse arrastrar por unos pocos percentiles atípicos.

modelo <- rlm(y_media ~ x_media, data = tabla_xy)
a <- coef(modelo)[1]
b <- coef(modelo)[2]
cat("Modelo ajustado (robusto): y =", round(a, 2), "+", round(b, 2), "* x\n")

Modelo ajustado (robusto): y = 7295.35 + 24.3 * x

summary(modelo)

Call: rlm(formula = y_media ~ x_media, data = tabla_xy)
Residuals:
      Min        1Q    Median        3Q       Max 
-596638.6   -8057.1    -127.3    6342.8   38409.6 

Coefficients:
            Value     Std. Error t value  
(Intercept) 7295.3520 2628.6887     2.7753
x_media       24.3015    0.2191   110.9061

Residual standard error: 11950 on 23 degrees of freedom

data.frame(
  Parametro = c("a (Intercepto)", "b (Pendiente)"),
  Valor     = round(c(a, b), 4)
) %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N°3: Parámetros del Modelo**")
  ) %>%
  tab_source_note(source_note = "Autor: Valeska Araujo") %>%
  cols_align(align = "center", everything())

Tabla N°3: Parámetros del Modelo
Parametro	Valor
a (Intercepto)	7295.3520
b (Pendiente)	24.3015
Autor: Valeska Araujo

8 Sobreponer Modelo con la Realidad

par(mar = c(5, 5, 4, 2))
plot(tabla_xy$x_media, tabla_xy$y_media, col = "#2E86AB", pch = 16,
     xlab = "X̄ (Media Producción Promedio Anual)", ylab = "Ȳ (Media Producción Acumulada)",
     main = "Gráfica N°3: Sobreponer Modelo con la Realidad — Pares (x̄, ȳ)",
     cex.main = 0.9, frame.plot = FALSE)
grid(nx = NULL, ny = NULL, col = "#D7DBDD", lty = "dotted")
abline(modelo, col = "#1F2A33", lwd = 3)
legend("topleft", legend = c("Datos (x̄, ȳ)", "Modelo Lineal"),
       col = c("#2E86AB", "#1F2A33"), pch = c(16, NA), lwd = c(NA, 3), bty = "n")
box()

La recta, ajustada con regresión robusta, sigue de cerca la dirección de la mayoría de los puntos —sin dejarse desviar por los pocos percentiles con valores más extremos— confirmando una relación lineal ascendente.

9 Test de Bondad (Pearson)

El coeficiente de correlación de Pearson, calculado mediante cor(x, y) sobre los pares (x̄, ȳ) por percentil (Tabla N°1), debe superar 0.7 (en valor absoluto) para aceptar el modelo lineal, dado que toma valores entre -1 y 1.

r_medias <- cor.test(tabla_xy$x_media, tabla_xy$y_media)

tabla_pearson <- data.frame(
  Conjunto = "Pares (x̄, ȳ) por percentil",
  r        = round(r_medias$estimate, 4),
  R2       = round(r_medias$estimate^2, 4),
  Supera_0.7 = abs(r_medias$estimate) > 0.7
)

tabla_pearson %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N°4: Test de Bondad de Ajuste**"),
    subtitle = "Umbral |r| > 0.7"
  ) %>%
  tab_source_note(source_note = "Autor: Valeska Araujo") %>%
  cols_align(align = "center", everything())

Tabla N°4: Test de Bondad de Ajuste
Umbral |r| > 0.7
Conjunto	r	R2	Supera_0.7
Pares (x̄, ȳ) por percentil	0.9029	0.8153	TRUE
Autor: Valeska Araujo

Sobre los pares (x̄, ȳ), \(r =\) 0.903 (\(R^2 =\) 0.815), muy por encima del umbral de 0.7, por lo que el modelo lineal se acepta para describir la relación entre las variables.

10 Restricciones

10.1 Dominios de las variables

data.frame(
  Variable = c("Y (CUMULATIVE_PRODUCTION)", "X (AVG_PRODUCTION)"),
  Dominio  = c("R+ : Y \u2208 (0, +\u221e)", "R+ : X \u2208 (0, +\u221e)")
) %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N°6: Dominios de las Variables**")
  ) %>%
  tab_source_note(source_note = "Autor: Valeska Araujo") %>%
  cols_align(align = "left", everything())

Tabla N°6: Dominios de las Variables
Variable	Dominio
Y (CUMULATIVE_PRODUCTION)	R+ : Y ∈ (0, +∞)
X (AVG_PRODUCTION)	R+ : X ∈ (0, +∞)
Autor: Valeska Araujo

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

El modelo no tiene restricciones, ya que al evaluar la ecuación en el valor mínimo observado de X (67 barriles/año), el resultado sigue estando dentro del dominio de Y (Y > 0):

\[Y = 7295.35 + 24.3 \times 67 = 8,926.9\]

Como este valor mínimo de X ya arroja un Y positivo, y la pendiente es positiva (\(b > 0\)), cualquier X dentro del rango observado (y mayor a este mínimo) también producirá valores de Y dentro de su dominio. Aun así, el modelo es válido únicamente dentro del rango de X observado, aproximadamente entre 67 y 47,126 barriles/año de Producción Promedio; no se recomienda extrapolar fuera de ese rango, ya que el comportamiento de pozos con ritmos de producción muy distintos a los observados no está garantizado por los datos.

11 Estimación

Ingresa un valor de Producción Promedio (X) y la calculadora estima la Producción Acumulada (Y) usando la ecuación del modelo, respetando el dominio \(X \in (0, +\infty)\). Si el valor ingresado no es válido, o si está fuera del rango de X observado en los datos (67 – 47,126), se muestra un aviso.

Calculadora: Y = a + bX

Modelo: Y = 7295.35 + 24.30 × X

X (Producción Promedio):
Calcular Y

12 Conclusiones

Entre la producción promedio (X) y la producción acumulada (Y) existe una relación lineal simple cuya ecuación matemática es:

\[Y = 7295.35 + 24.3\,X\]

Siendo X la producción promedio, medida en las unidades correspondientes de producción; y Y la producción acumulada. Con un coeficiente de correlación de 0.903, el modelo explica 81.5% de la variabilidad de Y (\(R^2\)); el resto (18.5%) es por otros factores, evidenciando una relación lineal positiva y de alta intensidad entre las variables.