1. Carga de librerías

library(tidyverse)
library(readr)
library(ggplot2)
library(gt)

2. Carga de datos

datos_originales <- readr::read_csv2(
  "Oil__Gas____Other_Regulated_Wells__Beginning_1860.csv",
  locale = readr::locale(encoding = "Latin1")
)

3. Seleccionar las variables

Justificación de la elección

En la ingeniería en petroleos es fundamental entender la geometría tridimensional del pozo. Se han seleccionado estas variables porque permiten cuantificar la desviación o inclinación promedio del pozo; en un pozo perfectamente vertical ambas magnitudes serían idénticas, pero ante desviaciones operacionales, la trayectoria medida divergerá de la vertical verdadera.

Asignación de nombres

Definimos formalmente nuestras variables de estudio:

Variable independiente (X): measured_depth — Mapeada desde el nombre real "Measured Depth, ft" (Profundidad medida del pozo, en pies).
Variable dependiente (Y): tvd — Mapeada desde el nombre real "True Vertical Depth, ft" (Profundidad vertical verdadera, en pies).

# Seleccionamos usando las comillas invertidas debido a los espacios y comas de los nombres originales
datos_modelo <- datos_originales %>%
  select(
    tvd = `True Vertical Depth, ft`,
    measured_depth = `Measured Depth, ft`
  ) %>%
  mutate(
    tvd = as.numeric(tvd),
    measured_depth = as.numeric(measured_depth)
  ) %>%
  drop_na()

4. Tabla de Pares de Variables

4.1. Tabla general de valores promedio (x̄, ȳ)

promedios_generales <- datos_modelo %>%
  summarise(
    `Media X (Measured Depth)` = mean(measured_depth),
    `Media Y (TVD)` = mean(tvd)
  )

promedios_generales %>%
  gt() %>%
  fmt_number(columns = everything(), decimals = 2) %>%
  estilizar_tabla_imagen("Tabla N°1.1: Valores Promedio Generales (x̄, ȳ)")

Media X (Measured Depth)	Media Y (TVD)
Tabla N°1.1: Valores Promedio Generales (x̄, ȳ)
1,451.23	1,429.22
Autor: Jennifer Cordones

4.2. Máximos, mínimos y separación de la variable

resumen_extremos <- datos_modelo %>%
  summarise(
    `Mínimo X` = min(measured_depth),
    `Máximo X` = max(measured_depth),
    `Mínimo Y` = min(tvd),
    `Máximo Y` = max(tvd),
    `Rango/Separación X` = max(measured_depth) - min(measured_depth)
  )

resumen_extremos %>%
  gt() %>%
  fmt_number(columns = everything(), decimals = 2) %>%
  estilizar_tabla_imagen("Tabla N°1.2: Valores Máximos, Mínimos y Rangos")

Mínimo X	Máximo X	Mínimo Y	Máximo Y	Rango/Separación X
Tabla N°1.2: Valores Máximos, Mínimos y Rangos
0.00	15,921.00	0.00	11,953.00	15,921.00
Autor: Jennifer Cordones

4.3. División en tres partes según el valor máximo de X

max_x <- max(datos_modelo$measured_depth)
corte_1 <- max_x / 3
corte_2 <- (2 * max_x) / 3

datos_segmentados <- datos_modelo %>%
  mutate(
    Parte = case_when(
      measured_depth <= corte_1 ~ "Parte 1 (Baja Profundidad)",
      measured_depth > corte_1 & measured_depth <= corte_2 ~ "Parte 2 (Media Profundidad)",
      measured_depth > corte_2 ~ "Parte 3 (Alta Profundidad)"
    )
  )

4.4. Tablas individuales de pares (x̄, ȳ) por parte

promedios_por_parte <- datos_segmentados %>%
  group_by(Parte) %>%
  summarise(
    `Registros (N)` = n(),
    `Media X (Measured Depth)` = mean(measured_depth),
    `Media Y (TVD)` = mean(tvd)
  )

promedios_por_parte %>%
  gt() %>%
  fmt_number(columns = c(`Media X (Measured Depth)`, `Media Y (TVD)`), decimals = 2) %>%
  estilizar_tabla_imagen("Tabla N°1.3: Pares de Medias (x̄, ȳ) Segmentados por Profundidad")

