1 Librerías

Se cargan las librerías necesarias: dplyr y stringr para manipulación y limpieza de datos, ggplot2 para visualización y gt para la generación de tablas.

library(dplyr)
library(ggplot2)
library(gt)
library(stringr)

2 Carga de Datos

Se importa el dataset “Oil, Gas & Other Regulated Wells” (NYS DEC, desde 1860), con codificación Latin-1 y detección automática del separador (; o ,).

ruta_csv <- "C:/Users/PATRICIA/Downloads/Oil__Gas____Other_Regulated_Wells__Beginning_1860.csv"

if (!file.exists(ruta_csv)) {
  stop("No se encontró el archivo en la ruta indicada:\n  ", ruta_csv)
}

primera_linea <- readLines(ruta_csv, n = 1, encoding = "latin1", warn = FALSE)
n_punto_coma <- lengths(regmatches(primera_linea, gregexpr(";", primera_linea)))
n_coma       <- lengths(regmatches(primera_linea, gregexpr(",", primera_linea)))
sep_detectado <- if (n_punto_coma >= n_coma) ";" else ","

Datos <- read.csv(ruta_csv,
                   header = TRUE,
                   sep = sep_detectado,
                   dec = ".",
                   fileEncoding = "Latin1",
                   stringsAsFactors = FALSE,
                   check.names = FALSE)

cat("Separador detectado:", sep_detectado, "\n")
## Separador detectado: ,
cat("Dimensiones del dataset:", nrow(Datos), "filas x", ncol(Datos), "columnas\n")
## Dimensiones del dataset: 47388 filas x 52 columnas

3 Selección de Variables

El TVD (True Vertical Depth, ft) es la variable independiente (x): una magnitud física definida previamente, sin depender del costo. La Tarifa de Profundidad (Depth Fee, USD) es la variable dependiente (y), pues se cobra en función de la profundidad alcanzada. A mayor TVD, mayores costos de perforación, materiales y tiempo de operación, lo cual puede generar variaciones no lineales en la tarifa cobrada, de ahí el modelo polinómico.

  • Variable Independiente (X): TVD (ft).
  • Variable Dependiente (Y): Tarifa de Profundidad (USD).
# Localizamos las columnas de forma robusta (los nombres pueden llegar
# alterados por R según el separador y encabezado original)
buscar_columna <- function(nombres, patrones, excluir = NA_character_) {
  nombres_validos <- setdiff(nombres, excluir)
  for (p in patrones) {
    encontrado <- nombres_validos[grepl(p, nombres_validos, ignore.case = TRUE)]
    if (length(encontrado) >= 1) return(encontrado[1])
  }
  return(NA_character_)
}

col_tvd <- buscar_columna(names(Datos), c("True.?Vertical.?Depth", "TVD"))
col_fee <- buscar_columna(names(Datos), c("^Depth.?Fee$", "Depth.?Fee"), excluir = col_tvd)

if (is.na(col_tvd)) stop("ERROR: No se encontró la columna de Profundidad Vertical Real (TVD).")
if (is.na(col_fee)) stop("ERROR: No se encontró la columna de Tarifa de Profundidad (Depth Fee).")

# Selección de variables
datos_raw <- Datos %>%
  select(all_of(c(col_tvd, col_fee))) %>%
  setNames(c("tvd", "depth_fee")) %>%
  mutate(
    x_raw = abs(as.numeric(str_replace(as.character(tvd), ",", "."))),
    y_raw = abs(as.numeric(str_replace(as.character(depth_fee), ",", ".")))
  ) %>%
  filter(!is.na(x_raw) & !is.na(y_raw) & x_raw > 0 & y_raw > 0)

4 Tabla de Pares de Valores

Se indica el tamaño muestral obtenido y se muestran únicamente las primeras filas de los pares de valores (x, y).

cat("Tamaño muestral: N =", nrow(datos_raw), "pares de valores (TVD, Tarifa de Profundidad)\n")
## Tamaño muestral: N = 9928 pares de valores (TVD, Tarifa de Profundidad)
datos_raw %>%
  select(x_raw, y_raw) %>%
  head(10) %>%
  gt() %>%
  tab_header(title = md("**Tabla N°1: Primeras filas de los pares de valores (x, y)**")) %>%
  cols_label(x_raw = "TVD (ft)", y_raw = "Tarifa de Profundidad (USD)") %>%
  cols_align(align = "center", columns = everything())
Tabla N°1: Primeras filas de los pares de valores (x, y)
TVD (ft) Tarifa de Profundidad (USD)
1500 570
1501 760
4707 2090
1898 760
1494 570
4537 1710
732 380
2802 750
8799 625
2344 625

