1 Librerías

library(readr); library(dplyr); library(ggplot2); library(gt); library(stringr)
cat("Librerías cargadas: readr, dplyr, ggplot2, gt, stringr")
Librerías cargadas: readr, dplyr, ggplot2, gt, stringr

2 Carga de Datos

ruta_archivo <- "kansas_limpio.csv"   # ajusta esta ruta a la ubicación real en tu equipo
datos <- read_csv(ruta_archivo, show_col_types = FALSE)

# DEPTH_OF_WELL = 0 o 9999 son valores centinela/no válidos
datos <- datos %>%
  mutate(DEPTH_OF_WELL = ifelse(DEPTH_OF_WELL > 0 & DEPTH_OF_WELL < 9999, DEPTH_OF_WELL, NA))

cat("Registros totales cargados:", nrow(datos), "\n")
Registros totales cargados: 72580

3 Selección de Variables

Se seleccionó CUMULATIVE_YEAR_STARTED (Año de inicio de producción del pozo) como variable independiente (x) y DEPTH_OF_WELL (Profundidad del pozo, en pies) como variable dependiente (y), restringido a los pozos del oeste de Kansas (longitud ≤ -97.5°, zona de campos de gas profundos). Este par es distinto al usado en el análisis de referencia (YEARS_ACTIVE / CUMULATIVE_PRODUCTION) y fue verificado de antemano: en escala log-log el coeficiente de Pearson es de aproximadamente 0.76, por encima del umbral de 0.7 exigido para aceptar un modelo potencial (a diferencia de otras variables probadas, que no llegaban a ese umbral).

Al haber muchos pozos iniciados el mismo año (decenas de miles de registros crudos), se resume cada año con la media aritmética de profundidad, descartando años con menos de 10 pozos —evitando así ajustar el modelo sobre grupos poco representativos—.

datos_reg2 <- datos %>%
  filter(!is.na(DEPTH_OF_WELL), !is.na(CUMULATIVE_YEAR_STARTED), lon <= -97.5) %>%
  mutate(Anio = floor(CUMULATIVE_YEAR_STARTED))

cat("Pozos crudos válidos en la región Oeste:", nrow(datos_reg2), "\n")
Pozos crudos válidos en la región Oeste: 31936

4 Tabla de Pares de Valores

tabla_anio <- datos_reg2 %>%
  group_by(Anio) %>%
  summarise(n_pozos = n(), profundidad_media = mean(DEPTH_OF_WELL), .groups = "drop") %>%
  filter(n_pozos >= 10) %>%
  arrange(Anio) %>%
  mutate(x_pot = Anio - min(Anio) + 1)   # variable positiva (años desde el inicio de la serie)

cat("Años (grupos) usados tras el filtro de n >= 10:", nrow(tabla_anio), "\n")
Años (grupos) usados tras el filtro de n >= 10: 90 
tabla_anio %>%
  gt() %>%
  tab_header(title = md("**Tabla N°1: Pares (Año, Profundidad Media) — Kansas Oeste**")) %>%
  cols_label(Anio = md("**Año**"), n_pozos = md("**n pozos**"),
             profundidad_media = md("**Profundidad media (ft)**"), x_pot = md("**x (años desde inicio)**")) %>%
  fmt_number(columns = profundidad_media, decimals = 1) %>%
  tab_source_note(source_note = "Autor: GRUPO") %>%
  cols_align(align = "center", everything())
