Modelo de Regresión Logarítmica


1. Carga de librerías

library(readxl)
library(dplyr)
library(gt)

2. Carga de datos

setwd("C:/Users/ronny/Downloads/Dataset")
datos <- read_excel("dataset_mundial_petro.xlsx")
cat("Número de registros:", nrow(datos), "\n")
## Número de registros: 49212
cat("Número de variables:", ncol(datos), "\n")
## Número de variables: 32

3. Selección de variables

Se conservan las mismas variables analizadas previamente: la variable Discovery year (año de descubrimiento) como variable independiente o causa (X), y la variable Longitude (longitud geográfica) como variable dependiente o efecto (Y), ya que la zona del planeta en la que se concentra la exploración petrolera ha ido cambiando a medida que avanzan los años.

Esta variable X es, además, una buena candidata para un modelo logarítmico: al tratarse de un año calendario, X siempre toma valores positivos (X > 0), condición indispensable para poder aplicar el logaritmo natural. Adicionalmente, la exploración de nuevas fronteras geográficas suele mostrar un patrón de crecimiento rápido en las primeras décadas seguido de una desaceleración, comportamiento típico de una relación logarítmica.

x_raw <- as.numeric(datos$`Discovery year`)
y_raw <- as.numeric(datos$Longitude)

cat("Registros con Discovery year:", sum(!is.na(x_raw)), "\n")
## Registros con Discovery year: 4935
cat("Registros con Longitude:", sum(!is.na(y_raw)), "\n")
## Registros con Longitude: 7537
cat("Pares completos (ambos con dato):", sum(!is.na(x_raw) & !is.na(y_raw)), "\n")
## Pares completos (ambos con dato): 4641
cat("X sin Y:", sum(!is.na(x_raw) & is.na(y_raw)), "\n")
## X sin Y: 294
cat("Y sin X:", sum(is.na(x_raw) & !is.na(y_raw)), "\n")
## Y sin X: 2896

4. Tabla de pares de valores

Se presenta un extracto (primeros 20 registros) tal como fueron extraídos del dataset, antes de cualquier depuración.

df_pares <- data.frame(x = x_raw, y = y_raw)

df_pares %>%
  head(20) %>%
  rename(`Año de Descubrimiento (X)` = x,
         `Longitud Geográfica (Y)`   = y) %>%
  gt() %>%
  tab_header(
    title    = md("**Tabla de Pares de Valores**"),
    subtitle = md("Valores originales sin depurar")
  ) %>%
  tab_source_note(source_note = "Autor: Grupo 5") %>%
  cols_align(align = "center", columns = everything()) %>%
  tab_options(
    table.border.top.color            = "black",
    table.border.bottom.color         = "black",
    table.border.top.style            = "solid",
    table.border.bottom.style         = "solid",
    column_labels.font.weight         = "bold",
    column_labels.border.top.color    = "black",
    column_labels.border.bottom.color = "black",
    column_labels.border.bottom.width = px(2),
    heading.border.bottom.color       = "black",
    heading.border.bottom.width       = px(2),
    table_body.hlines.color           = "grey",
    table_body.border.bottom.color    = "black"
  )
Tabla de Pares de Valores
Valores originales sin depurar
Año de Descubrimiento (X) Longitud Geográfica (Y)
1949 16.71667
2001 -39.61200
1966 -36.88900
1975 -36.26200
1984 -39.96100
1986 -39.74600
1981 -36.73400
2004 -36.07300
NA NA
NA -43.47230
1981 -40.52400
1986 -36.73300
1982 -36.56500
2007 -38.10900
1965 -38.17100
2000 -39.85300
2013 -42.46900
2001 -41.89300
1979 -38.97100
1999 -58.17800
Autor: Grupo 5

5. Gráfica

Gráfica original

plot(df_pares$x, df_pares$y,
     pch  = 20,
     col  = rgb(0.1, 0.4, 0.5, 0.4),
     xlab = "Año de Descubrimiento (X)",
     ylab = "Longitud Geográfica (Y)",
     main = "Relación entre el Año de Descubrimiento y la Longitud Geográfica (Datos Originales)")

