1 Librerías

library(dplyr)
library(gt)

2 Carga de datos

# NOTA: el archivo CSV debe estar en la misma carpeta que este .Rmd
# (por defecto, al hacer Knit, R usa esa carpeta como directorio de trabajo)

lineas <- readLines("Oil__Gas____Other_Regulated_Wells__Beginning_1860 (1).csv",
                     encoding = "latin1", warn = FALSE)
Encoding(lineas) <- "latin1"
lineas <- iconv(lineas, from = "latin1", to = "UTF-8")

datos <- read.csv(text = lineas, sep = ",", header = TRUE,
                   stringsAsFactors = FALSE)

cat("Número de registros:", nrow(datos), "\n")
## Número de registros: 47396
cat("Número de variables:", ncol(datos), "\n")
## Número de variables: 52

Extracto del dataset

datos %>%
  head(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: Grupo 1") %>%
  cols_align(align = "center", columns = everything()) %>%
  tab_style(
    style     = list(cell_fill(color = col_encabezado), cell_text(color = "white", weight = "bold")),
    locations = cells_title()
  ) %>%
  tab_style(
    style     = list(cell_fill(color = col_encabezado), cell_text(color = "white", weight = "bold")),
    locations = cells_column_labels()
  ) %>%
  tab_style(
    style     = list(cell_fill(color = col_fila_alt)),
    locations = cells_body(rows = seq(1, 5, 2))
  ) %>%
  tab_style(
    style = cell_borders(sides = "all", color = col_borde, weight = px(1)),
    locations = list(cells_body(), cells_column_labels())
  ) %>%
  opt_table_outline(style = "solid", width = px(3), color = col_borde) %>%
  tab_options(
    table.border.top.color            = col_borde,
    table.border.bottom.color         = col_borde,
    table.border.top.style            = "solid",
    table.border.bottom.style         = "solid",
    column_labels.border.top.color    = col_borde,
    column_labels.border.bottom.color = col_borde,
    column_labels.border.bottom.width = px(2),
    heading.border.bottom.color       = col_borde,
    heading.border.bottom.width       = px(2),
    table.font.size                   = px(12),
    data_row.padding                  = px(6),
    column_labels.background.color    = col_encabezado,
    container.overflow.x              = TRUE,
    table.width                       = pct(100)
  )
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 Date.Well.Completed 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
31003670100000 3 67010 0 0 Voided Permit 9998 NL O VP Pre-1989 Well (N/A) False Vertical Statewide 9 NA 0 NA NA NA NA 0 0 0 0 NA NL 0 0 NA 06/28/1995 12:00:00 AM http://extapps.dec.ny.gov/cfmx/extapps/GasOil/search/wells/index.cfm?api=31003670100000
31003672540000 3 67254 0 0 Voided Permit 9998 NL O VP Pre-1989 Well (N/A) A False Vertical Statewide 9 NA 0 NA NA NA NA 0 0 0 0 NA NL 0 0 NA 07/05/1995 12:00:00 AM http://extapps.dec.ny.gov/cfmx/extapps/GasOil/search/wells/index.cfm?api=31003672540000
31003673010000 3 67301 0 0 9998 NL O UN Pre-1989 Well (N/A) False Vertical Statewide 9 NA 0 NA NA NA NA 0 0 0 0 NA NL 0 0 NA 12/20/2019 03:27:41 PM http://extapps.dec.ny.gov/cfmx/extapps/GasOil/search/wells/index.cfm?api=31003673010000
31003686440000 3 68644 0 0 Voided Permit 9998 NL O VP Pre-1989 Well (N/A) A False Vertical Statewide 9 NA 0 NA NA NA NA 0 0 0 0 NA NL 0 0 NA 08/15/1995 12:00:00 AM http://extapps.dec.ny.gov/cfmx/extapps/GasOil/search/wells/index.cfm?api=31003686440000
31003694660000 3 69466 0 0 Bradford 48 Bradley Producing Company 9673 OD OWP PA Pre-1989 Well (N/A) Clarksville Bolivar B False Vertical Allegany 9 NA 0 -78.19359 42.08821 -78.19359 42.08821 0 0 0 0 NA NL 0 0 NA 03/01/2000 12:00:00 AM http://extapps.dec.ny.gov/cfmx/extapps/GasOil/search/wells/index.cfm?api=31003694660000 (42.08821, -78.19359) POINT (-78.19359 42.08821)
Autor: Grupo 1

3 Selección de variables

  • Variable independiente (X): Proposed Depth, ft (profundidad propuesta en el permiso).
  • Variable dependiente (Y): Measured Depth, ft (profundidad medida real del pozo).

Justificación causa-efecto:La profundidad propuesta (Proposed Depth) corresponde a la profundidad planificada en el permiso de perforación, mientras que la profundidad medida (Measured Depth) es la alcanzada al finalizar el pozo. Dado que la profundidad propuesta orienta la planificación técnica de la perforación, influye directamente en la profundidad final obtenida, estableciendo una relación de causa (X) → efecto (Y). pozo.

# Detección automática de columnas (los nombres pueden variar entre el CSV
# de muestra y el CSV local: puntos extra, mayúsculas/minúsculas, etc.)
col_x <- names(datos)[grepl("proposed", names(datos), ignore.case = TRUE) &
                       grepl("depth",    names(datos), ignore.case = TRUE)][1]
col_y <- names(datos)[grepl("measured", names(datos), ignore.case = TRUE) &
                       grepl("depth",    names(datos), ignore.case = TRUE)][1]

if (is.na(col_x) || is.na(col_y)) {
  stop("No se encontraron las columnas de Proposed Depth / Measured Depth. ",
       "Nombres disponibles: ", paste(names(datos), collapse = ", "))
}

x_raw <- suppressWarnings(as.numeric(as.character(datos[[col_x]])))
y_raw <- suppressWarnings(as.numeric(as.character(datos[[col_y]])))

cat("Registros con Proposed Depth:", sum(!is.na(x_raw) & x_raw > 0), "\n")
## Registros con Proposed Depth: 16507
cat("Registros con Measured Depth:", sum(!is.na(y_raw) & y_raw > 0), "\n")
## Registros con Measured Depth: 32765

4 Tabla de pares de valores

Se conservan únicamente los pares donde ambas variables son mayores que 0, ya que un valor de 0 o vacío significa que ese pozo no llegó a esa etapa (por ejemplo, tiene permiso pero nunca se perforó, o se perforó pero no se registró la profundidad propuesta).

df_raw <- data.frame(x = x_raw, y = y_raw) %>%
  filter(!is.na(x), !is.na(y), x > 0, y > 0)

cat("Tamaño muestral (pares completos, Proposed Depth > 0 y Measured Depth > 0):",
    nrow(df_raw), "\n")
## Tamaño muestral (pares completos, Proposed Depth > 0 y Measured Depth > 0): 14047

Nota: no se despliega la tabla completa; a continuación solo se muestran las primeras filas.

head(df_raw, 10) %>%
  rename(`Proposed Depth, ft (X)` = x,
         `Measured Depth, ft (Y)` = y) %>%
  gt() %>%
  tab_header(
    title    = md("**Tabla de Pares de Valores (primeras filas)**"),
    subtitle = md("Proposed Depth y Measured Depth")
  ) %>%
  tab_source_note(source_note = "Autor: Grupo 1") %>%
  cols_align(align = "center", columns = everything()) %>%
  tab_style(
    style     = list(cell_fill(color = col_encabezado), cell_text(color = "white", weight = "bold")),
    locations = cells_title()
  ) %>%
  tab_style(
    style     = list(cell_fill(color = col_encabezado), cell_text(color = "white", weight = "bold")),
    locations = cells_column_labels()
  ) %>%
  tab_style(
    style     = list(cell_fill(color = col_fila_alt)),
    locations = cells_body(rows = seq(1, 10, 2))
  ) %>%
  opt_table_outline(style = "solid", width = px(3), color = col_borde) %>%
  tab_options(
    table.border.top.color            = col_borde,
    table.border.bottom.color         = col_borde,
    table.border.top.style            = "solid",
    table.border.bottom.style         = "solid",
    column_labels.border.top.color    = col_borde,
    column_labels.border.bottom.color = col_borde,
    column_labels.border.bottom.width = px(2),
    heading.border.bottom.color       = col_borde,
    heading.border.bottom.width       = px(2),
    table_body.hlines.color           = "#CBD5DE",
    table_body.border.bottom.color    = col_borde,
    table.font.size                   = px(14),
    data_row.padding                  = px(6),
    table_body.border.top.style       = "solid",
    column_labels.background.color    = col_encabezado
  )
Tabla de Pares de Valores (primeras filas)
Proposed Depth y Measured Depth
Proposed Depth, ft (X) Measured Depth, ft (Y)
1465 1465
1400 1400
700 1000
1250 1220
2300 2352
1300 1400
2300 2136
1500 1332
3600 3906
1950 1898
Autor: Grupo 1

5 Gráfica de dispersión

plot(df_raw$x, df_raw$y,
     pch  = 20,
     col  = rgb(0.04, 0.18, 0.29, 0.15),
     xlab = "Proposed Depth, ft (X)",
     ylab = "Measured Depth, ft (Y)",
     main = "Gráfica original: Proposed Depth en comparación con Measured Depth")

6 Conjetura del modelo exponencial

La nube de puntos muestra una tendencia creciente que sugiere una relación exponencial entre la profundidad propuesta (X) y la profundidad medida (Y). Debido a la dispersión y la presencia de valores atípicos, se realiza un tratamiento previo de los datos para mejorar el ajuste del modelo.

6.1 Tratamiento de los datos

a) Único X (agrupación por valor exacto de X): Cuando varios registros presentan el mismo valor de Proposed Depth (X), se calcula la media de Measured Depth (Y) para obtener un único par representativo. Este procedimiento agrupa únicamente valores idénticos de X, sin crear intervalos artificiales.

