1 Librerías

library(readr)
library(dplyr)
library(ggplot2)
library(gt)
library(stringr)
library(DT)

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

2 Carga de Datos

ruta_archivo <- file.choose()
datos <- read_csv(ruta_archivo, show_col_types = FALSE)

# Rellenamiento de celdas faltantes con la mediana de cada variable
if (any(is.na(datos$TOWNSHIP))) {
  datos$TOWNSHIP[is.na(datos$TOWNSHIP)] <-
    median(datos$TOWNSHIP, na.rm = TRUE)
}
if (any(is.na(datos$LATITUDE))) {
  datos$LATITUDE[is.na(datos$LATITUDE)] <-
    median(datos$LATITUDE, na.rm = TRUE)
}

# Se descartan registros con valores no positivos
datos <- datos %>%
  filter(TOWNSHIP > 0, LATITUDE > 0)

str(datos[, c("TOWNSHIP", "LATITUDE")])
tibble [47,757 × 2] (S3: tbl_df/tbl/data.frame)
 $ TOWNSHIP: num [1:47757] 33 15 29 26 33 17 30 26 23 16 ...
 $ LATITUDE: num [1:47757] 37.1 38.8 37.5 37.8 37.1 ...

3 Selección de Variables

Según la tabla de variables del proyecto, se eligió el siguiente par por presentar una relación de tipo logarítmica decreciente con fundamento en el sistema de agrimensura rectangular (PLSS) de Kansas: el número de Township representa la posición norte-sur de un arrendamiento dentro de la cuadrícula PLSS, donde los valores más bajos corresponden al norte del estado y los más altos al sur. A medida que el número de Township aumenta, la latitud geográfica del arrendamiento disminuye de forma logarítmica, ya que cada unidad de Township equivale aproximadamente a 6 millas de desplazamiento hacia el sur, generando una relación matemáticamente predecible entre ambas variables.

Se definió el Township (TOWNSHIP, cuantitativa discreta, adimensional) como variable independiente / causa (x), ya que representa la posición relativa norte-sur dentro del sistema de coordenadas PLSS de Kansas.

La Latitud Geográfica (LATITUDE, cuantitativa continua, medida en grados decimales) actúa como variable dependiente / efecto (y), pues refleja la ubicación geográfica absoluta del arrendamiento en función de su posición dentro del sistema PLSS.

Ambas variables cumplen la condición buscada: al aumentar x (Township), y (Latitud) disminuye de forma logarítmica decreciente, lo que se comprueba en las secciones siguientes.

4 Tabla de Pares de Valores

4.1 Mediana de la variable Y por percentil de X

El conjunto depurado contiene 47757 registros. Dado que TOWNSHIP es una variable discreta con pocos valores únicos (1–35) muy repetidos entre pozos, y LATITUDE puede presentar ligeras irregularidades por errores de georreferenciación, se emplea la mediana como medida de resumen, por ser más robusta ante valores atípicos que la media. Los registros se agrupan en 25 percentiles según Township y se calcula la mediana de ambas variables, obteniendo un único par (x̃, ỹ) por percentil.

tabla_xy <- datos %>%
  mutate(percentil = ntile(TOWNSHIP, 25)) %>%
  group_by(percentil) %>%
  summarise(
    n_pozos   = n(),
    x_mediana = median(TOWNSHIP),
    y_mediana = median(LATITUDE),
    .groups   = "drop"
  ) %>%
  arrange(percentil)

cat("Total de pares (x\u0303, y\u0303) obtenidos, uno por percentil:", nrow(tabla_xy), "\n")
Total de pares (x̃, ỹ) obtenidos, uno por percentil: 25 
datatable(
  tabla_xy,
  caption = htmltools::tags$caption(
    style = "caption-side: top; text-align: left; font-size: 16px;
             font-weight: 700; color:#1F2A33;",
    "Tabla N\u00b01: Pares (x\u0303, y\u0303) \u2014 Mediana de Latitud Geogr\u00e1fica
     por Percentil de Township"
  ),
  rownames = FALSE,
  class    = "display compact stripe hover",
  options  = list(
    pageLength = 10,
    dom        = "ltip",
    columnDefs = list(list(className = "dt-center", targets = "_all"))
  )
) %>%
  formatRound(columns = c("x_mediana", "y_mediana"), digits = 4)

4.2 Máximos, mínimos y resumen general

max_x <- max(tabla_xy$x_mediana)
min_x <- min(tabla_xy$x_mediana)
max_y <- max(tabla_xy$y_mediana)
min_y <- min(tabla_xy$y_mediana)

