Se usa la misma pareja de variables del modelo exponencial, pero analizada ahora con un enfoque polinómico (sin linealizar), para comparar ambos enfoques sobre el mismo fenómeno.

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

1 Carga de librerías

library(dplyr)
library(gt)

2 Carga de datos

Misma advertencia que en el documento exponencial: el archivo real contiene, en la fila 1173, una celda con el texto #¡VALOR! (error de fórmula de Excel). Cargar el archivo con read.csv(..., fileEncoding = "latin1") directo hace que R se detenga silenciosamente ahí y solo cargue 1173 de los 47.407 registros, sin ningún error visible. Por eso se usa readLines() + iconv() antes de read.csv(text = ...), para garantizar que se cargue el archivo completo.

# IMPORTANTE: ajustar la ruta a la ubicación local del archivo
setwd("C:/Users/ASUS/Desktop/dally")

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: 47407

cat("Número de variables:", ncol(datos), "\n")

## Número de variables: 55

3 Selección de variables

x_raw <- suppressWarnings(as.numeric(as.character(datos$Proposed.Depth..ft)))
y_raw <- suppressWarnings(as.numeric(as.character(datos$Measured.Depth..ft)))

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

## Registros con Proposed Depth: 16493

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

## Registros con Measured Depth: 32753

4 Tabla de pares de valores

4.1 Paso 1 — Pares completos

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

cat("Pares completos (Proposed Depth > 0 y Measured Depth > 0):", nrow(df_raw), "\n")

## Pares completos (Proposed Depth > 0 y Measured Depth > 0): 14037

4.2 Paso 2 — Filtro de coherencia física

Explicación: se descartan los pozos donde Measured Depth / Proposed Depth es menor a 0.5 o mayor a 2, por ser casi con certeza errores de digitación (un dígito de más o de menos) y no variación técnica real. Esto explica por qué la tabla final conserva menos filas que el total de pares completos.

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:", n_antes, "\n")

## Pares antes del filtro de coherencia: 14037

cat("Pares tras el filtro de coherencia:", n_despues, "\n")

## Pares tras el filtro de coherencia: 13884

cat("Descartados por razón no física:", n_antes - n_despues, "\n")

## Descartados por razón no física: 153

4.3 Paso 3 — Gráfica original (datos filtrados, sin agrupar)

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 vs. Measured Depth")

4.4 Paso 4 — Agrupación de múltiples Y por X

Como en el documento exponencial, cuando una misma X (profundidad propuesta) tiene varios valores de Y, se calcula la media aritmética para obtener un único par representativo. No se aplica binning: se agrupa por el valor exacto de X, no por rangos artificiales.

pares <- df_raw %>%
  group_by(x) %>%
  summarise(y = mean(y, na.rm = TRUE), .groups = "drop") %>%
  arrange(x)

cat("Pares únicos para el modelo:", nrow(pares), "\n")

## Pares únicos para el modelo: 2360

4.4.1 Tabla de pares (vista previa)

Nota: el modelo se ajusta sobre las 2360 filas completas de pares; aquí solo se muestran las primeras 15 para mantener el documento legible.

tabla_pares_gt <- pares %>%
  head(15) %>%
  rename(`Proposed Depth, ft (X)` = x,
         `Measured Depth, ft (Y)` = y) %>%
  mutate(`Measured Depth, ft (Y)` = round(`Measured Depth, ft (Y)`, 2))

tabla_pares_gt %>%
  gt() %>%
  tab_header(
    title    = md("**Tabla de Pares de Valores (vista previa)**"),
    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, nrow(tabla_pares_gt), 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
  )

Proposed Depth, ft (X)	Measured Depth, ft (Y)
Tabla de Pares de Valores (vista previa)
Proposed Depth y Measured Depth
56	56.00
89	89.00
114	114.00
132	132.00
200	207.33
300	326.00
350	382.00
400	411.80
425	382.50
442	442.00
450	450.00
465	514.00
485	383.00
500	578.25
507	534.50
Autor: Grupo 1