b) Único Y: No aplica, ya que el análisis considera a Measured Depth (Y) como variable dependiente de Proposed Depth (X), por lo que no es necesario agrupar por valores de Y.

c) Segmentar por partes: No aplica, porque los datos no presentan cambios de comportamiento que justifiquen dividir el rango de Proposed Depth (X) en segmentos para realizar ajustes independientes.

# c) Omisión de outliers — filtro de coherencia física
df_raw <- df_raw %>% mutate(razon = y / x)

n_antes <- nrow(df_raw)
df_raw  <- df_raw %>% filter(razon > 0.5, razon < 2) %>% select(-razon)
n_despues <- nrow(df_raw)

cat("Pares antes del filtro de coherencia física:", n_antes, "\n")
## Pares antes del filtro de coherencia física: 14047
cat("Pares tras el filtro de coherencia física:", n_despues, "\n")
## Pares tras el filtro de coherencia física: 13893
cat("Descartados por razón no física (outliers):", n_antes - n_despues, "\n\n")
## Descartados por razón no física (outliers): 154
# a) Único X — agrupación por valor exacto de X (media de Y repetidos)
pares <- df_raw %>%
  group_by(x) %>%
  summarise(y = mean(y, na.rm = TRUE), .groups = "drop") %>%
  arrange(x)

