1 Librerías

library(dplyr)
library(gt)

2 Carga de datos

ruta_carpeta <- "C:/Users/ASUS/Desktop/Estadistica/new_york_exel"
archivo_csv  <- "Oil__Gas____Other_Regulated_Wells__Beginning_1860.csv"

if (dir.exists(ruta_carpeta)) {
  setwd(ruta_carpeta)
} else {
  warning("La carpeta indicada en 'ruta_carpeta' no existe en este equipo. ",
          "Ajusta 'ruta_carpeta' o escribe la ruta completa en 'archivo_csv'.")
}

lineas <- readLines(archivo_csv, encoding = "latin1", warn = FALSE)
Encoding(lineas) <- "latin1"
lineas <- iconv(lineas, from = "latin1", to = "UTF-8")

separadores <- c(",", ";", "\t", "|")
mejor_sep   <- NULL
mejor_ncol  <- 1
for (s in separadores) {
  n_campos <- tryCatch(length(strsplit(lineas[1], s, fixed = TRUE)[[1]]),
                        error = function(e) 1)
  if (!is.na(n_campos) && n_campos > mejor_ncol) {
    mejor_ncol <- n_campos
    mejor_sep  <- s
  }
}
if (is.null(mejor_sep)) mejor_sep <- ";"

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

cat("Registros:", nrow(datos), " | Variables:", ncol(datos), "\n")

## Registros: 47390  | Variables: 52

EXTRACTO DEL DATASET

datos %>%
  head(5) %>%
  gt() %>%
  tab_header(title = md("**Vista Previa del Dataset**"),
             subtitle = md(paste0("Total de variables = ", ncol(datos),
                                   " | Total de registros = ", nrow(datos)))) %>%
  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_options(table.font.size = px(11), data_row.padding = px(4))

API.Well.Number	County.Code	API.Hole.Number	Sidetrack	Completion	Well.Name	Company.Name	Operator.Number	Well.Type	Map.Symbol	Well.Status	Date.Spudded	Date.Well.Completed	Confidentiality.Code	Town	Quad	Quad.Section	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	Depth.Fee	Spacing.Acres	Date.Last.Modified	DEC.Database.Link	Location.1	Georeference
Vista Previa del Dataset
Total de variables = 52 \| Total de registros = 47390
31003026700000	3	2670	0	0	Francisco 1	Van Gilder	9279	DW	DP	PA	03/11/1953	04/10/1953	Pre-1989 Well (N/A)	Amity	Belmont	F	False	Vertical	Allegany	9	NA	0	-78.01913	42.19713	-78.01913	42.19713	2006	2006	0	2006	1815	NL	0	0	NA	10/12/1995 12:00:00 AM	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	NA	0	-78.02615	42.20221	-78.02615	42.20221	0	0	0	0	1520	NL	0	0	NA	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	NA	NA	NA	NA	NA	NA	0	0	0	0	NA	NL	0	0	NA	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	NA	0	-77.97909	42.07020	-77.97909	42.07020	0	0	0	0	2100	NL	0	0	NA	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)
31003069290000	3	6929	0	0	2667	Bradley Producing Company	9673	NL	O	VP			Pre-1989 Well (N/A)				False	Vertical	Statewide	9	NA	NA	NA	NA	NA	NA	0	0	0	0	NA	NL	0	0	NA	11/28/2018 10:25:33 AM	http://extapps.dec.ny.gov/cfmx/extapps/GasOil/search/wells/index.cfm?api=31003069290000
Autor: Grupo 1

3 Selección de variables

Variable independiente (X): Measured Depth, ft (profundidad medida, agrupada en intervalos de 500 ft — punto medio del intervalo).
Variable dependiente (Y): Frecuencia (cantidad de pozos cuya profundidad cae en ese intervalo).

col_y <- names(datos)[grepl("measured.*depth", names(datos), ignore.case = TRUE)][1]
cat("Columna de profundidad utilizada:", col_y, "\n")

## Columna de profundidad utilizada: Measured.Depth..ft

prof <- suppressWarnings(as.numeric(as.character(datos[[col_y]])))
prof <- prof[!is.na(prof) & prof > 0]
cat("Pozos con profundidad válida:", length(prof), "\n")

## Pozos con profundidad válida: 32760

4 Tabla de pares de valores

ancho <- 500  # ancho del intervalo de profundidad, en pies