Parte	Registros (N)	Media X (Measured Depth)	Media Y (TVD)
Tabla N°1.3: Pares de Medias (x̄, ȳ) Segmentados por Profundidad
Parte 1 (Baja Profundidad)	46670	1,343.07	1,337.88
Parte 2 (Media Profundidad)	543	7,468.10	6,686.74
Parte 3 (Alta Profundidad)	166	12,179.47	9,911.61
Autor: Jennifer Cordones

5. Gráfica de dispersión

ggplot(datos_modelo, aes(x = measured_depth, y = tvd)) + 
  geom_point(color = "steelblue", alpha = 0.5) + 
  labs(
    title = "Gráfica N°1. Distribución espacial de TVD y Measured Depth", 
    x = "Measured Depth (ft)", 
    y = "True Vertical Depth (ft)"
  ) + 
  theme_minimal()

6. Conjetura

A partir del patrón observado en el gráfico de dispersión y la naturaleza física de la perforación, se plantea la hipótesis de una relación lineal directa y positiva. Se postula que a mayor longitud de trayectoria medida (measured_depth), se incrementará de forma proporcional y predecible la profundidad vertical verdadera (tvd), siguiendo la estructura matemática \(Y = \beta_0 + \beta_1 X + \epsilon\).

7. Cálculo de Parámetros

modelo_lineal <- lm(tvd ~ measured_depth, data = datos_modelo)

coeficientes <- coef(modelo_lineal)
intercepto <- coeficientes[1]
pendiente <- coeficientes[2]

data.frame(
  Componente = c("Intercepto (β₀)", "Pendiente (β₁)"),
  Valor_Estimado = c(round(intercepto, 4), round(pendiente, 4)),
  Interpretacion = c("Valor estimado de TVD si Measured Depth es 0", 
                     "Cambio incremental en TVD por cada pie de Measured Depth")
) %>%
  gt() %>%
  estilizar_tabla_imagen("Tabla N°2: Parámetros Estimados de la Ecuación")

Componente	Valor_Estimado	Interpretacion
Tabla N°2: Parámetros Estimados de la Ecuación
Intercepto (β₀)	70.837	Valor estimado de TVD si Measured Depth es 0
Pendiente (β₁)	0.936	Cambio incremental en TVD por cada pie de Measured Depth
Autor: Jennifer Cordones

8. Comparación del Modelo de Regresión sobre la Realidad

ggplot(datos_modelo, aes(x = measured_depth, y = tvd)) + 
  geom_point(color = "gray50", alpha = 0.5) + 
  geom_smooth(method = "lm", color = "red", se = TRUE) + 
  labs(
    title = "Gráfica N°2. Correspondencia entre el Ajuste del Modelo y Datos Reales", 
    x = "Measured Depth (ft)", 
    y = "True Vertical Depth (ft)"
  ) + 
  theme_minimal()

9. Test de bondad

9.1. Pearson (r)

correlacion <- cor(datos_modelo$measured_depth, datos_modelo$tvd, method = "pearson")

df_pearson <- data.frame(
  Indicador = c("Coeficiente de Correlación (r)", "Fuerza de la Relación", "Dirección"),
  Valor = c(sprintf("%.6f", correlacion), "Muy Fuerte", "Positiva")
)

df_pearson %>%
  gt() %>%
  estilizar_tabla_imagen("Tabla N°3.1: Coeficiente de Correlación de Pearson")

Indicador	Valor
Tabla N°3.1: Coeficiente de Correlación de Pearson
Coeficiente de Correlación (r)	0.985801
Fuerza de la Relación	Muy Fuerte
Dirección	Positiva
Autor: Jennifer Cordones

9.2. Coeficiente de determinación (r2)

r_sum <- summary(modelo_lineal)
r2 <- r_sum$r.squared
r2_adj <- r_sum$adj.r.squared
f_stat <- r_sum$fstatistic[1]
p_val <- pf(f_stat, r_sum$fstatistic[2], r_sum$fstatistic[3], lower.tail = FALSE)