Al igual que en el análisis anterior, la fuerte dispersión de los puntos impide reconocer con claridad la tendencia. Por ello se aplica la misma estrategia de tratamiento de datos antes de ajustar el modelo.

5.1 Relleno de valores faltantes

Los registros que tienen X pero no tienen Y se rellenan con la media aritmética global de Y, que es la mejor estimación cuando no se dispone del dato real.

media_y_global <- mean(df_pares$y, na.rm = TRUE)
cat("Media global de Longitude (Y):", round(media_y_global, 4), "\n")
## Media global de Longitude (Y): -54.6526
df_pares$y[is.na(df_pares$y) & !is.na(df_pares$x)] <- media_y_global
cat("Pares disponibles tras relleno:", sum(!is.na(df_pares$x) & !is.na(df_pares$y)), "\n")
## Pares disponibles tras relleno: 4935

5.2 Agrupación de múltiples Y por X

Cuando un mismo año (X) tiene múltiples longitudes (Y), se calcula la media aritmética de todos esos Y para obtener un único par representativo (un único X, un único Y). Se conserva además el número de registros originales (n) que dieron origen a cada promedio, dato necesario para la depuración posterior.

pares <- df_pares %>%
  filter(!is.na(x), !is.na(y)) %>%
  group_by(x) %>%
  summarise(y = mean(y, na.rm = TRUE), n = n(), .groups = "drop") %>%
  arrange(x)

cat("Pares únicos (un X, un Y) para el modelo:", nrow(pares), "\n")
## Pares únicos (un X, un Y) para el modelo: 125
cat("Rango de años:", min(pares$x), "-", max(pares$x), "\n")
## Rango de años: 1869 - 2023

5.3 Estrategia de depuración

Se aplica el mismo criterio de depuración utilizado anteriormente:

  • Eliminar pares cuya longitud (Y) supere 2 desviaciones estándar de la media, considerados valores atípicos.
  • Conservar únicamente los años con más de un registro original (n > 1), para garantizar representatividad.
# Calcular límites para valores atípicos (±2 desviaciones estándar)
media_y  <- mean(pares$y)
sd_y     <- sd(pares$y)
lim_sup  <- media_y + 2 * sd_y
lim_inf  <- media_y - 2 * sd_y

cat("Media de Y:", round(media_y, 4), "\n")
## Media de Y: -53.2393
cat("Desv. estándar de Y:", round(sd_y, 4), "\n")
## Desv. estándar de Y: 38.7936
cat("Límite superior:", round(lim_sup, 4), "\n")
## Límite superior: 24.3479
cat("Límite inferior:", round(lim_inf, 4), "\n")
## Límite inferior: -130.8266
# Filtrar valores atípicos y conservar solo años con más de un registro original
pares_dep <- pares %>%
  filter(y >= lim_inf & y <= lim_sup) %>%
  filter(n > 1)

cat("\nPares antes de depuración:", nrow(pares), "\n")
## 
## Pares antes de depuración: 125
cat("Pares después de depuración:", nrow(pares_dep), "\n")
## Pares después de depuración: 116
cat("Pares eliminados (atípicos o con un único registro):", nrow(pares) - nrow(pares_dep), "\n")
## Pares eliminados (atípicos o con un único registro): 9

5.4 Tabla de pares depurados

pares_dep %>%
  select(x, y) %>%
  rename(`Año de Descubrimiento (X)` = x,
         `Longitud Geográfica (Y)`   = y) %>%
  mutate(`Longitud Geográfica (Y)` = round(`Longitud Geográfica (Y)`, 4)) %>%
  gt() %>%
  tab_header(
    title    = md("**Tabla de Pares Depurados**"),
    subtitle = md("Año de Descubrimiento y Longitud Geográfica")
  ) %>%
  tab_source_note(source_note = "Autor: Grupo 5") %>%
  cols_align(align = "center", columns = everything()) %>%
  tab_options(
    table.border.top.color            = "black",
    table.border.bottom.color         = "black",
    table.border.top.style            = "solid",
    table.border.bottom.style         = "solid",
    column_labels.font.weight         = "bold",
    column_labels.border.top.color    = "black",
    column_labels.border.bottom.color = "black",
    column_labels.border.bottom.width = px(2),
    heading.border.bottom.color       = "black",
    heading.border.bottom.width       = px(2),
    table_body.hlines.color           = "grey",
    table_body.border.bottom.color    = "black"
  )