bins <- floor(prof / ancho) * ancho
pares_iniciales <- as.data.frame(table(bins)) %>%
  mutate(x = as.numeric(as.character(bins)) + ancho / 2, y = Freq) %>%
  select(x, y) %>%
  arrange(x)

cat("Tamaño muestral (intervalos de profundidad):", nrow(pares_iniciales), "\n")

## Tamaño muestral (intervalos de profundidad): 32

tabla_ini_gt <- pares_iniciales %>%
  head(10) %>%
  rename(`Measured Depth, ft (X)` = x, `Frecuencia (Y)` = y)

tabla_ini_gt %>%
  gt() %>%
  tab_header(
    title    = md("**Tabla de Pares de Valores (vista previa)**"),
    subtitle = md(paste0("Tamaño muestral n = ", nrow(pares_iniciales)))
  ) %>%
  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_ini_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
  )

Measured Depth, ft (X)	Frecuencia (Y)
Tabla de Pares de Valores (vista previa)
Tamaño muestral n = 32
250	393
750	3568
1250	10534
1750	6958
2250	2921
2750	1711
3250	1557
3750	1786
4250	1745
4750	712
Autor: Grupo 1

5 Gráfica de dispersión

plot(pares_iniciales$x, pares_iniciales$y,
     pch  = 20,
     col  = col_puntos,
     type = "b",
     xlab = "Measured Depth, ft (X)",
     ylab = "Frecuencia de pozos (Y)",
     main = "Gráfica original: Frecuencia de pozos en función de la profundidad")

6 Conjetura

La nube muestra dos tramos: una subida breve hasta un pico, y luego una caída sostenida y curva, no una línea recta, conforme la profundidad aumenta. Se procede con el tratamiento de los datos.

6.1 Tratamiento de los datos

Segmentación por partes. El tramo ascendente inicial no corresponde al fenómeno de decaimiento por dificultad de perforación, sino a umbrales administrativos mínimos; se conserva únicamente la cola descendente, a partir del intervalo de mayor frecuencia (el pico).

pico_x <- pares_iniciales$x[which.max(pares_iniciales$y)]

pares <- pares_iniciales %>% filter(x >= pico_x)

cat("Intervalos iniciales:", nrow(pares_iniciales), "\n")

## Intervalos iniciales: 32

cat("Pico de la distribución en X =", pico_x, "ft\n")

## Pico de la distribución en X = 1250 ft

cat("Intervalos en la cola descendente:", nrow(pares), "\n")

## Intervalos en la cola descendente: 30

No fue necesario un tratamiento adicional (outliers, único X/Y): al ser una tabla de frecuencias, cada intervalo ya aporta un único par (X, Y).

6.2 Nueva gráfica de dispersión

plot(pares$x, pares$y,
     pch  = 20,
     col  = col_puntos,
     type = "b",
     xlab = "Measured Depth, ft (X)",
     ylab = "Frecuencia de pozos (Y)",
     main = "Gráfica tras el tratamiento de datos")

6.3 Nueva conjetura

La cola descendente muestra una caída curva y acelerada —muchos pozos se pierden entre los primeros intervalos y cada vez menos entre los últimos—, propia de un decaimiento exponencial, no de una línea recta:

\[y = a \cdot e^{bx}, \quad b < 0\]

Linealización: se aplica logaritmo natural a Y para ajustar con lm()/nls() y luego recuperar a con exp().

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

pares$log_y <- log(pares$y)

plot(pares$x, pares$log_y,
     pch  = 20,
     col  = col_puntos,
     xlab = "Measured Depth, ft (X)",
     ylab = "ln(Frecuencia)  —  eje Y reducido",
     main = "Linealización: ln(Y) en función de X")

7 Cálculo de parámetros

m_exp <- nls(y ~ a * exp(b * x), data = pares, start = list(a = max(pares$y), b = -0.0005))
coefs <- coef(m_exp)
a <- coefs["a"]
b <- coefs["b"]

cat("Parámetro a:", round(a, 4), "\n")

## Parámetro a: 35924.79

cat("Parámetro b:", round(b, 8), "\n")

## Parámetro b: -0.0009843

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

## 
## Ecuación del modelo exponencial:

cat("y =", round(a, 4), "* e^(", round(b, 8), "x )\n")

## y = 35924.79 * e^( -0.0009843 x )

8 Comparación del Modelo con la Realidad

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

plot(pares$x, pares$y,
     pch  = 20,
     col  = col_puntos,
     xlab = "Measured Depth, ft (X)",
     ylab = "Frecuencia de pozos (Y)",
     main = "Superposición: Modelo Exponencial y Datos Reales")

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