cat("Pares únicos para el modelo (tras agrupar por X):", nrow(pares), "\n")
## Pares únicos para el modelo (tras agrupar por X): 2360

6.2 Nueva gráfica de dispersión

plot(pares$x, pares$y,
     pch  = 20,
     col  = rgb(0.04, 0.18, 0.29, 0.35),
     xlab = "Proposed Depth, ft (X)",
     ylab = "Measured Depth, ft (Y)",
     main = "Gráfica tras tratamiento")

6.3 Nueva conjetura

Tras el tratamiento, la nube de puntos conserva la misma forma genera. Se confirma visualmente la tendencia de crecimiento acelerado propia de una relación exponencial, por lo que se mantiene la conjetura:

\[y = a \cdot e^{bx}\]

Estrategia de ajuste — reducción del eje Y con logaritmo: el modelo exponencial no es lineal en sus parámetros, por lo que se linealiza aplicando logaritmo natural a Y:

\[\ln(y) = \ln(a) + bx\]

Esta es una recta en las variables \((x, \ln y)\): intercepto \(\ln(a)\), pendiente \(b\). El eje Y se reduce a \(\ln(y)\) antes de ajustar el modelo con lm(); luego se recupera \(a\) con exp().

pares$log_y <- log(pares$y)

plot(pares$x, pares$log_y,
     pch  = 20,
     col  = rgb(0.04, 0.18, 0.29, 0.35),
     xlab = "Proposed Depth, ft (X)",
     ylab = "ln(Measured Depth, ft)  —  eje Y reducido",
     main = "Linealización: ln(Y) en comparación con X")

