1. Librerías

library(tidyverse)
library(readr)
library(knitr)
library(kableExtra)
library(ggplot2)

2. Carga de datos

Oil_Gas_Other_Regulated_Wells_Beginning_1860 <- read_delim("C:/Users/Toshiba/Desktop/C.Jennifer/Oil__Gas____Other_Regulated_Wells__Beginning_1860.csv", 
    delim = ";", escape_double = FALSE, trim_ws = TRUE)

df_raw <- Oil_Gas_Other_Regulated_Wells_Beginning_1860

# Data Set
df_head_display <- head(df_raw, 5) %>%
  mutate(across(everything(), ~ replace_na(as.character(.), "")))

df_head_display %>%
  kable(format = "html", 
        align = rep("c", ncol(df_head_display)),
        caption = "Tabla N°1: Dataset") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"), 
                full_width = FALSE, 
                position = "center") %>%
  row_spec(0, bold = TRUE, color = "white", background = "#134B70", extra_css = "text-align: center; vertical-align: middle; padding: 10px;") %>%
  column_spec(1:ncol(df_head_display), extra_css = "text-align: center; vertical-align: middle; padding: 8px;") %>%
  scroll_box(width = "100%", height = "400px") %>%
  footnote(general = "Fuente: Oil, Gas & Other Regulated Wells - NY State",
           general_title = "",
           footnote_as_chunk = TRUE)

Tabla N°1: Dataset
API Well Number	County Code	API Hole Number	Sidetrack	Completion	Well Name	Company Name	Operator Number	Well Type	Map Symbol	Well Status	Permit Application Date	Permit Issued Date	Date Spudded	Date of Total Depth	Completion Decade	Completion Year	Completion Month	Completion Day	Date Well Confidentiality Ends	Confidentiality Code	Town	Quad	Quad Section	Producing Field	Producing Formation	Financial Security	Slant	County	Region	Proposed Depth, ft	Surface Longitude	Surface Latitude	Bottom Hole Longitude	Bottom Hole Latitude	True Vertical Depth, ft	Measured Depth, ft	Kickoff, ft	Drilled Depth, ft	Elevation, ft	Original Well Type	Permit Fee	Objective Formation	Depth Fee	Spacing	Date Last Modified	DEC Database Link	Location 1	Georeference
31003026700000	3	2670	0	0	Francisco 1	Van Gilder	9279	DW	DP	PA			03/11/1953		1950s	1953	4	10		Pre-1989 Well (N/A)	Amity	Belmont	F			FALSE	Vertical	Allegany	9	0	-78019130000000000	42197130000000000	-78019130000000000	42197130000000000	2006	2006	0	2006	1815	NL	0		0		10/12/1995 0:00	http://extapps.dec.ny.gov/cfmx/extapps/GasOil/search/wells/index.cfm?api=31003026700000	(42.19713, -78.01913)	POINT (-78.01913 42.19713)
31003045990000	3	4599	0	0	Francisco 1	Christman Raymond L.	9111	OW	OW	UN										Pre-1989 Well (N/A)	Amity	Belmont	F			FALSE	Vertical	Allegany	9	0	-78026150000000000	42202210000000000	-78026150000000000	42202210000000000	0	0	0	0	1520	NL	0		0		01/24/2003 03:53:37 PM	http://extapps.dec.ny.gov/cfmx/extapps/GasOil/search/wells/index.cfm?api=31003045990000	(42.20221, -78.02615)	POINT (-78.02615 42.20221)
31003048420000	3	4842	0	0	Guyer Devonian #10	Pennzoil Products Co.	29	NL	O	VP										Pre-1989 Well (N/A)						FALSE	Vertical		9						0	0	0	0		NL	0		0		12/27/2013 03:00:05 PM	http://extapps.dec.ny.gov/cfmx/extapps/GasOil/search/wells/index.cfm?api=31003048420000
31003054190000	3	5419	0	0	Regan 2142	Iroquois Gas Corp.	16	GD	GWP	PA										Pre-1989 Well (N/A)	Alma	Wellsville South	D			FALSE	Vertical	Allegany	9	0	-77979089999999904	420702	-77979089999999904	420702	0	0	0	0	2100	NL	0		0		02/28/1995 12:00:00 AM	http://extapps.dec.ny.gov/cfmx/extapps/GasOil/search/wells/index.cfm?api=31003054190000	(42.0702, -77.97909)	POINT (-77.97909 42.0702)
31101265250000	101	26525	0	0	Edlind 25	Nathan Petroleum Corporation	2261	OD	OW	AC	08/18/2014	09/04/2014	11/25/2014	12/04/2014	2010s	2015	6	1	05/25/2015	Released	West Union	Rexville	A	Beech Hill-Independence	Fulmer Valley	TRUE	Vertical	Steuben	8	1800	-77726560000000000	42094329999999904	-77726560000000000	42094329999999904	1800	1800	0	1800	2260	OD	860	Fulmer Valley	760	Exempt from Title 5
Fuente: Oil, Gas & Other Regulated Wells - NY State