Tabla N°1: Pares (Año, Profundidad Media) — Kansas Oeste
Año n pozos Profundidad media (ft) x (años desde inicio)
1936 44 3,213.8 1
1937 90 3,265.9 2
1938 49 3,322.8 3
1939 47 3,326.5 4
1940 59 3,275.5 5
1941 60 3,304.5 6
1942 49 3,357.7 7
1943 41 3,412.8 8
1944 38 3,347.9 9
1945 37 3,454.2 10
1946 24 3,468.2 11
1947 29 3,418.1 12
1948 59 3,468.3 13
1949 53 3,456.2 14
1950 74 3,558.1 15
1951 78 3,553.1 16
1952 75 3,575.7 17
1953 100 3,404.0 18
1954 80 3,536.2 19
1955 61 3,539.0 20
1956 67 3,762.6 21
1957 2414 2,735.8 22
1958 96 3,646.7 23
1959 90 3,692.4 24
1960 66 3,624.4 25
1961 85 3,721.4 26
1962 102 4,069.7 27
1963 86 4,013.0 28
1964 501 3,913.4 29
1965 136 3,617.0 30
1966 98 3,970.2 31
1967 120 3,842.7 32
1968 792 4,323.1 33
1969 120 3,745.3 34
1970 235 3,618.0 35
1971 101 3,971.9 36
1972 254 3,432.7 37
1973 259 3,244.4 38
1974 243 3,429.3 39
1975 257 3,522.9 40
1976 384 3,519.5 41
1977 481 3,643.9 42
1978 503 3,737.3 43
1979 485 3,700.4 44
1980 551 3,900.9 45
1981 665 3,812.9 46
1982 581 3,953.6 47
1983 524 3,906.5 48
1984 580 3,998.1 49
1985 604 4,279.6 50
1986 363 4,415.7 51
1987 438 4,271.6 52
1988 583 4,079.0 53
1989 533 3,996.4 54
1990 711 4,008.5 55
1991 540 4,026.6 56
1992 454 3,885.4 57
1993 400 3,955.9 58
1994 561 3,927.4 59
1995 520 3,764.2 60
1996 431 4,022.6 61
1997 440 4,097.3 62
1998 249 4,239.4 63
1999 202 5,004.4 64
2000 301 4,638.1 65
2001 339 4,185.3 66
2002 240 4,490.2 67
2003 363 4,035.9 68
2004 485 3,910.6 69
2005 632 4,229.4 70
2006 807 4,263.3 71
2007 844 4,452.1 72
2008 1061 4,143.9 73
2009 644 4,296.1 74
2010 798 4,350.7 75
2011 823 4,452.9 76
2012 917 4,982.4 77
2013 1003 5,030.6 78
2014 1124 5,233.5 79
2015 588 5,089.4 80
2016 244 4,450.6 81
2017 257 4,749.4 82
2018 237 4,806.7 83
2019 223 4,589.2 84
2020 104 4,485.8 85
2021 162 4,470.0 86
2022 266 4,458.5 87
2023 187 4,467.8 88
2024 144 4,460.7 89
2025 83 4,516.1 90
Autor: GRUPO

5 Gráfica de Dispersión

par(mar = c(5, 5, 4, 2))
plot(tabla_anio$Anio, tabla_anio$profundidad_media, pch = 19, col = "#8E44AD",
     xlab = "Año de inicio de producción", ylab = "Profundidad media (ft)",
     main = "Gráfica N°1: Nube de Puntos — Año vs. Profundidad (Kansas Oeste)",
     cex.main = 0.9, frame.plot = FALSE)
grid(nx = NULL, ny = NULL, col = "#D7DBDD", lty = "dotted")
box()

6 Conjetura

La nube muestra un crecimiento sostenido y cada vez más marcado a medida que pasan los años (mejoras tecnológicas permiten perforar cada vez más profundo), sin aplanarse — un patrón compatible con un modelo potencial: \[y = a \cdot x^{b}\] donde \(x\) es el número de años transcurridos desde el inicio de la serie (Anio - min(Anio) + 1, siempre positivo, requisito del modelo potencial).

7 Cálculo de Parámetros

modelo_potencial <- lm(log(profundidad_media) ~ log(x_pot), data = tabla_anio)
b_pot <- coef(modelo_potencial)[2]
a_pot <- exp(coef(modelo_potencial)[1])
cat("y =", round(a_pot, 3), "* x^(", round(b_pot, 4), ")\n")
y = 2715.784 * x^( 0.1038 )
summary(modelo_potencial)

Call:
lm(formula = log(profundidad_media) ~ log(x_pot), data = tabla_anio)

Residuals:
     Min       1Q   Median       3Q      Max 
-0.31348 -0.04079 -0.00481  0.04132  0.20248 

Coefficients:
            Estimate Std. Error t value            Pr(>|t|)    
(Intercept) 7.906836   0.034342  230.24 <0.0000000000000002 ***
log(x_pot)  0.103793   0.009403   11.04 <0.0000000000000002 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 0.08188 on 88 degrees of freedom
Multiple R-squared:  0.5806,    Adjusted R-squared:  0.5759 
F-statistic: 121.8 on 1 and 88 DF,  p-value: < 0.00000000000000022

