library(dplyr)
library(ggplot2)
library(gt)
library(stringr)
library(plotly)
# IMPORTANTE: ajustar la ruta a la ubicación local del archivo
setwd("C:/Users/veru2/Downloads")
Datos <- read.csv("Oil__Gas____Other_Regulated_Wells__Beginning_1860 (3).csv",
header = TRUE, sep = ";", dec = ",",
fileEncoding = "latin1")
cat("Número de registros:", nrow(Datos), "\n")
## Número de registros: 47407
cat("Número de variables:", ncol(Datos), "\n")
## Número de variables: 55
Extracto del dataset
Datos %>%
slice_head(n = 5) %>%
gt() %>%
tab_header(
title = md("**Extracto del Dataset**"),
subtitle = md("Primeras 5 filas, todas las columnas del dataset original")
) %>%
tab_source_note(source_note = "Autor: Dallyanna Lozano") %>%
cols_align(align = "center", columns = everything()) %>%
tab_options(
table.border.top.color = "black",
table.border.bottom.color = "black",
table.border.top.style = "solid",
table.border.bottom.style = "solid",
column_labels.font.weight = "bold",
column_labels.border.top.color = "black",
column_labels.border.bottom.color = "black",
column_labels.border.bottom.width = px(2),
heading.border.bottom.color = "black",
heading.border.bottom.width = px(2),
table_body.hlines.color = "grey",
table_body.border.bottom.color = "black",
table.width = pct(100),
container.overflow.x = TRUE
)
| Extracto del Dataset | ||||||||||||||||||||||||||||||||||||||||||||||||||||||
| Primeras 5 filas, todas las columnas del dataset original | ||||||||||||||||||||||||||||||||||||||||||||||||||||||
| API.Well.Number | County.Code | API.Hole.Number | Sidetrack | Completion | Well.Name | Company.Name | Operator.Number | Well.Type | Map.Symbol | Well.Status | Status.Date | Permit.Application.Date | Permit.Issued.Date | Date.Spudded | Date.of.Total.Depth | Completion.Decade | Completion.Year | Completion.Month | Completion.Day | Date.Well.Plugged | Date.Well.Confidentiality.Ends | Confidentiality.Code | Town | Quad | Quad.Section | Producing.Field | Producing.Formation | Financial.Security | Slant | County | Region | State.Lease | 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 | Spacing.Acres | Integration | Hearing.Date | Date.Last.Modified | DEC.Database.Link | Location.1 | Georeference |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 31003026700000.00 | 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 | NA | 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.00 | 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 | NA | 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.00 | 3 | 4842 | 0 | 0 | Guyer Devonian #10 | Pennzoil Products Co. | 29 | NL | O | VP | Pre-1989 Well (N/A) | False | Vertical | 9 | NA | NA | NA | NA | NA | NA | 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.00 | 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 | NA | 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.00 | 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 | NA | 1800 | -77726560000000000 | 42094329999999904 | -77726560000000000 | 42094329999999904 | 1800 | 1800 | 0 | 1800 | 2260 | OD | 860 | Fulmer Valley | 760 | Exempt from Title 5 | |||||||||
| Autor: Dallyanna Lozano | ||||||||||||||||||||||||||||||||||||||||||||||||||||||
Justificación de causa y efecto:la profundidad vertical real (Y) depende principalmente de la profundidad objetivo (X1), ya que es la meta de perforación fijada en el permiso. La elevación del terreno (X2) también influye, pero de forma secundaria: si el terreno está más alto o más bajo, cambia la distancia que hay que perforar para llegar a la misma formación geológica. Juntas, X1 y X2 determinan el resultado final de la perforación (Y).
# Selección de variables, conservando los nombres ORIGINALES del dataset
# (tal como aparecen en la tabla de "Extracto del Dataset")
datos_model <- Datos %>%
select(`True.Vertical.Depth..ft`, `Proposed.Depth..ft`, `Elevation..ft`) %>%
rename(
`True Vertical Depth, ft` = `True.Vertical.Depth..ft`,
`Proposed Depth, ft` = `Proposed.Depth..ft`,
`Elevation, ft` = `Elevation..ft`
) %>%
mutate(
`True Vertical Depth, ft` = as.numeric(str_replace(`True Vertical Depth, ft`, ",", ".")),
`Proposed Depth, ft` = as.numeric(str_replace(`Proposed Depth, ft`, ",", ".")),
`Elevation, ft` = as.numeric(str_replace(`Elevation, ft`, ",", "."))
) %>%
filter(!is.na(`True Vertical Depth, ft`) & !is.na(`Proposed Depth, ft`) & !is.na(`Elevation, ft`)) %>%
filter(`True Vertical Depth, ft` > 0 & `Proposed Depth, ft` > 0 & `Elevation, ft` > 0)
# Alias matemáticos (y, x1, x2) usados en la ecuación del modelo,
# apuntando a las mismas columnas con el nombre original del dataset:
y <- datos_model$`True Vertical Depth, ft` # Y = True Vertical Depth, ft
x1 <- datos_model$`Proposed Depth, ft` # X1 = Proposed Depth, ft
x2 <- datos_model$`Elevation, ft` # X2 = Elevation, ft
cat("Tamaño muestral (tripletas completas y válidas):", nrow(datos_model), "\n")
## Tamaño muestral (tripletas completas y válidas): 13718
A diferencia de un modelo simple —donde cada X tiene asociada una Y—,
en un modelo de regresión múltiple cada tripleta de
valores está formada por dos causas y un efecto: para cada par (X₁, X₂)
existe una única Y asociada. Es decir, por cada
Proposed Depth (X₁) y cada Elevation (X₂)
registrados para un mismo pozo, existe una
True Vertical Depth (Y) que representa el resultado
observado.
tripletas <- data.frame(x1 = x1, x2 = x2, y = y) %>%
arrange(x1)
cat("Número de tripletas (X1, X2, Y):", nrow(tripletas), "\n")
## Número de tripletas (X1, X2, Y): 13718
tripletas %>%
slice_head(n = 15) %>%
rename(`Proposed Depth, ft (X1)` = x1,
`Elevation, ft (X2)` = x2,
`True Vertical Depth, ft (Y)` = y) %>%
mutate(across(everything(), ~round(.x, 2))) %>%
gt() %>%
tab_header(
title = md("**Tabla de Tripletas de Valores**"),
subtitle = md("Proposed Depth, Elevation y True Vertical Depth (muestra de 15 filas)")
) %>%
tab_source_note(source_note = "Autor: Grupo 1") %>%
cols_align(align = "center", columns = everything()) %>%
tab_options(
table.border.top.color = "black",
table.border.bottom.color = "black",
table.border.top.style = "solid",
table.border.bottom.style = "solid",
column_labels.font.weight = "bold",
column_labels.border.top.color = "black",
column_labels.border.bottom.color = "black",
column_labels.border.bottom.width = px(2),
heading.border.bottom.color = "black",
heading.border.bottom.width = px(2),
table_body.hlines.color = "grey",
table_body.border.bottom.color = "black"
)
| Tabla de Tripletas de Valores | ||
| Proposed Depth, Elevation y True Vertical Depth (muestra de 15 filas) | ||
| Proposed Depth, ft (X1) | Elevation, ft (X2) | True Vertical Depth, ft (Y) |
|---|---|---|
| 114 | 948 | 114 |
| 200 | 560 | 254 |
| 200 | 560 | 261 |
| 200 | 600 | 107 |
| 200 | 560 | 750 |
| 275 | 1680 | 2917 |
| 350 | 560 | 480 |
| 350 | 560 | 476 |
| 350 | 560 | 323 |
| 350 | 600 | 207 |
| 350 | 560 | 448 |
| 350 | 560 | 358 |
| 400 | 1257 | 401 |
| 400 | 1241 | 432 |
| 400 | 1252 | 411 |
| Autor: Grupo 1 | ||
El gráfico 3D interactivo permite rotar y ampliar la visualización para analizar la distribución y posible relación entre la profundidad objetivo, la elevación y la profundidad vertical real.
plot_ly(
x = ~x1,
y = ~x2,
z = ~y,
type = "scatter3d",
mode = "markers",
marker = list(
size = 3,
color = "#0B2F4A",
line = list(color = "black", width = 0.8),
opacity = 1
),
name = "Pozos"
) %>%
layout(
title = list(
text = "Gráfica N°1: Profundidad Vertical Real (ft) en función de la Profundidad Objetivo y la Elevación",
font = list(size = 12),
x = 0.5,
xanchor = 'center'
),
scene = list(
xaxis = list(title = list(text = "Profundidad Objetivo, ft [X1]", font = list(size = 10))),
yaxis = list(title = list(text = "Elevación, ft [X2]", font = list(size = 10))),
zaxis = list(title = list(text = "Profundidad Vertical Real, ft [Y]", font = list(size = 10))),
camera = list(eye = list(x = 1.6, y = 1.6, z = 1.2))
),
margin = list(t = 50)
)
Observando la nube de puntos en 3D, se propone un Modelo de Regresión Lineal Múltiple, ya que la profundidad vertical real parece responder de forma conjunta y aproximadamente lineal a la profundidad objetivo y a la elevación del terreno. Se plantea la ecuación del plano:
\[y = \beta_0 + \beta_1 \cdot X_1 + \beta_2 \cdot X_2\]
Explicación: lm(y ~ x1 + x2) ajusta,
por mínimos cuadrados, el plano que mejor se acerca a los puntos \((x_{1i}, x_{2i}, y_i)\).
modelo <- lm(y ~ x1 + x2)
coefs <- coef(modelo)
b0 <- coefs[1]
b1 <- coefs[2]
b2 <- coefs[3]
cat("Intercepto (b0) :", round(b0, 4), "\n")
## Intercepto (b0) : -1.8543
cat("Pendiente (b1) :", round(b1, 6), "\n")
## Pendiente (b1) : 0.972987
cat("Pendiente (b2) :", round(b2, 6), "\n")
## Pendiente (b2) : 0.027143
ecuacion <- paste0(
"y = ", round(b0, 4),
" + ", round(b1, 6), "\u00b7X1",
" + ", round(b2, 6), "\u00b7X2"
)
cat("\nEcuación estimada del modelo:\n\n", ecuacion)
##
## Ecuación estimada del modelo:
##
## y = -1.8543 + 0.972987·X1 + 0.027143·X2
Se visualiza el plano de regresión múltiple junto con los datos reales, permitiendo observar el ajuste del modelo y la relación conjunta entre la profundidad objetivo, la elevación y la profundidad vertical real.
# Crear grilla de valores
grid_x1 <- seq(min(x1), max(x1), length.out = 50) # Proposed Depth
grid_x2 <- seq(min(x2), max(x2), length.out = 50) # Elevation
# Calcular plano ajustado
z_plano <- t(outer(grid_x1, grid_x2, function(x1_val, x2_val) {
b0 + (b1 * x1_val) + (b2 * x2_val)
}))
# Gráfico interactivo
plot_ly() %>%
add_trace(
x = grid_x1,
y = grid_x2,
z = z_plano,
type = "surface",
colorscale = list(c(0, 1), c("#FDE9C8", "#D97706")),
opacity = 0.7,
name = "Plano Ajustado",
showscale = FALSE
) %>%
add_trace(
x = ~x1,
y = ~x2,
z = ~y,
type = "scatter3d",
mode = "markers",
marker = list(size = 3, color = "#0B2F4A", line = list(color = 'black', width = 0.5)),
name = "Datos Reales"
) %>%
layout(
title = list(
text = "Gráfica N°2: Plano de Regresión de la Profundidad Vertical Real (ft)",
font = list(size = 12),
x = 0.5,
xanchor = 'center'
),
scene = list(
xaxis = list(title = list(text = "Profundidad Objetivo, ft [X1]", font = list(size = 10))),
yaxis = list(title = list(text = "Elevación, ft [X2]", font = list(size = 10))),
zaxis = list(title = list(text = "Profundidad Vertical Real, ft [Y]", font = list(size = 10))),
camera = list(eye = list(x = 1.6, y = 1.6, z = 1.2))
),
margin = list(t = 50)
)
La correlación se calcula tal como se muestra a continuación, es decir, la correlación de Pearson entre la variable dependiente (Y) y la suma conjunta de las dos variables independientes (X1 + X2). A partir del resultado se obtiene el coeficiente de determinación elevándolo al cuadrado.
r <- cor(y, x1 + x2)
r <- cor(y, x1 + x2)
r2 <- (r^2) * 100
cat("Correlación de Pearson (r):", round(r, 4), "\n")
## Correlación de Pearson (r): 0.9387
cat("Coeficiente de determinación (R²%):", round(r2, 2), "%\n")
## Coeficiente de determinación (R²%): 88.11 %
El modelo es válido únicamente dentro del rango de los datos observados; su uso fuera de estos límites puede producir estimaciones poco confiables.
# Despeje de X1 y X2 a partir de la ecuación del plano, igualando Y = 0
# y = b0 + b1*X1 + b2*X2 -> 0 = b0 + b1*X1 + b2*X2
# Despejando X1 (en función de X2): X1 = -(b0 + b2*X2) / b1
x1_despejado <- function(x2_val) -(b0 + b2 * x2_val) / b1
# Despejando X2 (en función de X1): X2 = -(b0 + b1*X1) / b2
x2_despejado <- function(x1_val) -(b0 + b1 * x1_val) / b2
# Restricción física: X2 (Elevación) nunca puede ser negativa (X2 >= 0).
# Por lo tanto, el caso más exigente para garantizar Y >= 0 ocurre
# precisamente cuando X2 = 0 (la menor elevación físicamente posible).
x1_umbral <- x1_despejado(0)
# Valor de X2 a partir del cual Y >= 0 se cumple automáticamente,
# sin importar el valor de X1 (siempre que X1 >= 0).
x2_umbral <- x2_despejado(0)
cat("¿Cuándo Y es negativa?\n")
## ¿Cuándo Y es negativa?
cat("Y < 0 cuando X1 <", round(x1_umbral, 2), "- (", round(b2 / b1, 6), "* X2 )\n\n")
## Y < 0 cuando X1 < 1.91 - ( 0.027896 * X2 )
cat("Restricción de X1 (caso más exigente, con X2 = 0, ya que X2 no puede ser negativo):\n")
## Restricción de X1 (caso más exigente, con X2 = 0, ya que X2 no puede ser negativo):
cat(" X1 >=", round(x1_umbral, 2), "ft garantiza Y >= 0 para cualquier X2 >= 0\n\n")
## X1 >= 1.91 ft garantiza Y >= 0 para cualquier X2 >= 0
cat("A partir de X2 >=", round(x2_umbral, 2),
"ft, el modelo garantiza Y >= 0 para cualquier X1 >= 0\n")
## A partir de X2 >= 68.32 ft, el modelo garantiza Y >= 0 para cualquier X1 >= 0
# Verificación: ¿alguna combinación de X1 y X2 (dentro de sus rangos observados)
# produce un valor de Y fuera del rango observado de Y (fuera de su dominio)?
esquinas <- expand.grid(x1 = c(min(x1), max(x1)), x2 = c(min(x2), max(x2)))
esquinas$y_estimado <- b0 + b1 * esquinas$x1 + b2 * esquinas$x2
esquinas$fuera_de_dominio <- esquinas$y_estimado < min(y) | esquinas$y_estimado > max(y)
existe_fuera_dominio <- any(esquinas$fuera_de_dominio)
print(esquinas)
## x1 x2 y_estimado fuera_de_dominio
## 1 114 4 109.1748 FALSE
## 2 13450 4 13084.9325 TRUE
## 3 114 2911 188.0790 FALSE
## 4 13450 2911 13163.8367 TRUE
cat("\n¿Existe una combinación de X1 y X2 que genere",
"\nun valor de Y fuera de su dominio?",
ifelse(existe_fuera_dominio, " SÍ", " NO"), "\n")
##
## ¿Existe una combinación de X1 y X2 que genere
## un valor de Y fuera de su dominio? SÍ
¿Cuál es la profundidad vertical real estimada para un pozo con una profundidad objetivo de 2500 ft y una elevación de 1800 ft?
x1_test <- 2500
x2_test <- 1800
y_est <- predict(modelo,
newdata = data.frame(x1 = x1_test,
x2 = x2_test))
cat("Para una Profundidad Objetivo de", x1_test,
"ft y una Elevación de", x2_test,
"ft, la Profundidad Vertical Real estimada es:",
round(y_est, 2), "ft")
## Para una Profundidad Objetivo de 2500 ft y una Elevación de 1800 ft, la Profundidad Vertical Real estimada es: 2479.47 ft
Tabla resumen del modelo
tabla_resumen <- data.frame(
Variable = c("Profundidad Objetivo, ft", "Elevación, ft", "Profundidad Vertical Real, ft"),
Tipo = c("Independiente (X1)", "Independiente (X2)", "Dependiente (Y)"),
R_pearson = c("", "", round(r, 4)),
R2 = c("", "", round(r2, 4)),
Intercepto = c("", "", round(b0, 4)),
Beta1 = c("", "", round(b1, 6)),
Beta2 = c("", "", round(b2, 6)),
Ecuacion = c("", "", ecuacion)
)
tabla_resumen %>%
gt() %>%
tab_header(title = md("**Tabla N°2 del Resumen del Modelo de Regresión Múltiple**")) %>%
tab_source_note(source_note = "Autor: Dallyanna Lozano Grupo 1") %>%
cols_align(align = "center", columns = everything()) %>%
tab_style(
style = list(cell_fill(color = "#0B2F4A"), cell_text(color = "white", weight = "bold")),
locations = cells_column_labels()
) %>%
tab_style(
style = list(cell_fill(color = "#0B2F4A"), cell_text(color = "white", weight = "bold")),
locations = cells_title()
) %>%
opt_table_outline(style = "solid", width = px(3), color = "#0B2F4A")
| Tabla N°2 del Resumen del Modelo de Regresión Múltiple | |||||||
| Variable | Tipo | R_pearson | R2 | Intercepto | Beta1 | Beta2 | Ecuacion |
|---|---|---|---|---|---|---|---|
| Profundidad Objetivo, ft | Independiente (X1) | ||||||
| Elevación, ft | Independiente (X2) | ||||||
| Profundidad Vertical Real, ft | Dependiente (Y) | 0.9387 | 88.1097 | -1.8543 | 0.972987 | 0.027143 | y = -1.8543 + 0.972987·X1 + 0.027143·X2 |
| Autor: Dallyanna Lozano Grupo 1 | |||||||
Entre la profundidad objetivo (X₁), la elevación del terreno (X₂) y la profundidad vertical real (Y) existe una relación lineal múltiple cuya ecuación matemática es:
\[y = -1.85 + (0.972987)X_1 + (0.027143)X_2\]
Siendo X₁ la profundidad objetivo planificada, medida en pies, X₂ la elevación del terreno, medida en pies sobre el nivel del mar, y Y la profundidad vertical real alcanzada durante la perforación, medida en pies. Con una correlación de Pearson de 0.94 y un coeficiente de determinación de 88.11%, el modelo refleja qué tanto la combinación de la profundidad planificada y la elevación del terreno se relaciona con la profundidad vertical real obtenida durante la perforación.