VARIABLE CUANTITATIVA CONTINUA: LATITUD

En este documento se presenta el análisis estadístico y probabilístico de los deslizamientos de tierra a nivel global, utilizando la variable Latitud (°) . Se aplican modelos probabilísticos y pruebas estadísticas con el fin de evaluar el comportamiento espacial de los eventos y la adecuación de distintos modelos teóricos.

1. CARGA DE DATOS Y LIBRERÍAS

# Librerías
library(readxl)
library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(gt)
library(knitr)

# Carga de datos
datos <- read_excel("datos_nuevoartes.xlsx")

2. TABLA DE DISTRIBUCIÓN DE FRECUENCIAS

# Definición de la variable
latitude <- datos$latitude
latitude <- latitude[!is.na(latitude)]
n_lat <- length(latitude)

# Parámetros de clasificación
k_lat <- 12
min_lat <- min(latitude)
max_lat <- max(latitude)

R_lat <- max_lat - min_lat
A_real <- R_lat / k_lat

# Ajuste de amplitud
A_lat <- ifelse(
  A_real <= 2, 2,
  ifelse(
    A_real <= 5, 5,
    ifelse(A_real <= 10, 10, ceiling(A_real / 10) * 10)
  )
)

# Definición de clases
Li0 <- floor(min_lat / A_lat) * A_lat
Li_lat <- seq(Li0, by = A_lat, length.out = k_lat)
Ls_lat <- Li_lat + A_lat
MC_lat <- round((Li_lat + Ls_lat) / 2, 2)

# Frecuencias

ni_lat <- numeric(k_lat)

for (i in 1:k_lat) {
  if (i < k_lat) {
    ni_lat[i] <- sum(latitude >= Li_lat[i] & latitude < Ls_lat[i])
  } else {
    ni_lat[i] <- sum(latitude >= Li_lat[i] & latitude <= max_lat)
  }
}

hi_lat <- (ni_lat / sum(ni_lat)) * 100
Ni_asc <- cumsum(ni_lat)
Ni_dsc <- rev(cumsum(rev(ni_lat)))
Hi_asc <- cumsum(hi_lat)
Hi_dsc <- rev(cumsum(rev(hi_lat)))

# Tabla
TDF_latitude <- data.frame(
  Li = Li_lat,
  Ls = Ls_lat,
  MC = MC_lat,
  ni = ni_lat,
  hi = hi_lat,
  Ni_asc = Ni_asc,
  Ni_dsc = Ni_dsc,
  Hi_asc = Hi_asc,
  Hi_dsc = Hi_dsc
)

TDF_latitude <- rbind(
  TDF_latitude,
  data.frame(
    Li = "TOTAL",
    Ls = "",
    MC = "",
    ni = sum(ni_lat),
    hi = 100,
    Ni_asc = "",
    Ni_dsc = "",
    Hi_asc = "",
    Hi_dsc = ""
  )
)

tabla_latitude <- TDF_latitude %>%
  mutate(
    hi = round(as.numeric(hi), 2),
    Hi_asc = round(as.numeric(Hi_asc), 2)
  ) %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N° 1**"),
    subtitle = md("Distribución de frecuencias de Latitude (12 clases)")
  ) %>%
  tab_source_note(
    source_note = md("Elaborado por: Grupo 2 – Carrera de Geología")
  )

tabla_latitude

Tabla N° 1
Distribución de frecuencias de Latitude (12 clases)
Li	Ls	MC	ni	hi	Ni_asc	Ni_dsc	Hi_asc	Hi_dsc
-50	-40	-45	99	0.90	99	11033	0.90	100
-40	-30	-35	147	1.33	246	10934	2.23	99.1026919242273
-30	-20	-25	257	2.33	503	10787	4.56	97.7703253874739
-20	-10	-15	158	1.43	661	10530	5.99	95.4409498776398
-10	0	-5	498	4.51	1159	10372	10.50	94.0088824435784
0	10	5	1015	9.20	2174	9874	19.70	89.4951509109037
10	20	15	1394	12.63	3568	8859	32.34	80.2954772047494
20	30	25	1842	16.70	5410	7465	49.03	67.6606544004351
30	40	35	2554	23.15	7964	5623	72.18	50.9652859603009
40	50	45	2603	23.59	10567	3069	95.78	27.8165503489531
50	60	55	419	3.80	10986	466	99.57	4.22369255868757
60	70	65	47	0.43	11033	47	100.00	0.425994743043596
TOTAL			11033	100.00			NA
Elaborado por: Grupo 2 – Carrera de Geología