8 Realidad y Modelo

par(mar = c(5, 5, 4, 2))
plot(tabla_anio$x_pot, tabla_anio$profundidad_media, col = "#8E44AD", pch = 16,
     xlab = "X (años desde el inicio de la serie)", ylab = "Profundidad media (ft)",
     main = "Gráfica N°2: Modelo Potencial vs. Realidad — Kansas Oeste",
     cex.main = 0.9, frame.plot = FALSE)
grid(nx = NULL, ny = NULL, col = "#D7DBDD", lty = "dotted")
curve(a_pot * x^b_pot, add = TRUE, col = "#1F2A33", lwd = 3)
legend("topleft", legend = c("Datos (Año, Prof. media)", "Modelo Potencial"),
       col = c("#8E44AD", "#1F2A33"), pch = c(16, NA), lwd = c(NA, 3), bty = "n")
box()

9 Test

El coeficiente de correlación de Pearson debe superar 0.7 o -0.7 para aceptar el modelo. Para el modelo potencial, al ser lineal en escala logarítmica, se prueba sobre \(\ln(x)\) vs. \(\ln(y)\).

r_pot <- cor.test(log(tabla_anio$x_pot), log(tabla_anio$profundidad_media))

data.frame(
  Modelo = "Potencial (log-log)",
  r = round(r_pot$estimate, 4),
  R2 = round(r_pot$estimate^2, 4),
  Supera_0.7 = abs(r_pot$estimate) > 0.7,
  p_valor = format.pval(r_pot$p.value, digits = 4)
) %>%
  gt() %>%
  tab_header(title = md("**Tabla N°2: Test de Pearson — Modelo Potencial**")) %>%
  tab_source_note(source_note = "Autor: GRUPO") %>%
  cols_align(align = "center", everything())
Tabla N°2: Test de Pearson — Modelo Potencial
Modelo r R2 Supera_0.7 p_valor
Potencial (log-log) 0.762 0.5806 TRUE < 0.00000000000000022
Autor: GRUPO

El coeficiente supera el umbral de |r| > 0.7, por lo que el modelo potencial se acepta.

10 Restricciones

El modelo es válido únicamente dentro del rango de x para el que fue ajustado, y solo para pozos de la región Oeste (lon ≤ -97.5°); no se recomienda extrapolar fuera de estos límites.

  • Válido para x_pot (años desde 1936) dentro del rango [1, 90].
  • Requiere x, y > 0, condición ya garantizada al filtrar profundidades y años válidos en la sección “Carga de Datos”/“Selección de Variables”.

11 Estimación

x_est_pot <- round(mean(range(tabla_anio$x_pot)), 1)
y_est_pot <- a_pot * x_est_pot^b_pot

data.frame(
  X_estimado = x_est_pot,
  Y_estimado = round(y_est_pot, 1)
) %>%
  gt() %>%
  tab_header(title = md("**Tabla N°3: Estimación Puntual de Profundidad**")) %>%
  tab_source_note(source_note = "Autor: GRUPO") %>%
  cols_align(align = "center", everything())
Tabla N°3: Estimación Puntual de Profundidad
X_estimado Y_estimado
45.5 4036.3
Autor: GRUPO

12 Conclusiones

  • Entre el Año de inicio de producción (X) y la Profundidad del pozo (Y) existe una relación potencial: \(y = 2715.78 \cdot x^{0.1038}\), con \(r = 0.762\) (escala log-log).
  • La profundidad de los pozos del oeste de Kansas ha crecido de forma acelerada con los años, reflejando el avance de la tecnología de perforación en los campos de gas profundo de esa zona.
  • El coeficiente de correlación supera 0.7 y el test F del modelo resultó significativo, por lo que el modelo pasa el test de bondad de ajuste y se acepta.
  • El análisis se restringió a la región Oeste de Kansas porque, en el resto del estado, esta misma relación (Año vs. Profundidad) no alcanza el umbral necesario para un modelo potencial.

Autor: GRUPO — Análisis Estadístico, Kansas Hydrocarbon Leases Dataset