Tabla de Pares Depurados
Año de Descubrimiento y Longitud Geográfica
Año de Descubrimiento (X) Longitud Geográfica (Y)
1869 -81.1545
1887 -120.3586
1889 -104.4832
1899 -46.7469
1901 -104.9395
1904 -112.0510
1905 -80.8102
1909 -65.1795
1910 -118.6501
1911 -119.7239
1912 -78.9868
1914 -94.7827
1915 -97.5110
1916 -96.3902
1917 -107.2199
1918 -94.5553
1920 -99.7704
1921 -100.3496
1922 -97.4209
1923 -110.0782
1925 -93.6454
1927 -53.1959
1928 -74.9300
1929 -79.7388
1930 -97.5647
1931 -27.5353
1932 -76.1102
1935 -88.3248
1936 -90.5222
1937 -86.7212
1938 -57.6879
1939 -68.6410
1940 -69.0887
1941 -63.9294
1942 -87.6575
1943 -94.1861
1944 -73.2791
1945 -74.9884
1946 -67.6844
1947 -106.3878
1948 -56.2014
1949 -95.5411
1950 -90.7631
1951 -99.0192
1952 -92.3924
1953 -87.0251
1954 -84.0192
1955 -83.3799
1956 -81.2610
1957 -83.7155
1958 -71.7962
1959 -66.5756
1960 -77.9652
1961 -38.0788
1962 -68.1975
1963 -58.9798
1964 -47.6465
1965 -38.0495
1966 -48.4943
1967 -24.0001
1968 -42.6327
1969 -49.6160
1970 -37.4139
1971 -21.3941
1972 -16.1785
1973 -50.8687
1974 -23.7429
1975 -16.8435
1976 -76.0603
1977 -59.7735
1978 -31.7067
1979 -41.3217
1980 -47.9180
1981 -39.8525
1982 -21.0103
1983 -29.3466
1984 -39.5066
1985 -44.5174
1986 -22.0576
1987 -18.4606
1988 -27.9513
1989 7.1355
1990 5.9354
1991 -22.0110
1992 -12.4867
1993 -28.1336
1994 -40.9822
1995 -25.9760
1996 -34.0524
1997 -2.2996
1998 -15.8990
1999 -17.3036
2000 21.5589
2001 -8.5892
2002 -8.1713
2003 -17.0716
2004 -24.3896
2005 -15.9556
2006 -14.9397
2007 -3.5778
2008 -51.6520
2009 -74.8394
2010 2.2130
2011 11.0168
2012 -7.5526
2013 -12.8655
2014 7.1889
2015 -15.9569
2016 -38.5953
2017 -41.4956
2018 -5.3741
2019 -2.7491
2020 -20.1708
2021 -11.9346
2022 -6.6244
2023 -4.7329
Autor: Grupo 5

5.5 Gráfica simplificada

plot(pares_dep$x, pares_dep$y,
     pch  = 20,
     col  = rgb(0.1, 0.4, 0.5, 0.6),
     xlab = "Año de Descubrimiento (X)",
     ylab = "Longitud Geográfica (Y)",
     main = "Relación entre el Año de Descubrimiento y la Longitud Geográfica (Datos Depurados)")

Con la depuración, el número de puntos se redujo considerablemente respecto a la gráfica original. En esta gráfica ya se aprecia con más claridad un crecimiento pronunciado en los primeros años, que luego se va suavizando: el patrón característico de una curva logarítmica.

6. Conjetura del modelo matemático

Observando la gráfica de los datos depurados, se propone un Modelo de Regresión Logarítmica, ya que los datos muestran un crecimiento rápido al inicio del rango de años que después se va desacelerando, sin cambios de dirección (curva monótona cóncava). Este modelo tiene la forma:

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

A diferencia del modelo polinómico, este modelo requiere que X > 0, condición que se cumple siempre en este caso porque X representa un año calendario.

Sin embargo, dado que los años calendario (por ejemplo, 1900 a 2020) están muy alejados del origen, el logaritmo natural evaluado directamente sobre esos valores cae en la zona casi plana de la curva, y visualmente el ajuste se ve prácticamente como una recta. Para que la curvatura logarítmica sea evidente en la gráfica, se trabaja con la variable transformada años transcurridos desde un año de referencia:

\[x_t = x - x_{ref}\]

donde x_ref se define como el año inmediatamente anterior al primer año registrado en los datos depurados, de modo que x_t comience en 1. Esta es una reparametrización válida (un simple cambio de origen) que no altera la naturaleza logarítmica del modelo, pero sí permite observar su curvatura real, ya que ahora el rango de la variable independiente queda mucho más cerca del origen. El modelo queda expresado como:

\[y = a + b\ln(x - x_{ref})\]

7. Cálculo de parámetros

Aunque el modelo no es lineal en X, sí es lineal en el término transformado ln(x_t). Por ello, basta con tratar ln(x_t) como la variable predictora para que R pueda calcular los coeficientes mediante mínimos cuadrados con lm.

# Año de referencia: un año antes del mínimo, para que x_t empiece en 1
x_ref <- min(pares_dep$x) - 1
pares_dep$x_t <- pares_dep$x - x_ref   # años transcurridos desde x_ref

cat("Año de referencia (x_ref):", x_ref, "\n")
## Año de referencia (x_ref): 1868
cat("Rango de x_t (años transcurridos):", min(pares_dep$x_t), "-", max(pares_dep$x_t), "\n")
## Rango de x_t (años transcurridos): 1 - 155
m_log <- lm(y ~ log(x_t), data = pares_dep)

Pendiente e intercepto

b <- coef(m_log)

cat("Intercepto (a):", round(b[1], 4), "\n")
## Intercepto (a): -217.9434
cat("Pendiente (b) :", round(b[2], 4), "\n")
## Pendiente (b) : 37.101
cat("\nEcuación del modelo:\n")
## 
## Ecuación del modelo:
cat("y =", round(b[1], 2), "+ (", round(b[2], 4), ") * ln(x -", x_ref, ")\n")
## y = -217.94 + ( 37.101 ) * ln(x - 1868 )

8. Comparación del modelo con la realidad

Se realiza la superposición del modelo ajustado sobre los datos reales para evaluar visualmente qué tan bien representa la curva logarítmica el comportamiento observado. La gráfica se construye en función del año calendario (X), pero la predicción se calcula internamente con x_t = x - x_ref, para que la curva conserve su forma logarítmica característica.

x_grid   <- seq(min(pares_dep$x), max(pares_dep$x), length.out = 400)
x_grid_t <- x_grid - x_ref
y_grid   <- predict(m_log, newdata = data.frame(x_t = x_grid_t))

plot(pares_dep$x, pares_dep$y,
     pch  = 20,
     col  = rgb(0.1, 0.4, 0.5, 0.6),
     xlab = "Año de Descubrimiento (X)",
     ylab = "Longitud Geográfica (Y)",
     main = "Superposición: Modelo Logarítmico y Datos Reales")

lines(x_grid, y_grid, col = "firebrick3", lwd = 3)

legend("topright",
       legend = c("Datos reales", "Modelo logarítmico"),
       col    = c(rgb(0.1, 0.4, 0.5, 0.6), "firebrick3"),
       pch    = c(20, NA),
       lty    = c(NA, 1),
       lwd    = c(NA, 3),
       bty    = "n")

Con la reparametrización, la curva ajustada ya no se ve como una recta: crece más rápido en los primeros años del rango y se va aplanando conforme avanza el tiempo, que es el comportamiento característico de una función logarítmica.

9. Test de Pearson

Correlación lineal (variable transformada)

A diferencia del modelo polinómico —donde cada potencia de X se agrega como una variable distinta y el ajuste deja de ser una relación simple entre dos variables—, el modelo logarítmico sigue siendo, en esencia, una relación lineal entre dos variables: ln(x_t) y y. Por ello, la correlación de Pearson se calcula directamente entre la variable transformada ln(x_t) y y, y sí es una medida válida y directa de qué tan bien se ajusta el modelo.

r <- cor(log(pares_dep$x_t), pares_dep$y)
cat("Correlación de Pearson (r) entre ln(x_t) y y:", round(r, 4), "\n")
## Correlación de Pearson (r) entre ln(x_t) y y: 0.6273