3. HISTOGRAMA

hist(
  latitude,
  breaks = k_lat,
  col = "grey",
  main = "Gráfica 5: Histograma de frecuencia absoluta de Latitude",
  xlab = "Latitude (°)",
  ylab = "Densidad de Probabilidad"
)

4. AGRUPACIÓN DE LONGITUD 1 (Intervalo: −50 a −20)

# DATOS BASE – AGRUPACIÓN 1
# Filtrado
lat_50_20 <- latitude[latitude >= -50 & latitude <= -20]

# Histograma BASE (frecuencia absoluta)
HistoLat1 <- hist(
  lat_50_20,
  breaks = seq(-50, -20, by = 10),
  freq = TRUE,
  col = "grey",
  main = "Histograma base – Latitude (−50 a −20)",
  xlab = "Latitude (°)",
  ylab = "Densidad de Probabilidad"
)

# Frecuencias observadas
Fo_abs <- HistoLat1$counts

# Marcas de clase
MC_50_20 <- (HistoLat1$breaks[-length(HistoLat1$breaks)] +
               HistoLat1$breaks[-1]) / 2

4.1 Conjetura del Modelo

Modelo propuesto: Exponencial Variable: Latitud (°)

# Histograma para la conjetura (se vuelve a dibujar SOLO para graficar)
hist(
  lat_50_20,
  breaks = seq(-50, -20, by = 10),
  freq = TRUE,
  col = "grey",
  main = "Gráfica Nº X: Conjetura del modelo exponencial\nLatitud (−50 a −20)",
  xlab = "Latitud (°)",
  ylab = "Densidad de Probabilidad"
)

# Ajuste preliminar del modelo exponencial
Fo_adj <- Fo_abs
Fo_adj[Fo_adj == 0] <- 0.5

ajuste_exp <- lm(log(Fo_adj) ~ MC_50_20)
b_est <- coef(ajuste_exp)[2]

# Curva del modelo
x_exp <- seq(-50, -20, length.out = 400)
y_exp <- exp(b_est * x_exp)
y_exp <- y_exp / max(y_exp) * max(Fo_abs)

# Superposición del modelo
lines(x_exp, y_exp, col = "red", lwd = 3)

legend(
  "topright",
  legend = c("Histograma", "Modelo exponencial"),
  col = c("grey", "red"),
  lwd = c(10, 3),
  bty = "n"
)

A partir del histograma de densidad de la latitud de los intervalos comprendidos entre −50° y −20°, se observa una distribución asimétrica con incremento progresivo hacia los valores superiores del intervalo. Esta forma sugiere un comportamiento compatible con un modelo exponencial creciente, el cual se adopta como conjetura inicial y será evaluado posteriormente mediante los tests de Pearson y Chi-cuadrado.

4.2 Test de Pearson – AGRUPACIÓN 1

# Cálculo de probabilidades por intervalo (modelo exponencial)
f_exp <- function(x) exp(b_est * x)

h <- length(Fo_abs)
P <- numeric(h)

for (i in 1:h) {
  P[i] <- integrate(
    f_exp,
    lower = HistoLat1$breaks[i],
    upper = HistoLat1$breaks[i + 1]
  )$value
}

P <- P / sum(P)

# Frecuencias observadas
Fo_abs <- HistoLat1$counts

# Frecuencias esperadas (modelo exponencial)
Fe_abs <- P * sum(Fo_abs)

# Coeficiente de correlación de Pearson
pearson_r <- cor(Fo_abs, Fe_abs)
pearson_pct <- pearson_r * 100
pearson_pct

## [1] 99.60892