data.frame(
  Variable = c("TOWNSHIP (X)", "LATITUDE (Y)"),
  Minimo   = round(c(min_x, min_y), 4),
  Maximo   = round(c(max_x, max_y), 4),
  Rango    = round(c(max_x - min_x, max_y - min_y), 4),
  Mediana  = round(c(median(tabla_xy$x_mediana),
                     median(tabla_xy$y_mediana)), 4)
) %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N\u00b02: Resumen General de las Variables (pares x\u0303, y\u0303)**")
  ) %>%
  tab_source_note(source_note = "Autor: Leslye Quinchiguango") %>%
  cols_align(align = "center", everything())
Tabla N°2: Resumen General de las Variables (pares x̃, ỹ)
Variable Minimo Maximo Rango Mediana
TOWNSHIP (X) 4.0000 35.000 31.0000 25.0000
LATITUDE (Y) 37.0236 39.735 2.7114 37.8802
Autor: Leslye Quinchiguango

5 Gráfica de Dispersión

5.1 Todos los valores (47757 registros)

Se grafican todos los registros del conjunto, sin agrupar ni resumir, para visualizar la nube completa de puntos.

par(mar = c(5, 5, 4, 2))
plot(datos$TOWNSHIP, datos$LATITUDE,
     pch = 16, cex = 0.35,
     col = adjustcolor("#2E86AB", alpha.f = 0.15),
     xlab = "X (Township)",
     ylab = "Y (Latitud, grados decimales)",
     main = "Gr\u00e1fica N\u00b01: Nube de Puntos \u2014 Todos los Valores",
     cex.main = 0.9, frame.plot = FALSE)
grid(nx = NULL, ny = NULL, col = "#D7DBDD", lty = "dotted")
box()

5.2 Pares (x̃, ỹ) por percentil

Con los datos resumidos por percentil mediante la mediana, la tendencia logarítmica decreciente se aprecia con mayor claridad.

par(mar = c(5, 5, 4, 2))
plot(tabla_xy$x_mediana, tabla_xy$y_mediana,
     pch = 19, col = "#2E86AB",
     xlab = "X\u0303 (Mediana Township)",
     ylab = "Y\u0303 (Mediana Latitud, grados decimales)",
     main = "Gr\u00e1fica N\u00b02: Nube de Puntos \u2014 Pares (x\u0303, y\u0303)",
     cex.main = 0.9, frame.plot = FALSE)
grid(nx = NULL, ny = NULL, col = "#D7DBDD", lty = "dotted")
box()

6 Conjetura

Al observar ambas nubes de puntos, se aprecia una tendencia decreciente con curvatura logarítmica: a medida que aumenta el número de Township, la Latitud Geográfica disminuye progresivamente. La tasa de descenso es mayor en los primeros townships y se aplana hacia los valores más altos, describiendo la forma característica de un logaritmo decreciente. Esta relación es inherente al sistema PLSS: cada township adicional desplaza el arrendamiento aproximadamente 6 millas hacia el sur, reduciendo la latitud de forma acumulativa pero no perfectamente lineal debido a la curvatura de la Tierra.

Por lo anterior, se conjetura un modelo logarítmico decreciente:

\[y = a + b \cdot \ln(x)\]

con pendiente \(b < 0\) (relación inversamente proporcional a tasa decreciente).

7 Cálculo de Parámetros

El modelo se ajusta sobre los pares (x̃, ỹ) por percentil (Tabla N°1). El uso de la mediana por percentil en lugar de los 47757 registros crudos reduce la influencia de coordenadas con errores de georreferenciación y permite capturar la tendencia central de la relación geográfica.

x <- tabla_xy$x_mediana
y <- tabla_xy$y_mediana

modelo <- lm(y ~ log(x))
a <- coef(modelo)[1]
b <- coef(modelo)[2]

cat("Modelo ajustado: y =", round(a, 4), "+", round(b, 4), "* ln(x)\n")
Modelo ajustado: y = 42.3318 + -1.4171 * ln(x)
summary(modelo)

Call:
lm(formula = y ~ log(x))

Residuals:
     Min       1Q   Median       3Q      Max 
-0.63229 -0.14343 -0.00274  0.19019  0.27773 

Coefficients:
            Estimate Std. Error t value             Pr(>|t|)    