3. Selección de variables

Para este análisis de regresión lineal clásica, establecemos una relación causa-efecto teórica y geológica sólida:

Variable Independiente (\(X\) - Causa): Measured Depth, ft (Profundidad Medida a lo largo de la trayectoria del pozo, en pies).
Variable Dependiente (\(Y\) - Efecto): True Vertical Depth, ft (Profundidad Vertical Verdadera, en pies).

Justificación Teórica: En la perforación de pozos desviados o direccionales, la profundidad medida (longitud total de la sarta o trayectoria del pozo) es siempre mayor o igual a la profundidad vertical verdadera (la distancia vertical desde la superficie hasta el objetivo). Por lo tanto, un incremento en la profundidad medida del pozo impacta directamente y de manera proporcional en su profundidad vertical máxima alcanzada.

4. Tabla de pares de valores

col_x <- df_raw$`Measured Depth, ft`
col_y <- df_raw$`True Vertical Depth, ft`

df_clean <- data.frame(
  MEASURED_DEPTH = col_x,
  TRUE_DEPTH = col_y
) %>% drop_na()

n_muestral <- nrow(df_clean)

head(df_clean, 10) %>%
  mutate(across(everything(), as.character)) %>%
  kable(format = "html", 
        align = c("c", "c"),
        col.names = c("Measured Depth (ft) ", "True Vertical Depth (ft)"),
        caption = "Tabla N°2: Pares de Valores") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE, 
                position = "center") %>%
  row_spec(0, bold = TRUE, color = "white", background = "#134B70", extra_css = "text-align: center; vertical-align: middle; padding: 10px;") %>%
  column_spec(1:2, extra_css = "text-align: center; vertical-align: middle; padding: 8px;") %>%
  scroll_box(width = "100%", height = "400px") %>%
  footnote(general = "Fuente: Oil, Gas & Other Regulated Wells - NY State",
           general_title = "",
           footnote_as_chunk = TRUE)

Tabla N°2: Pares de Valores
Measured Depth (ft)	True Vertical Depth (ft)
2006	2006
0	0
0	0
0	0
1800	1800
1445	1445
2135	2135
2070	2070
927	927
685	685
Fuente: Oil, Gas & Other Regulated Wells - NY State

5. Gráfica de dispersión inicial

color_principal <- "#134B70"
color_secundario <- "#20639B"

ggplot(df_clean, aes(x = MEASURED_DEPTH, y = TRUE_DEPTH)) +
  geom_point(color = color_principal, alpha = 0.6, size = 2) +
  labs(
    title = "Gráfica N°1: Diagrama de Dispersión Inicial",
    x = "Profundidad Medida (ft)",
    y = "Profundidad Vertical Verdadera (ft)"
  ) +
  theme_minimal(base_size = 12) +
  theme(
    plot.title = element_text(face = "bold", hjust = 0.5, color = color_principal, size = 13),
    axis.title = element_text(face = "bold", color = "#333333"),
    panel.grid.major = element_line(color = "#E5E5E5"),
    panel.grid.minor = element_blank()
  )

6. Conjetura

Al observar la nube de puntos, se aprecia una tendencia ascendente y prácticamente recta: a medida que aumenta la profundidad medida del pozo (\(X\)), la profundidad vertical verdadera (\(Y\)) crece de forma sostenida y proporcional en todo el rango, 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).

6.1 Tratamiento de los datos

q1_x <- quantile(df_clean$MEASURED_DEPTH, 0.25, na.rm = TRUE)
q3_x <- quantile(df_clean$MEASURED_DEPTH, 0.75, na.rm = TRUE)
iqr_x <- q3_x - q1_x