# Gráfica Fo vs Fe
plot(
  Fo_abs, Fe_abs,
  main = "Gráfica Nº X: Correlación Fo vs Fe\nModelo exponencial – Latitud (−50 a −20)",
  xlab = "Frecuencia observada",
  ylab = "Frecuencia esperada",
  pch = 19,
  col = "blue3"
)

abline(lm(Fe_abs ~ Fo_abs), col = "red", lwd = 2)

4.3 Test de Chi-Cuadrado – AGRUPACIÓN 1

# Frecuencias en porcentaje
Fo <- (Fo_abs / sum(Fo_abs)) * 100
Fe <- (Fe_abs / sum(Fe_abs)) * 100

tabla_chi <- data.frame(Fo = Fo, Fe = Fe)

# Reagrupación para cumplir Fe ≥ 5
Fo_r <- c()
Fe_r <- c()
acum_Fo <- 0
acum_Fe <- 0

for (i in 1:nrow(tabla_chi)) {
  acum_Fo <- acum_Fo + tabla_chi$Fo[i]
  acum_Fe <- acum_Fe + tabla_chi$Fe[i]
  
  if (acum_Fe >= 5) {
    Fo_r <- c(Fo_r, acum_Fo)
    Fe_r <- c(Fe_r, acum_Fe)
    acum_Fo <- 0
    acum_Fe <- 0
  }
}

if (acum_Fe > 0) {
  Fo_r[length(Fo_r)] <- Fo_r[length(Fo_r)] + acum_Fo
  Fe_r[length(Fe_r)] <- Fe_r[length(Fe_r)] + acum_Fe
}

tabla_chi_final <- data.frame(Fo = Fo_r, Fe = Fe_r)
tabla_chi_final

##         Fo       Fe
## 1 19.68191 19.20433
## 2 29.22465 30.94199
## 3 51.09344 49.85368

# Estadístico Chi-cuadrado
x2 <- sum((tabla_chi_final$Fo - tabla_chi_final$Fe)^2 /
            tabla_chi_final$Fe)
x2

## [1] 0.1380221

# Grados de libertad
k_validas <- nrow(tabla_chi_final)
m <- 1  # parámetro del modelo exponencial
gl <- k_validas - 1 - m
gl

## [1] 1

# Valor crítico
alpha <- 0.05
chi_crit <- qchisq(1 - alpha, gl)
chi_crit

## [1] 3.841459

# Decisión
if (x2 < chi_crit) {
  "NO se rechaza H0: el modelo exponencial es adecuado"
} else {
  "SE rechaza H0: el modelo exponencial NO es adecuado"
}

## [1] "NO se rechaza H0: el modelo exponencial es adecuado"

4.4 MODELO DE PROBABILIDAD – AGRUPACIÓN 1

Distribución exponencial (−50 a −20)

# Función de densidad exponencial
f_exp <- function(x) exp(b_est * x)

# Constante de normalización en el intervalo
C_exp <- integrate(
  f_exp,
  lower = -50,
  upper = -20
)$value

# Función de densidad normalizada
f_exp_norm <- function(x) {
  f_exp(x) / C_exp
}

# Curva del modelo de probabilidad
x <- seq(-50, -20, length.out = 500)
y <- f_exp_norm(x)

plot(
  x, y,
  type = "l",
  lwd = 2,
  col = "skyblue3",
  main = "Gráfica Nº X: Modelo de probabilidad exponencial\nLatitud (−50 a −20)",
  xlab = "Latitud (°)",
  ylab = "Densidad de probabilidad"
)

# Intervalo de interés
x_sec <- seq(-35, -25, by = 0.01)
y_sec <- f_exp_norm(x_sec)

# Área de probabilidad
polygon(
  c(x_sec, rev(x_sec)),
  c(y_sec, rep(0, length(y_sec))),
  col = rgb(1, 0, 0, 0.6),
  border = NA
)

lines(x_sec, y_sec, col = "red", lwd = 2)

legend(
  "topleft",
  legend = c("Modelo exponencial", "Área de probabilidad"),
  col = c("skyblue3", "red"),
  lwd = 3,
  bty = "n"
)

4.5 Resumen del test de Bondad – AGRUPACIÓN 1