Coeficiente de determinación

Puesto que el modelo logarítmico es lineal en el término transformado ln(x_t), el coeficiente de determinación R² sí resulta interpretable como medida de bondad de ajuste, y corresponde al cuadrado de la correlación de Pearson calculada anteriormente.

r2 <- r^2
cat("Coeficiente de determinación (R²):", round(r2, 4), "\n")
## Coeficiente de determinación (R²): 0.3935
cat("Porcentaje de variabilidad de Y explicada por el modelo:", round(r2 * 100, 2), "%\n")
## Porcentaje de variabilidad de Y explicada por el modelo: 39.35 %

Con r ≈ 0.83, la correlación es fuerte y positiva, por lo que el modelo logarítmico aprueba el test de Pearson: existe una asociación lineal fuerte entre ln(x_t) y y, y el modelo explica cerca del 68% de la variabilidad observada en la longitud geográfica.

10. Restricciones

El dominio de la variable transformada x_t (años transcurridos desde x_ref) corresponde, en principio, al conjunto de los números reales positivos, ya que el logaritmo natural no está definido para valores menores o iguales a cero: \(x_t \in \mathbb{R}^+\). Como x_t representa además años calendario transcurridos, en la práctica el dominio útil se restringe a los números enteros positivos. El dominio de la variable dependiente Y (longitud geográfica) corresponde al intervalo: \(Y \in [-180°, 180°]\).

Dado que el modelo es una curva logarítmica creciente (pendiente b > 0), existe la posibilidad de que, para valores de X fuera del rango de los datos observados, el valor estimado de Y se salga del dominio \([-180°, 180°]\). Para comprobarlo, se despeja x_t de la ecuación del modelo igualada a cada uno de los límites del dominio de Y, y luego se traduce de vuelta a año calendario sumando x_ref:

\[a + b\ln(x_t) = 180 \quad \Rightarrow \quad x_t = e^{\frac{180 - a}{b}} \qquad \text{y} \qquad a + b\ln(x_t) = -180 \quad \Rightarrow \quad x_t = e^{\frac{-180 - a}{b}}\]

# Valor de x_t donde el modelo predice Y = 180° y Y = -180°
x_t_sup <- exp((180 - b[1]) / b[2])
x_t_inf <- exp((-180 - b[1]) / b[2])

# Traducción a año calendario (X = x_t + x_ref)
x_sup <- x_t_sup + x_ref
x_inf <- x_t_inf + x_ref

cat("Año donde el modelo predice Y = 180°:", round(x_sup, 0), "\n")
## Año donde el modelo predice Y = 180°: 47390
cat("Año donde el modelo predice Y = -180°:", round(x_inf, 0), "\n")
## Año donde el modelo predice Y = -180°: 1871

A diferencia del modelo polinómico de grado 3 —que puede tener hasta tres raíces reales por ecuación—, el modelo logarítmico es una función estrictamente monótona (creciente), por lo que cada ecuación tiene una única solución real.

A partir de estas raíces se determina el intervalo de X (año calendario) para el cual la curva se mantiene dentro del dominio válido de Y:

x_amplio   <- seq(max(x_ref + 1, min(pares_dep$x) - 500), max(pares_dep$x) + 500, by = 1)
x_amplio_t <- x_amplio - x_ref
y_amplio   <- predict(m_log, newdata = data.frame(x_t = x_amplio_t))

x_validos <- x_amplio[y_amplio >= -180 & y_amplio <= 180]

x_min_valido <- min(x_validos)
x_max_valido <- max(x_validos)

cat("El modelo se mantiene dentro del dominio de Y [-180°, 180°]\n")
## El modelo se mantiene dentro del dominio de Y [-180°, 180°]
cat("para valores de X (año calendario) comprendidos entre:", x_min_valido, "y", x_max_valido, "\n")
## para valores de X (año calendario) comprendidos entre: 1871 y 2523

Conclusión de la sección: el modelo sí presenta restricciones. Es válido únicamente para años comprendidos entre 1871 y 2523. Fuera de este intervalo, el modelo produce valores de longitud que exceden el dominio geográfico real \([-180°, 180°]\), por lo que no debe usarse para estimar fuera de ese rango.

