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), un archivo separado por ; y con codificación Latin-1.

ruta_csv <- "C:/Users/PATRICIA/Desktop/pr-estadistica/Oil__Gas____Other_Regulated_Wells__Beginning_1860 (3).csv"

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

cat("Dimensiones del dataset:", nrow(Datos), "filas x", ncol(Datos), "columnas\n")

## Dimensiones del dataset: 47407 filas x 55 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, mayor tarifa, pero con crecimiento decreciente, de ahí el modelo logarítmico.

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 como "True.Vertical.Depth..ft" y "Depth.Fee")
col_tvd <- grep("True.?Vertical.?Depth", names(Datos), value = TRUE)[1]
col_fee <- grep("^Depth.?Fee$", names(Datos), value = TRUE)[1]

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) %>%
  filter(x_raw <= 27500 & y_raw <= 10900)   # rango de dominio válido de cada variable

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 = 9931 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())

TVD (ft)	Tarifa de Profundidad (USD)
Tabla N°1: Primeras filas de los pares de valores (x, y)
1800	760
1445	375
2070	625
6321	1625
1206	375
1590	375
9914	280
9674	5130
1529	950
4281	1125

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 = round(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, x > 0)   # se excluye x = 0 (ln(0) no está definido)

# 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 creciente con una tasa de crecimiento decreciente conforme aumenta el TVD, patrón compatible con un modelo logarítmico:

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

7 Cálculo de Parámetros

modelo_log <- lm(y ~ log(x))

a_bin <- coef(modelo_log)[1]
b_bin <- coef(modelo_log)[2]

if (b_bin >= 0) {
  ecuacion <- paste0("y = ",
                      round(a_bin, 4),
                      " + ",
                      round(b_bin, 4),
                      " ln(x)")
} else {
  ecuacion <- paste0("y = ",
                      round(a_bin, 4),
                      " - ",
                      abs(round(b_bin, 4)),
                      " ln(x)")
}

cat("La ecuación estimada del modelo es:\n\n", ecuacion)

## La ecuación estimada del modelo es:
## 
##  y = -8651.7475 + 1217.0977 ln(x)

r <- cor(log(x), y, use = "complete.obs")
r2 <- summary(modelo_log)$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_a = c("", round(a_bin, 4)),
  Pendiente_b = c("", round(b_bin, 4)),
  Ecuación = c("", ecuacion)
)

tabla_resumen %>%
  gt() %>%
  tab_header(title = md("**Tabla N°2: Resumen del Modelo de Regresión Logarítmica**")) %>%
  tab_source_note(source_note = "Autor: JENNY") %>%
  cols_align(align = "center", columns = everything())

Variable	Tipo	R	R2	Intercepto_a	Pendiente_b	Ecuación
Tabla N°2: Resumen del Modelo de Regresión Logarítmica
TVD (ft)	Independiente (x)
Tarifa de Profundidad (USD)	Dependiente (y)	0.93	0.87	-8651.7475	1217.0977	y = -8651.7475 + 1217.0977 ln(x)
Autor: JENNY

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 Logarítmico 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_log <- predict(modelo_log,
                     newdata = data.frame(x = x_seq),
                     interval = "confidence",
                     level = 0.95)

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

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

legend("topleft",
       legend = c("Datos promediados (binning)",
                  "Modelo Logarítmico",
                  "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 del Modelo Linealizado

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

## El coeficiente de correlación es:  0.93

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.87

10 Restricciones

El modelo presenta como única condición matemática que x > 0, lo cual se cumple naturalmente en el contexto físico del TVD (ft), por lo que no existen restricciones prácticas adicionales dentro del rango analizado.

11 Estimación

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

tvd_test <- 3000
y_est <- predict(modelo_log,
                  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 3000 ft, la Tarifa de Profundidad estimada es: 1092.784 USD

12 Conclusión

Entre el TVD (ft) y la Tarifa de Profundidad (USD) existe una relación de tipo logarítmica, con un coeficiente de determinación R² = 0.87, lo que indica un ajuste aceptable del modelo.

La ecuación estimada es: y = -8651.7475 + 1217.0977 ln(x).

El modelo presenta como única condición matemática que x > 0, lo cual se cumple naturalmente en el contexto físico del TVD (ft), por lo que no existen restricciones prácticas adicionales dentro del rango analizado.

REGRESIÓN LOGARÍTMICA

Profundidad Vertical Real en funcion. Tarifa de Profundidad

JENNIFER OYASA

2026-07-20