Variable <- c("Latitude (−50 a −20)")

tabla_resumen <- data.frame(
  Variable,
  round(pearson_pct, 2),
  round(x2, 2),
  round(chi_crit, 2)
)

colnames(tabla_resumen) <- c(
  "Variable",
  "Test de Pearson (%)",
  "Chi-cuadrado calculado",
  "Chi-cuadrado crítico"
)

kable(
  tabla_resumen,
  format = "markdown",
  caption = "Tabla Nº X: Resumen de los test de bondad – Modelo exponencial"
)

Tabla Nº X: Resumen de los test de bondad – Modelo exponencial

Variable	Test de Pearson (%)	Chi-cuadrado calculado	Chi-cuadrado crítico
Latitude (−50 a −20)	99.61	0.14	3.84

5. AGRUPACIÓN DE LONGITUD 2 (Intervalo: −20 a 80)

# DATOS BASE – AGRUPACIÓN 2

# Filtrado
lat_20_80 <- latitude[latitude >= -20 & latitude <= 80]

# Histograma BASE
HistoLat2 <- hist(
  lat_20_80,
  breaks = seq(-20, 80, by = 10),
  freq = TRUE,
  col = "grey",
  main = "Histograma base – Latitude (−20 a 80)",
  xlab = "Latitude (°)",
  ylab = "Densidad de Probabilidad"
)

# Frecuencias observadas
Fo2_abs <- HistoLat2$counts

# Marcas de clase
MC_20_80 <- (HistoLat2$breaks[-length(HistoLat2$breaks)] +
               HistoLat2$breaks[-1]) / 2

5.1 Conjetura del Modelo

Modelo propuesto: Lognormal reflejado Variable: Latitud (°)

# Histograma para la conjetura
hist(
  lat_20_80,
  breaks = seq(-20, 80, by = 10),
  freq = TRUE,
  col = "grey",
  main = "Gráfica Nº X: Conjetura del modelo lognormal\nLatitud (−20 a 80)",
  xlab = "Latitud (°)",
  ylab = "Densidad de Probabilidad"
)

# Transformación reflejada
x_ln <- max(lat_20_80) - lat_20_80 + 0.001

# Estimación de parámetros
mu_ln <- mean(log(x_ln))
sd_ln <- sd(log(x_ln))

# Curva lognormal
x_curve <- seq(min(x_ln), max(x_ln), length.out = 400)
y_ln <- dlnorm(x_curve, meanlog = mu_ln, sdlog = sd_ln)
y_ln <- y_ln / max(y_ln) * max(Fo2_abs)

# Transformación inversa para graficar
x_plot <- max(lat_20_80) - x_curve
lines(x_plot, y_ln, col = "blue3", lwd = 3)

legend(
  "topleft",
  legend = c("Histograma", "Modelo lognormal"),
  col = c("grey", "blue3"),
  lwd = c(10, 3),
  bty = "n"
)

La distribución empírica de la latitud en el intervalo −20° a 80° presenta asimetría positiva y concentración progresiva, lo que sugiere un comportamiento compatible con un modelo lognormal reflejado , adoptado como conjetura inicial para su validación estadística.

5.2 Prueba de Pearson – AGRUPACIÓN 2

# Límites de clase
Li <- HistoLat2$breaks[-length(HistoLat2$breaks)]
LS <- HistoLat2$breaks[-1]

# Transformación reflejada de límites
Li_ref <- max(lat_20_80) - LS + 0.001
LS_ref <- max(lat_20_80) - Li + 0.001

# Probabilidades teóricas
h <- length(Fo2_abs)
P2 <- numeric(h)

for (i in 1:h) {
  P2[i] <- plnorm(
    LS_ref[i], meanlog = mu_ln, sdlog = sd_ln
  ) -
    plnorm(
      Li_ref[i], meanlog = mu_ln, sdlog = sd_ln
    )
}

# Frecuencias esperadas
Fe2_abs <- P2 * sum(Fo2_abs)

# Correlación de Pearson
pearson2_r <- cor(Fo2_abs, Fe2_abs)
pearson2_pct <- pearson2_r * 100
pearson2_pct