9 Test pearson

El Test de Pearson no se calcula entre X y Y directamente (la relación entre ambas es curva, no lineal, así que ese coeficiente subestimaría el ajuste). En su lugar se calcula entre los valores reales (Y) y los valores que predice el modelo exponencial (Ŷ): mientras más cerca estén los puntos predichos de los reales, más cerca de 1 estará r. Esta es la forma correcta de validar un modelo ya ajustado con nls().

y_pred <- predict(m_exp)
ss_res <- sum((pares$y - y_pred)^2)
ss_tot <- sum((pares$y - mean(pares$y))^2)
r2     <- (1 - (ss_res / ss_tot)) * 100
r      <- cor(pares$y, y_pred)

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

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

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

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

# Referencia: un ajuste lineal simple sobre los mismos datos explica mucho
# menos varianza, lo que confirma que la relación es genuinamente exponencial.
r2_lineal <- summary(lm(y ~ x, data = pares))$r.squared * 100
cat("R² de un modelo lineal simple sobre los mismos datos:", round(r2_lineal, 2), "%\n")

## R² de un modelo lineal simple sobre los mismos datos: 37.27 %

10 Restricciones

x_min <- round(min(pares$x), 2)
x_max <- round(max(pares$x), 2)
cat("Dominio válido de X (Measured Depth, ft):", x_min, "a", x_max, "\n")

## Dominio válido de X (Measured Depth, ft): 1250 a 15750

El modelo es válido únicamente dentro del rango observado de X (1250 a 15750 ft), es decir, a partir del pico de la distribución. No se recomienda extrapolar.
No aplica al tramo ascendente inicial (profundidades muy someras), que responde a un fenómeno distinto (umbrales técnicos mínimos), ya excluido en el tratamiento de datos.
Describe una tendencia agregada de la distribución de pozos, no la probabilidad de un pozo individual.

11 Estimación

x_estimar1  <- x_min
y_estimada1 <- a * exp(b * x_estimar1)
cat("X =", x_estimar1, "ft -> Frecuencia estimada:", round(y_estimada1, 2), "pozos\n\n")

## X = 1250 ft -> Frecuencia estimada: 10496.64 pozos

x_estimar2  <- round((x_min + x_max) / 2)
y_estimada2 <- a * exp(b * x_estimar2)
cat("X =", x_estimar2, "ft -> Frecuencia estimada:", round(y_estimada2, 2), "pozos\n\n")

## X = 8500 ft -> Frecuencia estimada: 8.35 pozos

x_estimar3  <- x_max
y_estimada3 <- a * exp(b * x_estimar3)
cat("X =", x_estimar3, "ft -> Frecuencia estimada:", round(y_estimada3, 2), "pozos\n")

## X = 15750 ft -> Frecuencia estimada: 0.01 pozos

11.1 Tabla resumen del modelo

Ecuacion <- paste0("y = ", round(a, 4), " * e^(", round(b, 8), " x )")

Tabla_resumen <- data.frame(
  `Variable Independiente`       = "Measured Depth, ft",
  `Variable Dependiente`         = "Frecuencia de pozos",
  `Test Pearson (Y real, Y predicho)` = 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)
  )

Variable Independiente	Variable Dependiente	Test Pearson (Y real, Y predicho)	Coeficiente de determinación	Ecuación del modelo
Tabla N°1
Resumen del modelo de regresión exponencial
Measured Depth, ft	Frecuencia de pozos	0.9867	97.27	y = 35924.7924 * e^(-0.0009843 x )
Autor: Grupo 1

12 Conclusión

La frecuencia de pozos según su profundidad medida sigue un decaimiento exponencial genuino, no lineal:

\[y = 35924.7924 \cdot e^{-0.0009843 \, x}\]

Con Pearson 0.99 (entre los valores reales y los predichos por el modelo) y R² de 97.27% —muy superior al 37.27% que explica un modelo lineal sobre los mismos datos—, se confirma que el modelo exponencial sigue de cerca a los datos observados: cada intervalo adicional de profundidad reduce el número de pozos en una proporción constante, no en una cantidad fija; la dificultad de perforar más profundo crece multiplicativamente, no de forma aditiva. El modelo es válido solo entre 1250 y 15750 ft.

Modelo de Regresión Exponencial

Análisis estadístico de Pozos Regulados del Estado de Nueva York

Dallyanna

2026-07-24