q1_y <- quantile(df_clean$TRUE_DEPTH, 0.25, na.rm = TRUE)
q3_y <- quantile(df_clean$TRUE_DEPTH, 0.75, na.rm = TRUE)
iqr_y <- q3_y - q1_y

df_filtered <- df_clean %>%
  filter(
    MEASURED_DEPTH >= (q1_x - 1.5 * iqr_x) & MEASURED_DEPTH <= (q3_x + 1.5 * iqr_x),
    TRUE_DEPTH >= (q1_y - 1.5 * iqr_y) & TRUE_DEPTH <= (q3_y + 1.5 * iqr_y)
  )

6.2 Nueva gráfica de dispersión

ggplot(df_filtered, aes(x = MEASURED_DEPTH, y = TRUE_DEPTH)) +
  geom_point(color = color_secundario, alpha = 0.6, size = 2) +
  geom_smooth(method = "lm", color = "#E63946", se = TRUE, linewidth = 1.1) +
  labs(
    title = "Gráfica N°2: Diagrama de Dispersión Depurado y Tendencia Lineal",
    x = "Profundidad Medida (ft)",
    y = "Profundidad Vertical Verdadera (ft)"
  ) +
  theme_minimal(base_size = 12) +
  theme(
    plot.title = element_text(face = "bold", hjust = 0.5, color = color_principal, size = 13),
    axis.title = element_text(face = "bold", color = "#333333"),
    panel.grid.major = element_line(color = "#E5E5E5")
  )

6.3 Nueva conjetura

Al observar ambas nubes de puntos tras el tratamiento de los datos, se confirma la tendencia ascendente y prácticamente recta: a medida que aumenta la profundidad medida del pozo, la profundidad vertical verdadera crece de forma sostenida y proporcional en todo el rango de X, manteniendo una relación directamente proporcional con pendiente \(b > 0\), lo que valida plenamente el modelo lineal simple planteado.

7. Cálculo de parámetros

modelo_lm <- lm(TRUE_DEPTH ~ MEASURED_DEPTH, data = df_filtered)
summary_lm <- summary(modelo_lm)

a <- coef(modelo_lm)[1]
b1 <- coef(modelo_lm)[2]
r_correlacion <- cor(df_filtered$MEASURED_DEPTH, df_filtered$TRUE_DEPTH)

cat("Intercepto (a) :", a, "\n\n")

## Intercepto (a) : 2.730212

cat("Pendiente b1   :", b1, "\n\n")

## Pendiente b1   : 0.9943695

cat("Ecuación del modelo:\n\n")

## Ecuación del modelo:

cat("y =", a, "+ (", b1, ")x\n")

## y = 2.730212 + ( 0.9943695 )x

8. Realidad y modelo

ggplot(df_filtered, aes(x = MEASURED_DEPTH, y = TRUE_DEPTH)) +
  geom_point(color = color_secundario, alpha = 0.4, size = 1.5, aes(shape = "Datos reales")) +
  geom_smooth(method = "lm", formula = y ~ x, color = "#D97706", se = FALSE, linewidth = 1.2, aes(linetype = "Modelo lineal")) +
  scale_shape_manual(name = "", values = c("Datos reales" = 16)) +
  scale_linetype_manual(name = "", values = c("Modelo lineal" = "solid")) +
  labs(
    title = "Superposición: Modelo Lineal y Datos Reales",
    x = "Measured Depth, ft",
    y = "True Vertical Depth, ft"
  ) +
  theme_bw(base_size = 12) +
  theme(
    plot.title = element_text(face = "bold", hjust = 0.5, color = "#222222", size = 13),
    axis.title = element_text(face = "bold", color = "#222222"),
    legend.position = c(0.2, 0.8),
    legend.background = element_rect(fill = alpha("white", 0.8), color = NA),
    panel.grid.major = element_line(color = "#E5E5E5"),
    panel.grid.minor = element_blank()
  )

9. Test de Pearson

r_val <- cor(df_filtered$MEASURED_DEPTH, df_filtered$TRUE_DEPTH)
r2_val <- summary_lm$r.squared * 100

cat("Correlación de Pearson (r):", round(r_val, 4), "\n")

## Correlación de Pearson (r): 0.9972

cat("Coeficiente de determinación (R²%):", round(r2_val, 2), "%\n")