## [1] 97.90874

# Gráfica Fo vs Fe
plot(
  Fo2_abs, Fe2_abs,
  main = "Gráfica Nº X: Correlación Fo vs Fe\nModelo lognormal – Latitud (−20 a 80)",
  xlab = "Frecuencia observada",
  ylab = "Frecuencia esperada",
  pch = 19,
  col = "blue3"
)

abline(lm(Fe2_abs ~ Fo2_abs), col = "red", lwd = 2)

5.3 Prueba de Chi-Cuadrado – AGRUPACIÓN 2

# Frecuencias porcentuales
Fo <- (Fo2_abs / sum(Fo2_abs)) * 100
Fe <- (Fe2_abs / sum(Fe2_abs)) * 100

tabla_chi <- data.frame(Fo = Fo, Fe = Fe)

# Reagrupación
Fo_r <- c()
Fe_r <- c()
acum_Fo <- 0
acum_Fe <- 0

for (i in 1:nrow(tabla_chi)) {
  acum_Fo <- acum_Fo + tabla_chi$Fo[i]
  acum_Fe <- acum_Fe + tabla_chi$Fe[i]
  
  if (acum_Fe >= 5) {
    Fo_r <- c(Fo_r, acum_Fo)
    Fe_r <- c(Fe_r, acum_Fe)
    acum_Fo <- 0
    acum_Fe <- 0
  }
}

if (acum_Fe > 0) {
  Fo_r[length(Fo_r)] <- Fo_r[length(Fo_r)] + acum_Fo
  Fe_r[length(Fe_r)] <- Fe_r[length(Fe_r)] + acum_Fe
}

tabla_chi_final <- data.frame(Fo = Fo_r, Fe = Fe_r)

# Estadístico
x2_2 <- sum((tabla_chi_final$Fo - tabla_chi_final$Fe)^2 /
              tabla_chi_final$Fe)

# Grados de libertad
k_validas <- nrow(tabla_chi_final)
m <- 2
gl_2 <- k_validas - 1 - m

# Umbral
alpha <- 0.05
chi_crit_2 <- qchisq(1 - alpha, gl_2)

if (x2_2 < chi_crit_2) {
  "NO se rechaza H0: el modelo lognormal es adecuado"
} else {
  "SE rechaza H0: el modelo lognormal NO es adecuado"
}

## [1] "NO se rechaza H0: el modelo lognormal es adecuado"

5.4 MODELO DE PROBABILIDAD – AGRUPACIÓN 2

## 4.5 MODELO DE PROBABILIDAD – AGRUPACIÓN 2
## Distribución lognormal reflejada (−20 a 80)

# Definición del dominio original
x_lat <- seq(-20, 80, length.out = 500)

# Transformación reflejada
x_ref <- max(lat_20_80) - x_lat + 0.001

# Función de densidad lognormal reflejada
f_ln <- dlnorm(
  x_ref,
  meanlog = mu_ln,
  sdlog = sd_ln
)

# Normalización en el intervalo
C_ln <- integrate(
  function(x) {
    dlnorm(
      max(lat_20_80) - x + 0.001,
      meanlog = mu_ln,
      sdlog = sd_ln
    )
  },
  lower = -20,
  upper = 80
)$value

f_ln_norm <- f_ln / C_ln

# Gráfica del modelo de probabilidad
plot(
  x_lat,
  f_ln_norm,
  type = "l",
  lwd = 2,
  col = "skyblue3",
  main = "Gráfica Nº X: Modelo de probabilidad lognormal reflejado\nLatitud (−20 a 80)",
  xlab = "Latitud (°)",
  ylab = "Densidad de probabilidad"
)

# Intervalo de probabilidad
x_sec <- seq(10, 40, by = 0.05)
x_sec_ref <- max(lat_20_80) - x_sec + 0.001
y_sec <- dlnorm(
  x_sec_ref,
  meanlog = mu_ln,
  sdlog = sd_ln
) / C_ln

# Área sombreada
polygon(
  c(x_sec, rev(x_sec)),
  c(y_sec, rep(0, length(y_sec))),
  col = rgb(1, 0, 0, 0.6),
  border = NA
)