5 Gráfica de Dispersión

par(mar = c(5, 5, 4, 2))

color_trans <- rgb(0.2, 0.6, 0.86, 0.4)

plot(datos_raw$x_raw, datos_raw$y_raw,
     main = "Gráfica N°1: Diagrama de Dispersión de la Tarifa de Profundidad\nen función de la Profundidad Vertical Real (TVD)",
     xlab = "TVD (ft)",
     ylab = "Tarifa de Profundidad (USD)",
     col = color_trans,
     pch = 16,
     cex = 0.6,
     cex.main = 0.9,
     frame.plot = FALSE)

grid(nx = NULL, ny = NULL, col = "#D7DBDD", lty = "dotted")

6 Conjetura

La nube de puntos observada en la Gráfica N°1 presenta una alta variabilidad, con un comportamiento disperso y ruidoso que dificulta identificar visualmente una tendencia clara. Al tratarse de una nube compleja/caótica, se procede con el tratamiento de los datos descrito a continuación.

6.1 Tratamiento de los Datos

Para reducir el ruido y resaltar la tendencia, se segmenta x en bins de 500 ft (único x), se promedia y por bin (único y), y se omiten outliers: bins con menos de 3 datos y valores de y fuera del percentil 5%-95%.

# Agrupamiento cada 500 unidades de TVD
datos_model <- datos_raw %>%
  mutate(x_bin = floor(x_raw / 500) * 500) %>%
  group_by(x_bin) %>%
  summarise(
    y = mean(y_raw, na.rm = TRUE),
    conteo = n(),
    .groups = "drop"
  ) %>%
  rename(x = x_bin) %>%
  filter(conteo >= 3)

# Limpieza de outliers
lim_y <- quantile(datos_model$y, probs = c(0.05, 0.95))

datos_model <- datos_model %>%
  filter(y >= lim_y[1] & y <= lim_y[2])

x <- datos_model$x
y <- datos_model$y

6.2 Nueva Gráfica de Dispersión

par(mar = c(5, 5, 4, 2))

plot(x, y,
     main = "Gráfica N°2: Dispersión de la Tarifa de Profundidad promedio\npor intervalos de TVD (ft)",
     xlab = "TVD (ft)",
     ylab = "Tarifa de Profundidad promedio (USD)",
     col = "#3498DB",
     pch = 16,
     cex = 0.9,
     cex.main = 0.9,
     frame.plot = FALSE)

grid(nx = NULL, ny = NULL, col = "#D7DBDD", lty = "dotted")

6.3 Nueva Conjetura

Tras el tratamiento de los datos, la nube de puntos muestra una tendencia curvilínea, con posibles cambios de curvatura conforme aumenta el TVD, patrón compatible con un modelo polinómico de quinto grado:

\[y = \beta_0 + \beta_1 x + \beta_2 x^2 + \beta_3 x^3 + \beta_4 x^4 + \beta_5 x^5\]

7 Cálculo de Parámetros

modelo_polinomico <- lm(y ~ poly(x, 5, raw = TRUE))

coeficientes <- coef(modelo_polinomico)
b0 <- coeficientes[1]
b1 <- coeficientes[2]
b2 <- coeficientes[3]
b3 <- coeficientes[4]
b4 <- coeficientes[5]
b5 <- coeficientes[6]

formatear <- function(coef, termino) {
  if (coef >= 0) {
    paste0(" + ", round(coef, 10), termino)
  } else {
    paste0(" - ", abs(round(coef, 10)), termino)
  }
}

ecuacion <- paste0(
  "y = ", round(b0, 4),
  formatear(b1, "x"),
  formatear(b2, "x^2"),
  formatear(b3, "x^3"),
  formatear(b4, "x^4"),
  formatear(b5, "x^5")
)

cat("La ecuación estimada del modelo es:\n\n", ecuacion)
## La ecuación estimada del modelo es:
## 
##  y = 626.1258 - 0.3449530739x + 0.0003055716x^2 - 6.11e-08x^3 + 0x^4 - 0x^5
r <- cor(x, y)
r2 <- summary(modelo_polinomico)$r.squared

tabla_resumen <- data.frame(
  Variable = c("TVD (ft)", "Tarifa de Profundidad (USD)"),
  Tipo = c("Independiente (x)", "Dependiente (y)"),
  R = c("", round(r, 2)),
  R2 = c("", round(r2, 2)),
  Intercepto = c("", round(b0, 4)),
  Beta1 = c("", round(b1, 6)),
  Beta2 = c("", round(b2, 8)),
  Beta3 = c("", round(b3, 10)),
  Beta4 = c("", round(b4, 12)),
  Beta5 = c("", round(b5, 14)),
  Ecuación = c("", ecuacion)
)