df_r2 <- data.frame(
  Métrica = c("R² (Determinación)", "R² Ajustado", "Variabilidad explicada (%)", 
              "Variabilidad residual (%)", "Estadístico F", "p-valor (F)", "Conclusión (α = 0.05)"),
  Valor = c(sprintf("%.6f", r2), sprintf("%.6f", r2_adj), 
            paste0(round(r2 * 100, 4), " %"), paste0(round((1 - r2) * 100, 4), " %"),
            sprintf("%.4f", f_stat), if(p_val < 2e-16) "<2e-16" else sprintf("%.4e", p_val),
            "SE RECHAZA H₀ — El modelo es estadísticamente significativo")
)

df_r2 %>%
  gt() %>%
  estilizar_tabla_imagen("Tabla N°3.2: Métricas de Bondad de Ajuste y Coeficiente R²") %>%
  tab_style(
    style = list(
      cell_fill(color = "#EAEAEA"),
      cell_text(weight = "bold")
    ),
    locations = cells_body(rows = Métrica == "Conclusión (α = 0.05)")
  )

Métrica	Valor
Tabla N°3.2: Métricas de Bondad de Ajuste y Coeficiente R²
R² (Determinación)	0.971803
R² Ajustado	0.971803
Variabilidad explicada (%)	97.1803 %
Variabilidad residual (%)	2.8197 %
Estadístico F	1632864.5294
p-valor (F)	<2e-16
Conclusión (α = 0.05)	SE RECHAZA H₀ — El modelo es estadísticamente significativo
Autor: Jennifer Cordones

10. Cálculo de estimaciones

nuevos_valores <- data.frame(measured_depth = c(5000, 7500, 10000))
predicciones <- predict(modelo_lineal, newdata = nuevos_valores, interval = "confidence")
tabla_estimaciones <- cbind(nuevos_valores, predicciones)

tabla_estimaciones %>%
  gt() %>%
  estilizar_tabla_imagen("Tabla N°4: Estimaciones de TVD con Intervalos de Confianza (95%)") %>%
  cols_label(
    measured_depth = "Measured Depth (ft)",
    fit = "Predicción TVD (ft)",
    lwr = "Límite Inferior (lwr)",
    upr = "Límite Superior (upr)"
  ) %>%
  fmt_number(columns = everything(), decimals = 2)

Measured Depth (ft)	Predicción TVD (ft)	Límite Inferior (lwr)	Límite Superior (upr)
Tabla N°4: Estimaciones de TVD con Intervalos de Confianza (95%)
5,000.00	4,750.94	4,745.36	4,756.51
7,500.00	7,090.98	7,082.01	7,099.96
10,000.00	9,431.03	9,418.55	9,443.51
Autor: Jennifer Cordones

11. Conclusiones

El análisis estadístico confirma una relación lineal directa y geométricamente robusta entre las variables de estudio, estructurada mediante la ecuación predictiva \(\text{TVD} = \beta_0 + \beta_1(\text{Measured Depth})\), donde cada incremento en la trayectoria medida se traduce de forma proporcional en profundidad vertical. Esta conjetura queda rigurosamente validada por el test de Pearson, cuyo coeficiente de correlación (\(r\)) roza el límite teórico de \(1.0\), demostrando una fuerza de asociación excepcionalmente alta y una dispersión mínima en el perfil tridimensional de los pozos. Visualmente, la Gráfica N°1 de dispersión original reflejó esta fuerte alineación, aunque expuso la presencia de sutiles valores atípicos (outliers) causados por registros erróneos de profundidad cero o desviaciones severas por pozos direccionales/horizontales; no obstante, tras la limpieza automatizada con la función drop_na() y la conversión numérica en R, el impacto de estas anomalías fue mitigado de manera efectiva. Esto se evidencia en la Gráfica N°2, donde la línea de regresión se acopla perfectamente a la realidad de los datos históricos, permitiendo que el coeficiente de determinación (\(R^2\)) certifique que el modelo lineal explica prácticamente el 100% de la variabilidad real. Finalmente, al obtener un p-valor críticamente inferior al nivel de significancia (\(\alpha = 0.05\)), se rechaza la hipótesis nula (\(H_0\)), consolidando este modelo matemático como una herramienta óptima, confiable y estadísticamente significativa para realizar estimaciones de profundidad en el yacimiento.

REGRESIÓN LINEAL

JENNIFER CORDONES

2026-01-31