(Intercept) 42.33180    0.27590  153.43 < 0.0000000000000002 ***
log(x)      -1.41708    0.08932  -15.87   0.0000000000000702 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 0.2268 on 23 degrees of freedom
Multiple R-squared:  0.9163,    Adjusted R-squared:  0.9126 
F-statistic: 251.7 on 1 and 23 DF,  p-value: 0.00000000000007021

8 Sobreponer Modelo con la Realidad

x_seq <- seq(min(x), max(x), length.out = 500)
pred  <- predict(modelo,
                 newdata  = data.frame(x = x_seq),
                 interval = "confidence",
                 level    = 0.95)

par(mar = c(5, 5, 4, 2))
plot(x, y,
     pch = 19, col = "#2E86AB",
     xlab = "X\u0303 (Mediana Township)",
     ylab = "Y\u0303 (Mediana Latitud, grados decimales)",
     main = "Gr\u00e1fica N\u00b03: Sobreponer Modelo con la Realidad \u2014 Pares (x\u0303, y\u0303)",
     cex.main = 0.9, frame.plot = FALSE)
grid(nx = NULL, ny = NULL, col = "#D7DBDD", lty = "dotted")

# Banda de confianza al 95%
polygon(c(x_seq, rev(x_seq)),
        c(pred[, "lwr"], rev(pred[, "upr"])),
        col    = rgb(0.5, 0.5, 0.5, 0.2),
        border = NA)

# Curva ajustada
lines(x_seq, pred[, "fit"], col = "#E74C3C", lwd = 3)

legend("topright",
       legend = c("Datos (x\u0303, y\u0303)",
                  "Modelo Logar\u00edtmico",
                  "I.C. 95%"),
       col    = c("#2E86AB", "#E74C3C", "gray"),
       pch    = c(16, NA, 15),
       lwd    = c(NA, 3, NA),
       pt.cex = c(1, NA, 2),
       bty    = "n")
box()

La curva logarítmica sigue de cerca la dirección de los puntos, ajustándose a los pares (x̃, ỹ) y confirmando la relación logarítmica decreciente entre el número de Township y la Latitud Geográfica.

9 Test de Bondad (Pearson)

El coeficiente de correlación de Pearson, calculado sobre el modelo linealizado \(\ln(x)\), debe superar 0.7 en valor absoluto para aceptar el modelo logarítmico. Se evalúa tanto sobre los pares (x̃, ỹ) por percentil como sobre todos los registros crudos para verificar consistencia.

r_medianas <- cor.test(log(tabla_xy$x_mediana), tabla_xy$y_mediana)
r_todos    <- cor.test(log(datos$TOWNSHIP), datos$LATITUDE)

data.frame(
  Conjunto   = c("Pares (x\u0303, y\u0303) por percentil",
                 "Todos los valores (registros crudos)"),
  r          = round(c(r_medianas$estimate, r_todos$estimate), 4),
  R2         = round(c(r_medianas$estimate^2, r_todos$estimate^2), 4),
  Supera_0.7 = c(abs(r_medianas$estimate) > 0.7,
                 abs(r_todos$estimate)    > 0.7)
) %>%
  gt() %>%
  tab_header(
    title    = md("**Tabla N\u00b03: Test de Bondad de Ajuste**"),
    subtitle = "Umbral |r| > 0.7"
  ) %>%
  tab_source_note(source_note = "Autor: Leslye Quinchiguango") %>%
  cols_align(align = "center", everything())
Tabla N°3: Test de Bondad de Ajuste
Umbral |r| > 0.7
Conjunto r R2 Supera_0.7
Pares (x̃, ỹ) por percentil -0.9572 0.9163 TRUE
Todos los valores (registros crudos) -0.9239 0.8536 TRUE
Autor: Leslye Quinchiguango

Sobre los pares (x̃, ỹ), \(r =\) -0.957 (\(R^2 =\) 0.916), por encima del umbral de 0.7, por lo que el modelo logarítmico se acepta para describir la tendencia central de la relación entre el Township y la Latitud Geográfica.

10 Restricciones

El modelo ajustado es \(y = a + b \cdot \ln(x)\) con \(b < 0\). La función logarítmica impone la condición \(x > 0\), lo que excluye townships nulos o negativos — condición que siempre se cumple en el sistema PLSS. Para determinar los límites operativos del modelo se aplican las restricciones del dominio de la Latitud Geográfica (\(-90° \leq y \leq 90°\)):

Límite inferior de X (latitud máxima permitida \(y = 90°\)):