## Coeficiente de determinación (R²%): 99.44 %

10. Restricciones

x_umbral <- -a / b1

cat("¿Cuándo Y es negativa?\n\n")

## ¿Cuándo Y es negativa?

cat("Y < 0 cuando X <", round(x_umbral, 2), "ft\n\n")

## Y < 0 cuando X < -2.75 ft

cat("Restricción del modelo:\n")

## Restricción del modelo:

cat("X >=", round(x_umbral, 2),
    "ft garantiza que la profundidad vertical estimada sea positiva.\n\n")

## X >= -2.75 ft garantiza que la profundidad vertical estimada sea positiva.

x_min <- min(df_filtered$MEASURED_DEPTH)
x_max <- max(df_filtered$MEASURED_DEPTH)

y_min <- min(df_filtered$TRUE_DEPTH)
y_max <- max(df_filtered$TRUE_DEPTH)

extremos <- data.frame(
  X = c(x_min, x_max)
)

extremos$Y_Estimado <- predict(modelo_lm, newdata = data.frame(MEASURED_DEPTH = extremos$X))

extremos$Fuera_del_Dominio <-
  extremos$Y_Estimado < y_min |
  extremos$Y_Estimado > y_max

print(extremos)

##      X  Y_Estimado Fuera_del_Dominio
## 1    0    2.730212             FALSE
## 2 4866 4841.332175             FALSE

cat("\n¿Existe algún extremo que genere un valor fuera del dominio observado?:",
    ifelse(any(extremos$Fuera_del_Dominio), "SÍ", "NO"))

## 
## ¿Existe algún extremo que genere un valor fuera del dominio observado?: NO

Válido para:

Measured Depth (X) desde 0 ft hasta 4866 ft.

La inferencia de la muestra hacia la población de pozos se sustenta en el coeficiente de determinación (R²) obtenido dentro del rango observado de los datos. En consecuencia, las predicciones realizadas fuera de dicho intervalo constituyen extrapolaciones y pueden perder confiabilidad, ya que la relación entre la profundidad medida y la profundidad vertical verdadera podría dejar de comportarse de forma lineal.

11. Estimación (Predicciones)

nueva_medicion <- data.frame(MEASURED_DEPTH = 3000)
prediccion <- predict(modelo_lm, newdata = nueva_medicion, interval = "confidence")

pred_df <- data.frame(
  Measured_Depth_X = 3000,
  Prediccion_True_Depth_Y = prediccion[1],
  Limite_Inferior = prediccion[2],
  Limite_Superior = prediccion[3]
)

pred_df %>%
  kable(format = "html", digits = 2, align = rep("c", 4),
        col.names = c("Profundidad Medida (ft)", "Profundidad Vertical Predicha (ft)", "Límite Inferior (95%)", "Límite Superior (95%)"),
        caption = "Tabla N°6: Predicción Puntual y por Intervalos de Confianza") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE, position = "center") %>%
  row_spec(0, bold = TRUE, color = "white", background = "#134B70", extra_css = "text-align: center; vertical-align: middle; padding: 10px;") %>%
  column_spec(1:4, extra_css = "text-align: center; vertical-align: middle; padding: 8px;") %>%
  footnote(general = "Fuente: Oil, Gas & Other Regulated Wells - NY State", general_title = "", footnote_as_chunk = TRUE)

Tabla N°6: Predicción Puntual y por Intervalos de Confianza
Profundidad Medida (ft)	Profundidad Vertical Predicha (ft)	Límite Inferior (95%)	Límite Superior (95%)
3000	2985.84	2984.42	2987.26
Fuente: Oil, Gas & Other Regulated Wells - NY State

12. Conclusiones

Entre la profundidad medida (Measured Depth, X) y la profundidad vertical verdadera (True Vertical Depth, Y) existe una relación lineal simple cuya ecuación es:

\[ \hat{Y} = 2.73 + (0.994369)X \]

Con una correlación de Pearson de 1 y un coeficiente de determinación de 99.44%, el modelo evidencia una relación lineal positiva muy fuerte entre ambas variables. Esto indica que la profundidad medida explica aproximadamente el 99.44% de la variabilidad observada en la profundidad vertical verdadera, por lo que el modelo es adecuado para realizar predicciones dentro del rango de datos analizado.

Análisis de Regresión Lineal en pozos de Petróleo y Gas

Jennifer Cordones