7 Cálculo de parámetros

m_exp   <- lm(log_y ~ x, data = pares)
sum_reg <- summary(m_exp)
coefs      <- coef(m_exp)
intercepto <- coefs[1]
pendiente  <- coefs[2]

a <- exp(intercepto)
b <- pendiente

cat("Intercepto en espacio log [ln(a)] :", round(intercepto, 6), "\n")
## Intercepto en espacio log [ln(a)] : 7.024228
cat("Pendiente (b)                     :", round(b, 8), "\n")
## Pendiente (b)                     : 0.00026612
cat("Parámetro a = exp(intercepto)     :", round(a, 4), "\n")
## Parámetro a = exp(intercepto)     : 1123.527
cat("\nEcuación del modelo exponencial:\n")
## 
## Ecuación del modelo exponencial:
cat("y =", round(a, 4), "* e^(", round(b, 8), "x )\n")
## y = 1123.527 * e^( 0.00026612 x )

8 Comparación del Modelo con la Realidad

x_grid     <- seq(min(pares$x), max(pares$x), length.out = 400)
log_y_grid <- predict(m_exp, newdata = data.frame(x = x_grid))
y_grid     <- exp(log_y_grid)

plot(pares$x, pares$y,
     pch  = 20,
     col  = rgb(0.04, 0.18, 0.29, 0.15),
     xlab = "Proposed Depth, ft (X)",
     ylab = "Measured Depth, ft (Y)",
     main = "Superposición: Modelo Exponencial y Datos Reales")

lines(x_grid, y_grid, col = col_curva, lwd = 3)

legend("topleft",
       legend = c("Datos reales", "Modelo exponencial"),
       col    = c(col_puntos, col_curva),
       pch    = c(20, NA),
       lty    = c(NA, 1),
       lwd    = c(NA, 3),
       bty    = "n")

La curva del modelo sigue de cerca la tendencia central de la nube de puntos real, lo que respalda visualmente la elección del modelo exponencial.

9 Test de Pearson

Explicación: como el modelo se ajustó linealizado (sobre \(\ln y\)), el test de Pearson correcto para este modelo se calcula entre X y \(\ln(Y)\), que es donde la relación es realmente lineal.

r  <- cor(pares$x, pares$log_y)
r2 <- sum_reg$r.squared * 100

cat("Correlación de Pearson (r), entre X y ln(Y):", round(r, 4), "\n")
## Correlación de Pearson (r), entre X y ln(Y): 0.9093
cat("Coeficiente de determinación (R²%):", round(r2, 2), "%\n")
## Coeficiente de determinación (R²%): 82.69 %

El coeficiente de determinación (R²) indica qué porcentaje de la variación en \(\ln(\text{Measured Depth})\) es explicado por Proposed Depth.

10 Restricciones

El modelo exponencial estimado es válido únicamente bajo las siguientes restricciones:

  • El modelo solo es válido para valores de Proposed Depth (X) dentro de su dominio, comprendido entre 56 ft y 13 450 ft. Fuera de este intervalo las predicciones corresponden a una extrapolación y pierden confiabilidad. Además, el modelo requiere que X > 0 y no considera otros factores, como las condiciones geológicas, que también pueden influir en la profundidad medida.

11 Estimaciones