lines(x_sec, y_sec, col = "red", lwd = 2)

legend(
  "topright",
  legend = c("Modelo lognormal reflejado", "Área de probabilidad"),
  col = c("skyblue3", "red"),
  lwd = 3,
  bty = "n"
)

5.5 Resumen del Test de Bondad – AGRUPACIÓN 2

Variable <- c("Latitude (−20 a 80)")

tabla_resumen_2 <- data.frame(
  Variable,
  round(pearson2_pct, 2),
  round(x2_2, 2),
  round(chi_crit_2, 2)
)

colnames(tabla_resumen_2) <- c(
  "Variable",
  "Test de Pearson (%)",
  "Chi-cuadrado calculado",
  "Chi-cuadrado crítico"
)

kable(
  tabla_resumen_2,
  format = "markdown",
  caption = "Tabla Nº X: Resumen de los test de bondad – Modelo lognormal"
)

Tabla Nº X: Resumen de los test de bondad – Modelo lognormal

Variable	Test de Pearson (%)	Chi-cuadrado calculado	Chi-cuadrado crítico
Latitude (−20 a 80)	97.91	2.86	9.49

Con base en el modelo lognormal reflejado ajustado para la latitud en el intervalo −20° a 80°, se construye la función de densidad de probabilidad normalizada. Este modelo permite estimar la probabilidad de ocurrencia de tamaños dentro de subintervalos específicos, representados por el área bajo la curva, considerando la asimetría observada en la distribución empírica.

6. TEOREMA DE LÍMITE CENTRAL

Variable: Latitud (°)

# Tamaño muestral
n_N <- length(lat_20_80)

# Media y desviación estándar muestral
media_N <- mean(lat_20_80)
sd_N <- sd(lat_20_80)

# Error estándar de la media
error_estandar_N <- sd_N / sqrt(n_N)

# Intervalo de confianza al 95 %
limit_inf_N <- media_N - 1.96 * error_estandar_N
limit_sup_N <- media_N + 1.96 * error_estandar_N

# Tabla resumen del TLC
tabla_media_norm <- data.frame(
  `Límite inferior` = round(limit_inf_N, 2),
  Variable = "LATITUD (−20 a 80)",
  `Límite superior` = round(limit_sup_N, 2),
  `Error estándar` = round(error_estandar_N, 2)
)

# Presentación de la tabla
kable(
  tabla_media_norm,
  format = "markdown",
  caption = "Tabla Nº X. Intervalo de confianza de la media poblacional (95 %) – Teorema del Límite Central"
)

Tabla Nº X. Intervalo de confianza de la media poblacional (95 %) – Teorema del Límite Central

Límite.inferior	Variable	Límite.superior	Error.estándar
28.29	LATITUD (−20 a 80)	28.92	0.16

Con un nivel de confianza del 95% , se estima que la media poblacional de la latitud de los deslizamientos de tierra se encuentra comprendida entre los límites inferiores y superiores obtenidos. Este resultado es consistente con la aplicación del Teorema del Límite Central, dado el tamaño muestral y la representatividad del intervalo analizado.

7. CONCLUSIÓN

La variable LATITUD presenta comportamientos probabilísticos diferenciados según el intervalo analizado. En la agrupación −50° a −20° , la latitud sigue un modelo de probabilidad exponencial , probando las pruebas de Pearson y Chi-Cuadrado , por lo que el modelo resulta estadísticamente adecuado. De esta manera, fue posible calcular probabilidades, como la ocurrencia de desplazamientos con latitud entre −35° y −25° , a partir del área bajo la curva del modelo ajustado.

Por otro lado, en la agrupación −20° a 80° , la variable latitud sigue un modelo de probabilidad lognormal reflejado , aprobando las pruebas de Pearson y Chi-Cuadrado , lo que permitió estimar probabilidades, como la probabilidad de que la latitud de los lados se encuentre entre 10° y 40° . Además, mediante el Teorema del Límite Central , se determina que la media aritmética poblacional de la latitud se encuentra dentro de un intervalo de confianza del 95% , confirmando la consistencia estadística de los resultados obtenidos.