tabla_resumen %>%
  gt() %>%
  tab_header(title = md("**Tabla N°2: Resumen del Modelo de Regresión Polinómica**")) %>%
  tab_source_note(source_note = "Autor: JENNIFER OYASA") %>%
  cols_align(align = "center", columns = everything())
Tabla N°2: Resumen del Modelo de Regresión Polinómica
Variable Tipo R R2 Intercepto Beta1 Beta2 Beta3 Beta4 Beta5 Ecuación
TVD (ft) Independiente (x)
Tarifa de Profundidad (USD) Dependiente (y) 0.96 0.94 626.1258 -0.344953 0.00030557 -6.11e-08 5e-12 0 y = 626.1258 - 0.3449530739x + 0.0003055716x^2 - 6.11e-08x^3 + 0x^4 - 0x^5
Autor: JENNIFER OYASA

8 Realidad y Modelo

Se presenta el ajuste del modelo sobre los datos reales (agrupados), incluyendo la banda de incertidumbre estadística (Intervalo de Confianza del 95%).

par(mar = c(5, 5, 4, 2))

plot(x, y,
     main = "Gráfica N°3: Modelo Polinómico de la Tarifa de Profundidad\nen función del TVD (ft)",
     xlab = "TVD (ft)",
     ylab = "Tarifa de Profundidad (USD)",
     col = "#3498DB",
     pch = 16,
     cex = 1.0,
     cex.main = 0.9,
     frame.plot = FALSE)

grid(nx = NULL, ny = NULL, col = "#D7DBDD", lty = "dotted")

# Secuencia suave
x_seq <- seq(min(x), max(x), length.out = 500)

pred_poli <- predict(modelo_polinomico,
                      newdata = data.frame(x = x_seq),
                      interval = "confidence",
                      level = 0.95)

# Intervalo de confianza
polygon(c(x_seq, rev(x_seq)),
        c(pred_poli[, "lwr"], rev(pred_poli[, "upr"])),
        col = rgb(0.5, 0.5, 0.5, 0.2),
        border = NA)

# Línea ajustada
lines(x_seq, pred_poli[, "fit"], col = "#E74C3C", lwd = 3)

legend("topleft",
       legend = c("Datos promediados (binning)",
                  "Modelo Polinómico (Grado 5)",
                  "I.C. 95%"),
       col = c("#3498DB", "#E74C3C", "gray"),
       pch = c(16, NA, 15),
       lwd = c(NA, 3, NA),
       pt.cex = c(1, NA, 2),
       bty = "n")

9 Test

9.1 Coeficiente de Correlación

cat("El coeficiente de correlación es: ", round(r, 2))
## El coeficiente de correlación es:  0.96

9.2 Coeficiente de Determinación

cat(paste0("El coeficiente de determinación (R²) es: ", round(r2, 2)))
## El coeficiente de determinación (R²) es: 0.94

10 Restricciones

El modelo es válido únicamente dentro del rango de TVD observado, entre 0 y 1.15^{4} ft. No se recomienda extrapolar fuera de este rango, ya que un polinomio de grado 5 puede volverse inestable fuera de la zona de ajuste.

11 Estimación

¿Cuál es la Tarifa de Profundidad estimada para un pozo con un TVD de 5000 ft?

tvd_test <- 5000
y_est <- predict(modelo_polinomico,
                  newdata = data.frame(x = tvd_test))

cat("Para un TVD de", tvd_test,
    "ft, la Tarifa de Profundidad estimada es:",
    round(y_est, 4), "USD")
## Para un TVD de 5000 ft, la Tarifa de Profundidad estimada es: 1684.888 USD

12 Conclusión

Entre el TVD (ft) y la Tarifa de Profundidad (USD) existe una relación de tipo polinómica de quinto grado, con un coeficiente de determinación R² = 0.94, lo que indica un ajuste excelente del modelo.

La ecuación estimada es: y = 626.1258 - 0.3449530739x + 0.0003055716x^2 - 6.11e-08x^3 + 0x^4 - 0x^5.

El modelo es válido únicamente dentro del rango de TVD observado (0 a 11500 ft); se recomienda revisar la magnitud de los coeficientes de mayor grado (x^4, x^5), pues si resultan prácticamente nulos, el comportamiento del fenómeno estaría mayormente explicado por los términos de menor grado.