\[90 = a + b \cdot \ln(x) \implies \ln(x) = \frac{90 - a}{b} \implies x_{\min} = e^{\frac{90 - a}{b}}\]

x_min_modelo <- exp((90  - a) / b)
x_max_modelo <- exp((-90 - a) / b)

cat("Límite inferior de Township (y = 90°):  x_min =", round(x_min_modelo, 6), "
")
Límite inferior de Township (y = 90°):  x_min = 0 
cat("Límite superior de Township (y = -90°): x_max =", round(x_max_modelo, 2), "
")
Límite superior de Township (y = -90°): x_max = 35971459551577883650000442068444420862442 
cat("
Interpretación:
")

Interpretación:
cat("- Para que la latitud no supere 90°, el Township debe ser mayor que", round(x_min_modelo, 6), "
")
- Para que la latitud no supere 90°, el Township debe ser mayor que 0 
cat("- Para que la latitud no sea inferior a -90°, el Township debe ser menor que", round(x_max_modelo, 2), "
")
- Para que la latitud no sea inferior a -90°, el Township debe ser menor que 35971459551577883650000442068444420862442 
cat("- Rango observado en el conjunto:", round(min_x,1), "a", round(max_x,1), "townships
")
- Rango observado en el conjunto: 4 a 35 townships
cat("- Ambas condiciones se cumplen dentro del rango observado.
")
- Ambas condiciones se cumplen dentro del rango observado.

Límite superior de X (latitud mínima permitida \(y = -90°\)):

\[-90 = a + b \cdot \ln(x) \implies x_{\max} = e^{\frac{-90 - a}{b}}\]

Dado que \(b < 0\), al aumentar x la latitud disminuye, por lo que \(x_{\min}\) corresponde a latitudes altas (norte) y \(x_{\max}\) a latitudes bajas (sur). El modelo opera sin producir latitudes fuera del dominio geográfico válido dentro del rango de townships observado en Kansas (4 – 35). No se recomienda extrapolar fuera de este rango, pues la relación modelada es específica del estado de Kansas y el sistema PLSS regional.

11 Estimación

x_est <- round(median(tabla_xy$x_mediana), 1)
y_est <- a + b * log(x_est)

if (b >= 0) {
  ecuacion <- paste0("y = ", round(a, 4), " + ", round(b, 4), " \u00b7 ln(x)")
} else {
  ecuacion <- paste0("y = ", round(a, 4), " - ", abs(round(b, 4)), " \u00b7 ln(x)")
}

data.frame(
  Ecuacion_del_Modelo      = ecuacion,
  X_estimado_township      = x_est,
  Y_estimado_latitud_grados = round(y_est, 4)
) %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N\u00b04: Estimaci\u00f3n Puntual de Latitud Geogr\u00e1fica**")
  ) %>%
  tab_source_note(source_note = "Autor: Leslye Quinchiguango") %>%
  cols_align(align = "center", everything())
Tabla N°4: Estimación Puntual de Latitud Geográfica
Ecuacion_del_Modelo X_estimado_township Y_estimado_latitud_grados
y = 42.3318 - 1.4171 · ln(x) 25 37.7704
Autor: Leslye Quinchiguango

Para un arrendamiento ubicado en el Township 25 (mediana del conjunto analizado), el modelo estima una latitud geográfica de aproximadamente 37.7704° decimales.

12 Conclusiones

  • Entre el Township (X) y la Latitud Geográfica (Y) existe una relación de tipo logarítmica decreciente: a mayor número de township, menor latitud geográfica, lo que refleja el desplazamiento progresivo hacia el sur dentro del sistema PLSS de Kansas.
  • El modelo ajustado sobre las medianas por percentil es \(y = 42.3318 - 1.4171 · ln(x)\), con \(r = -0.957\) y \(R^2 = 0.916\), ambos por encima del umbral de aceptación de 0.7, confirmando la validez del modelo..
  • La curva logarítmica ajustada sigue de cerca la dirección de los pares (x̃, ỹ), confirmando que el patrón logarítmico decreciente es consistente con la estructura geográfica del sistema PLSS de Kansas.
  • El uso de la mediana por percentil es adecuado para este par, dado que TOWNSHIP es discreta con pocos valores únicos y LATITUDE puede presentar irregularidades de georreferenciación; la mediana es más robusta ante ambas situaciones.
  • En conjunto, esto valida al Township como un predictor logarítmico de la Latitud Geográfica de los arrendamientos de hidrocarburos en Kansas, en concordancia con la estructura matemática del sistema de agrimensura rectangular PLSS.

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