x_estimar1  <- round(min(pares$x), 2)
y_estimada1 <- exp(predict(m_exp, newdata = data.frame(x = x_estimar1)))
cat("Estimación para X =", x_estimar1, "ft:\n")
## Estimación para X = 56 ft:
cat("Measured Depth estimado:", round(y_estimada1, 2), "ft\n\n")
## Measured Depth estimado: 1140.4 ft
x_estimar2  <- round(max(pares$x), 2)
y_estimada2 <- exp(predict(m_exp, newdata = data.frame(x = x_estimar2)))
cat("Estimación para X =", x_estimar2, "ft:\n")
## Estimación para X = 13450 ft:
cat("Measured Depth estimado:", round(y_estimada2, 2), "ft\n\n")
## Measured Depth estimado: 40274.72 ft
# Ejemplo puntual solicitado en el documento de referencia
x_estimar3  <- 1500
y_estimada3 <- exp(predict(m_exp, newdata = data.frame(x = x_estimar3)))
cat("Estimación para X =", x_estimar3, "ft:\n")
## Estimación para X = 1500 ft:
cat("Measured Depth estimado:", round(y_estimada3, 2), "ft\n")
## Measured Depth estimado: 1674.72 ft
Ecuacion <- paste0("y = ", round(a, 4), " * e^(", round(b, 8), " x )")

Tabla_resumen <- data.frame(
  `Variable Independiente`       = "Proposed Depth, ft",
  `Variable Dependiente`         = "Measured Depth, ft",
  `Test Pearson (X en comparación con ln Y)`     = round(r, 4),
  `Coeficiente de determinación` = round(r2, 2),
  `Ecuación del modelo`          = Ecuacion,
  check.names = FALSE
)

Tabla_resumen %>%
  gt() %>%
  tab_header(
    title    = md("**Tabla N°1**"),
    subtitle = md("**Resumen del modelo de regresión exponencial**")
  ) %>%
  tab_source_note(source_note = md("Autor: Grupo 1")) %>%
  cols_align(align = "center", columns = everything()) %>%
  tab_style(
    style     = list(cell_fill(color = col_encabezado), cell_text(color = "white", weight = "bold")),
    locations = cells_title()
  ) %>%
  tab_style(
    style     = list(cell_fill(color = col_encabezado), cell_text(color = "white", weight = "bold")),
    locations = cells_column_labels()
  ) %>%
  tab_style(
    style     = list(cell_fill(color = col_fila_alt)),
    locations = cells_body(rows = 1)
  ) %>%
  opt_table_outline(style = "solid", width = px(3), color = col_borde) %>%
  tab_options(
    table.border.top.color            = col_borde,
    table.border.bottom.color         = col_borde,
    table.border.top.style            = "solid",
    table.border.bottom.style         = "solid",
    column_labels.border.top.color    = col_borde,
    column_labels.border.bottom.color = col_borde,
    column_labels.border.bottom.width = px(2),
    heading.border.bottom.color       = col_borde,
    heading.border.bottom.width       = px(2),
    table_body.hlines.color           = "#CBD5DE",
    table_body.border.bottom.color    = col_borde,
    table.font.size                   = px(14),
    data_row.padding                  = px(6)
  )
Tabla N°1
Resumen del modelo de regresión exponencial
Variable Independiente Variable Dependiente Test Pearson (X en comparación con ln Y) Coeficiente de determinación Ecuación del modelo
Proposed Depth, ft Measured Depth, ft 0.9093 82.69 y = 1123.5266 * e^(0.00026612 x )
Autor: Grupo 1

12 Conclusión

Entre la profundidad propuesta (Proposed Depth, X) y la profundidad medida (Measured Depth, Y) existe una relación exponencial, ajustada mediante linealización logarítmica, cuya ecuación es:

\[y = 1123.5266 \cdot e^{0.0002661 \, x}\]

Con una correlación de Pearson (entre X y \(\ln Y\)) de 0.91 y un coeficiente de determinación de 82.69%, el modelo respalda la hipótesis de que la profundidad real alcanzada durante la perforación crece de forma multiplicativa —no aditiva— respecto de la profundidad planificada en el permiso: mientras más profundo se planea perforar, mayor es, proporcionalmente, la profundidad extra que termina alcanzándose en la práctica. El modelo debe interpretarse dentro de las restricciones señaladas en la Sección 10, especialmente el rango de validez de X.