5 Conjetura del modelo matemático

Observando la gráfica de dispersión, se propone un Modelo de Regresión Polinómica de grado 2:

\[y = a + b_1 x + b_2 x^2\]

Justificación del grado: se probó también un modelo de grado 3, y la mejora en el R² fue prácticamente nula (menos de 0.05 puntos porcentuales) respecto al de grado 2. Por el principio de parsimonia —preferir el modelo más simple que explique igual de bien los datos—, se conserva el grado 2 en lugar de agregar un término adicional que no aporta poder explicativo real.

m_poli2 <- lm(y ~ poly(x, 2, raw = TRUE), data = pares)
sum_reg <- summary(m_poli2)

6 Cálculo de parámetros

b <- coef(m_poli2)

cat("Intercepto (a) :", round(b[1], 4), "\n")

## Intercepto (a) : -123.4069

cat("Pendiente b1   :", round(b[2], 6), "\n")

## Pendiente b1   : 1.062629

cat("Pendiente b2   :", round(b[3], 8), "\n")

## Pendiente b2   : 0.00000577

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

## 
## Ecuación del modelo:

cat("y =", round(b[1], 2),
    "+ (", round(b[2], 6), ")x",
    "+ (", round(b[3], 8), ")x²\n")

## y = -123.41 + ( 1.062629 )x + ( 0.00000577 )x²

7 Comparación del modelo con la realidad

x_grid <- seq(min(pares$x), max(pares$x), length.out = 400)
y_grid <- predict(m_poli2, newdata = data.frame(x = x_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 Polinómico y Datos Reales")

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

legend("topleft",
       legend = c("Datos reales", "Modelo polinómico (grado 2)"),
       col    = c(col_puntos, col_curva),
       pch    = c(20, NA),
       lty    = c(NA, 1),
       lwd    = c(NA, 3),
       bty    = "n")

8 Test de Pearson

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

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

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

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

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

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

9 Cálculo de estimaciones

x_estimar1  <- round(min(pares$x), 2)
y_estimada1 <- predict(m_poli2, 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: -63.88 ft

x_estimar2  <- round(max(pares$x), 2)
y_estimada2 <- predict(m_poli2, 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: 15212.43 ft

x_estimar3  <- 1500
y_estimada3 <- predict(m_poli2, 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: 1483.51 ft

9.1 Tabla resumen del modelo

Ecuacion <- paste0(
  "y = ", round(b[1], 2),
  " + (", round(b[2], 6), ")x",
  " + (", round(b[3], 8), ")x²"
)

Tabla_resumen <- data.frame(
  `Variable Independiente`      = "Proposed Depth, ft",
  `Variable Dependiente`        = "Measured Depth, ft",
  `Test Pearson`                = 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 polinómica (grado 2)**")
  ) %>%
  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)
  )

Variable Independiente	Variable Dependiente	Test Pearson	Coeficiente de determinación	Ecuación del modelo
Tabla N°1
Resumen del modelo de regresión polinómica (grado 2)
Proposed Depth, ft	Measured Depth, ft	0.9696	94.04	y = -123.41 + (1.062629)x + (0.00000577)x²
Autor: Grupo 1

10 Conclusión

Entre la profundidad propuesta (Proposed Depth, X) y la profundidad medida (Measured Depth, Y) existe una relación polinómica de segundo grado cuya ecuación matemática es:

\[y = -123.41 + (1.062629)x + (0.0000058)x^2\]

Con una correlación de Pearson de 0.97 y un coeficiente de determinación de 94.04%, el modelo indica que la profundidad planificada en el permiso explica en gran medida la profundidad realmente alcanzada durante la perforación, con una ligera curvatura que un modelo puramente lineal no captura del todo.

Modelo de Regresión Polinómica

Proposed Depth y Measured Depth de Pozos Regulados del Estado de Nueva York

DALLYANNA

2026-07-06