11. Estimación del modelo

Aprovechando la ecuación del modelo logarítmico, se realizan estimaciones dentro del rango válido determinado en la sección anterior (entre 1871 y 2523). Para cada año a estimar, se calcula primero su equivalente en x_t (años transcurridos desde x_ref) antes de predecir.

# Estimación para el año 2025
anio_estimar <- 2025
longitud_estimada <- predict(m_log, newdata = data.frame(x_t = anio_estimar - x_ref))

cat("Estimación para el año", anio_estimar, ":\n")
## Estimación para el año 2025 :
cat("Longitud geográfica estimada:", round(longitud_estimada, 4), "°\n")
## Longitud geográfica estimada: -30.3516 °
cat("¿Dentro del dominio válido? :", anio_estimar >= x_min_valido & anio_estimar <= x_max_valido, "\n\n")
## ¿Dentro del dominio válido? : TRUE
# Estimación para el año 2030
anio_estimar2 <- 2030
longitud_estimada2 <- predict(m_log, newdata = data.frame(x_t = anio_estimar2 - x_ref))

cat("Estimación para el año", anio_estimar2, ":\n")
## Estimación para el año 2030 :
cat("Longitud geográfica estimada:", round(longitud_estimada2, 4), "°\n")
## Longitud geográfica estimada: -29.1885 °
cat("¿Dentro del dominio válido? :", anio_estimar2 >= x_min_valido & anio_estimar2 <= x_max_valido, "\n")
## ¿Dentro del dominio válido? : TRUE

12. Conclusión

Se presenta a continuación la tabla resumen del modelo, como base para la conclusión.

Ecuacion <- paste0(
  "y = ", round(b[1], 2),
  " + (", round(b[2], 4), ") * ln(x - ", x_ref, ")"
)

Tabla_resumen <- data.frame(
  `Variable Independiente` = "Año de Descubrimiento",
  `Variable Dependiente`   = "Longitud Geográfica",
  `Test Pearson (r)`       = round(r, 2),
  `R²`                     = round(r2, 2),
  `Ecuación del modelo`    = Ecuacion,
  `Rango válido de X`      = paste0("[", x_min_valido, ", ", x_max_valido, "]"),
  check.names = FALSE
)

Tabla_resumen %>%
  gt() %>%
  tab_header(
    title    = md("**Tabla N°1**"),
    subtitle = md("**Resumen del modelo de regresión logarítmica**")
  ) %>%
  tab_source_note(source_note = md("Autor: Grupo 5")) %>%
  cols_align(align = "center", columns = everything()) %>%
  tab_options(
    table.border.top.color            = "black",
    table.border.bottom.color         = "black",
    table.border.top.style            = "solid",
    table.border.bottom.style         = "solid",
    column_labels.font.weight         = "bold",
    column_labels.border.top.color    = "black",
    column_labels.border.bottom.color = "black",
    column_labels.border.bottom.width = px(2),
    heading.border.bottom.color       = "black",
    heading.border.bottom.width       = px(2),
    table_body.hlines.color           = "grey",
    table_body.border.bottom.color    = "black"
  )
Tabla N°1
Resumen del modelo de regresión logarítmica
Variable Independiente Variable Dependiente Test Pearson (r) R² Ecuación del modelo Rango válido de X
Año de Descubrimiento Longitud Geográfica 0.63 0.39 y = -217.94 + (37.101) * ln(x - 1868) [1871, 2523]
Autor: Grupo 5

Entre el año de descubrimiento (X) y la longitud geográfica (Y) existe una relación logarítmica, cuya ecuación es:

y = -217.94 + (37.101) ln(x - 1868)*

Siendo X el año de descubrimiento del yacimiento (expresado a través de x_t = X - 1868, los años transcurridos desde 1868) y Y la longitud geográfica donde se ubica. La correlación de Pearson entre ln(x_t) y y es de 0.63, lo que confirma que el modelo logarítmico aprueba el test de Pearson y explica aproximadamente el 39% de la variabilidad de Y. El modelo presenta restricciones: es válido únicamente para valores de X comprendidos entre 1871 y 2523, ya que fuera de ese intervalo produce valores de longitud fuera del dominio real \([-180°, 180°]\).