ESTADÍSTICA INFERENCIAL: VARIABLE LATITUD

1. Librerías 2. Variable 3. Frecuencias

4. Agrupación 1 ▼

4.1 Conjetura del modelo 4.2 Cálculo de parámetros 4.3 Gráfica del modelo 4.4 Test de Pearson y Chi-cuadrado 4.5 Cálculo de probabilidades 4.6 Conclusión

5. Agrupación 2 ▼

5.1 Conjetura del modelo 5.2 Cálculo de parámetros 5.3 Gráfica del modelo 5.4 Test de Pearson y Chi-cuadrado 5.5 Cálculo de probabilidades 5.6 Conclusión

1. CARGA DE 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)

datos <- read_excel("datos_deslizamientos.xlsx")

2. SELECCIÓN DE LA VARIABLE

latitude <- datos$latitude
latitude <- latitude[!is.na(latitude)]
n_lat <- length(latitude)

3. TABLA DE FRECUENCIAS

#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 DE CLASE
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)

#CÁLCULO DE 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 DE FRECUENCIAS SIMPLE
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 = ""
  )
)

TDF_latitude

##       Li  Ls  MC    ni          hi Ni_asc Ni_dsc            Hi_asc
## 1    -50 -40 -45    99   0.8973081     99  11033 0.897308075772682
## 2    -40 -30 -35   147   1.3323665    246  10934  2.22967461252606
## 3    -30 -20 -25   257   2.3293755    503  10787  4.55905012236019
## 4    -20 -10 -15   158   1.4320674    661  10530  5.99111755642164
## 5    -10   0  -5   498   4.5137315   1159  10372  10.5048490890963
## 6      0  10   5  1015   9.1996737   2174   9874  19.7045227952506
## 7     10  20  15  1394  12.6348228   3568   8859  32.3393455995649
## 8     20  30  25  1842  16.6953684   5410   7465  49.0347140396991
## 9     30  40  35  2554  23.1487356   7964   5623  72.1834496510469
## 10    40  50  45  2603  23.5928578  10567   3069  95.7763074413124
## 11    50  60  55   419   3.7976978  10986    466  99.5740052569564
## 12    60  70  65    47   0.4259947  11033     47               100
## 13 TOTAL         11033 100.0000000                                
##               Hi_dsc
## 1                100
## 2   99.1026919242273
## 3   97.7703253874739
## 4   95.4409498776398
## 5   94.0088824435784
## 6   89.4951509109037
## 7   80.2954772047494
## 8   67.6606544004351
## 9   50.9652859603009
## 10  27.8165503489531
## 11  4.22369255868757
## 12 0.425994743043596
## 13

tabla_latitude <- TDF_latitude %>%
  # Aseguramos que todas las columnas sean tratadas como numéricas
  mutate(across(c(ni, hi, Ni_asc, Ni_dsc, Hi_asc, Hi_dsc, MC), as.numeric)) %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N° 1**"),
    subtitle = md("Distribución de frecuencias de la variable Latitud (°) de los eventos a nivel mundial")
  ) %>%
  # 1. Formato de 2 decimales para todas las columnas relativas y marcas de clase
  fmt_number(
    columns = c(hi, Hi_asc, Hi_dsc, MC),
    decimals = 2
  ) %>%
  # 2. Formato de 0 decimales para todas las frecuencias absolutas (asc y desc)
  fmt_number(
    columns = c(ni, Ni_asc, Ni_dsc),
    decimals = 0
  ) %>%
  # 3. Etiquetas de columna (agregando las que faltaban)
  cols_label(
    Li = "Límite inferior (°)",
    Ls = "Límite superior (°)",
    MC = "Marca de clase (°)",
    ni = "ni",
    hi = "hi (%)",
    Ni_asc = "Ni (asc)",
    Ni_dsc = "Ni (desc)",
    Hi_asc = "Hi (asc %)",
    Hi_dsc = "Hi (desc %)"
  ) %>%
  tab_style(
    style = cell_text(weight = "bold"),
    locations = cells_body(rows = Li == "TOTAL")
  ) %>%
  # 4. Limpieza de celdas vacías en la fila TOTAL
  sub_missing(columns = everything(), missing_text = "") %>%
  tab_source_note(
    source_note = md("Elaborado por: Grupo 1 – Carrera de Geología")
  )

tabla_latitude

Tabla N° 1
Distribución de frecuencias de la variable Latitud (°) de los eventos a nivel mundial
Límite inferior (°)	Límite superior (°)	Marca de clase (°)	ni	hi (%)	Ni (asc)	Ni (desc)	Hi (asc %)	Hi (desc %)
-50	-40	−45.00	99	0.90	99	11,033	0.90	100.00
-40	-30	−35.00	147	1.33	246	10,934	2.23	99.10
-30	-20	−25.00	257	2.33	503	10,787	4.56	97.77
-20	-10	−15.00	158	1.43	661	10,530	5.99	95.44
-10	0	−5.00	498	4.51	1,159	10,372	10.50	94.01
0	10	5.00	1,015	9.20	2,174	9,874	19.70	89.50
10	20	15.00	1,394	12.63	3,568	8,859	32.34	80.30
20	30	25.00	1,842	16.70	5,410	7,465	49.03	67.66
30	40	35.00	2,554	23.15	7,964	5,623	72.18	50.97
40	50	45.00	2,603	23.59	10,567	3,069	95.78	27.82
50	60	55.00	419	3.80	10,986	466	99.57	4.22
60	70	65.00	47	0.43	11,033	47	100.00	0.43
TOTAL			11,033	100.00
Elaborado por: Grupo 1 – Carrera de Geología

#Histograma ni
# Configuración de márgenes
par(mar=c(5, 4, 4, 2))

# 1. Identificamos el máximo real de ni_lat
max_ni_lat_local <- max(ni_lat)

# 2. Graficamos Local (ni) sin ejes automáticos
pos_x <- barplot(ni_lat, 
                 col = "grey", 
                 border = "black", 
                 space = 0, 
                 las = 1, 
                 ylim = c(0, max_ni_lat_local),
                 yaxt = "n",
                 main = "Gráfica 1: Distribución local de la frecuencia absoluta\nde la variable Latitud (°) de los eventos a nivel mundial", 
                 xlab = "Latitud (°)",
                 ylab = "Frecuencia absoluta (ni)")

# 3. Eje Y manual (sin decimales)
ticks_y_l <- round(seq(0, max_ni_lat_local, length.out = 5), 0)
axis(side = 2, at = ticks_y_l, labels = ticks_y_l, las = 1)

# 4. Eje X en las intersecciones (Límites de clase)
# Usamos Li_lat y el último Ls_lat
axis(side = 1, at = 0:length(ni_lat), labels = c(Li_lat, max(Ls_lat)), cex.axis = 0.7)

4. AGRUPACIÓN 1: LATITUD ENTRE −50° Y −20°

4.1 CONJETURA DEL MODELO EXPONENCIAL

La distribución de las frecuencias de la variable latitud entre −50° y −20° presenta una tendencia decreciente. Por esta razón, se plantea como conjetura que los datos pueden ajustarse a un modelo de probabilidad exponencial.

#Filtro de datos
lat_50_20 <- latitude[latitude >= -50 & latitude <= -20]
#Intervalos
Li_50_20 <- seq(-50, -30, by = 10)
LS_50_20 <- Li_50_20 + 10
MC_50_20 <- (Li_50_20 + LS_50_20) / 2
k_50_20 <- length(Li_50_20)
#Frecuencias
ni_50_20 <- numeric(k_50_20)

for (i in 1:k_50_20) {
  if (i < k_50_20) {
    ni_50_20[i] <- sum(lat_50_20 >= Li_50_20[i] & lat_50_20 < LS_50_20[i])
  } else {
    ni_50_20[i] <- sum(lat_50_20 >= Li_50_20[i] & lat_50_20 <= -20)
  }
}

hi_50_20 <- (ni_50_20 / sum(ni_50_20)) * 100
NI_50_20 <- cumsum(ni_50_20)
NID_50_20 <- rev(cumsum(rev(ni_50_20)))
HI_50_20 <- cumsum(hi_50_20)
HID_50_20 <- rev(cumsum(rev(hi_50_20)))

#Tabla de frecuencias
Tabla_50_20 <- data.frame(
  Li  = Li_50_20,
  LS  = LS_50_20,
  MC  = MC_50_20,
  ni  = ni_50_20,
  hi  = round(hi_50_20, 2),
  NI  = NI_50_20,
  NID = NID_50_20,
  HI  = round(HI_50_20, 2),
  HID = round(HID_50_20, 2)
)

tabla_gt_50_20 <- Tabla_50_20 %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N° 2**"),
    subtitle = md("Distribución de frecuencias de la variable 
                  Latitud entre (−50° a −20°) de los eventos a nivel mundial")
  ) %>%
  fmt_number(columns = c(hi, HI, HID), decimals = 2) %>%
  tab_source_note(
    source_note = md("Elaborado por: Grupo 2 – Carrera de Geología")
  )

tabla_gt_50_20

Tabla N° 2
Distribución de frecuencias de la variable Latitud entre (−50° a −20°) de los eventos a nivel mundial
Li	LS	MC	ni	hi	NI	NID	HI	HID
-50	-40	-45	99	19.68	99	503	19.68	100.00
-40	-30	-35	147	29.22	246	404	48.91	80.32
-30	-20	-25	257	51.09	503	257	100.00	51.09
Elaborado por: Grupo 2 – Carrera de Geología

# El histograma permite observar la forma de la distribución
# antes de superponer cualquier modelo probabilístico.

par(mar = c(5, 4, 4, 2))

hist(
  lat_50_20,
  
  breaks = seq(-50, -20, by = 10),
  
  freq = TRUE,
  
  col = "grey",
  
  border = "black",
  
  main = "Gráfica Nº 2: Distribución de frecuencias de la variable\nLatitud entre (-50° y -20°)",
  
  xlab = "Latitud (°)",
  
  ylab = "Frecuencia absoluta (ni)"
)

4.2 CÁLCULO DE PARÁMETROS

# Frecuencias observadas de la nueva agrupación
Fo_abs <- ni_50_20

# Para poder aplicar el logaritmo se reemplazan los ceros
# por un valor pequeño
ni_adj <- ni_50_20

ni_adj[ni_adj == 0] <- 0.5

# Ajuste del modelo exponencial
ajuste_exp <- lm(
  log(ni_adj) ~ MC_50_20
)

# Parámetro del modelo exponencial
b_est <- coef(
  ajuste_exp
)[2]

# Mostrar el parámetro calculado
b_est

##   MC_50_20 
## 0.04769781

4.3 GRÁFICA DEL MODELO EXPONENCIAL

# Histograma de las frecuencias observadas
HistoLat1 <- hist(
  lat_50_20,
  
  breaks = seq(
    -50,
    -20,
    by = 10
  ),
  
  freq = TRUE,
  col = "grey",
  border = "black",
  main = "Gráfica Nº 3: Modelo de probabilidad exponencial\n
  de la variable Latitud entre (-50° y -20°)",
  xlab = "Latitud (°)",
  ylab = "Frecuencia absoluta (ni)"
)
# Función del modelo exponencial ajustado
f_exp <- function(x) {
  exp(
    b_est * x
  )
}

# Valores del eje X para construir la curva
x_exp <- seq(
  -50,
  -20,
  length.out = 300
)

# Valores teóricos del modelo
y_exp <- f_exp(
  x_exp
)

# Ajuste de escala de la curva al histograma
y_exp <- y_exp /
  
  max(y_exp) *
  
  max(ni_50_20)

# Superposición de la curva exponencial
lines(
  
  x_exp,
  y_exp,
  
  col = "red",
  
  lwd = 2
)

# Leyenda
legend(
  
  "topleft",
  
  legend = c(
    
    "Frecuencia observada",
    "Modelo exponencial"
    
  ),
  
  col = c(
    
    "grey",
    "red"
    
  ),
  
  lwd = c(
    
    10,
    2
    
  ),
  
  bty = "n"
)

4.4 TEST DE PEARSON Y CHI-CUADRADO

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)

Fe_abs <- P * sum(Fo_abs)

Fo <- (Fo_abs / sum(Fo_abs)) * 100
Fe <- (Fe_abs / sum(Fe_abs)) * 100

Correlacion <- cor(Fo, Fe) * 100
Correlacion

## [1] 99.60892

plot(Fo, Fe, xlim = c(0, max(Fo)), ylim = c(0, max(Fe)),
  
  main = "Gráfica 3: Correlación de frecuencias",
  xlab = "Frecuencia observada (%)",
  ylab = "Frecuencia esperada (%)",
  pch = 19,
  col = "darkblue"
)

lines(
  c(0, max(c(Fo, Fe))),
  c(0, max(c(Fo, Fe))),
  col = "red",
  lwd = 2
)

#Chi-cuadrado
x2 <- sum(
  (
    Fo - Fe
  )^2 /
    Fe
)

gl <- length(
  Fo
) - 1

alpha <- 0.05

chi_crit <- qchisq(
  1 - alpha,
  gl
)

x2

## [1] 0.1380221

gl

## [1] 2

chi_crit

## [1] 5.991465

x2 < chi_crit

## [1] TRUE

#Grafica de probalidades
f_exp <- function(x) exp(b_est * x)

C_exp <- integrate(f_exp, lower = -50, upper = -20)$value

f_exp_norm <- function(x) {
  f_exp(x) / C_exp
}

x <- seq(-50, -20, length.out = 500)
y <- f_exp_norm(x)

plot(
  x, y,
  type = "l",
  lwd = 2,
  col = "skyblue3",
  main = "Gráfica 4: Cálculo de probabilidades – Modelo exponencial de 
  la variable Latitud entre (−50 a −20) a nivel mundial",
  xlab = "Latitude (°)",
  ylab = "Densidad de probabilidad"
)

x_sec <- seq(-35, -25, by = 0.01)
y_sec <- f_exp_norm(x_sec)

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 = 4,
  bty = "n"
)

4.5 CÁLCULO DE PROBABILIDADES

¿Cuál es la probabilidad de que un evento ocurra en una latitud entre −35° y −25°?

# Cálculo basado en la Gráfica 4 (Modelo exponencial)
f_exp <- function(x) exp(b_est * x)
C_exp <- integrate(f_exp, lower = -50, upper = -20)$value
f_exp_norm <- function(x) { f_exp(x) / C_exp }

# Probabilidad del área roja (-35 a -25)
prob_decimal <- integrate(f_exp_norm, lower = -35, upper = -25)$value
x <- round(prob_decimal * 100, 1)

print(paste("La probabilidad es de:", x, "%"))

## [1] "La probabilidad es de: 39.3 %"

#Tablas de Resumen Estadístico (Formato GT)
# --- PREPARACIÓN DE DATOS ---
sd_N      <- sd(lat_50_20)
media_N   <- mean(lat_50_20)
n_N       <- length(lat_50_20)
correlacion_N <- Correlacion 
x2_N      <- x2            
umbral_N  <- chi_crit      

# --- 1. TABLA N° 3: RESUMEN DEL TEST DE BONDAD AL MODELO ---
tabla_resumen_norm <- data.frame(
  Variable = "Latitud (−50° a −20°)",
  Pearson = correlacion_N,
  Chi_cuadrado = x2_N,
  Umbral = umbral_N
)

tabla_gt_bondad <- tabla_resumen_norm %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N° 3**"),
    subtitle = md("Resumen del test de bondad al modelo Exponencial")
  ) %>%
  cols_label(
    Variable = "Variable",
    Pearson = "Test de Pearson (%)",
    Chi_cuadrado = "Chi-cuadrado (f. relativa)",
    Umbral = "Umbral de aceptación"
  ) %>%
  fmt_number(columns = Pearson, decimals = 2) %>%
  fmt_number(columns = c(Chi_cuadrado, Umbral), decimals = 4) %>%
  tab_source_note(source_note = md("Elaborado por: Grupo 2 – Carrera de Geología"))

tabla_gt_bondad

Tabla N° 3
Resumen del test de bondad al modelo Exponencial
Variable	Test de Pearson (%)	Chi-cuadrado (f. relativa)	Umbral de aceptación
Latitud (−50° a −20°)	99.61	0.1380	5.9915
Elaborado por: Grupo 2 – Carrera de Geología

# --- 2. TABLA N° 4: TEOREMA DEL LÍMITE CENTRAL ---
error_estandar_N <- sd_N / sqrt(n_N)
limit_inf_N <- media_N - 1.96 * error_estandar_N
limit_sup_N <- media_N + 1.96 * error_estandar_N

tabla_media_norm <- data.frame(
  Limite_inf = limit_inf_N,
  Variable = "Latitud (−50° a −20°)",
  Limite_sup = limit_sup_N,
  Error_estandar = error_estandar_N
)

tabla_gt_limite <- tabla_media_norm %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N° 4**"),
    subtitle = md("Cálculo del Error Estándar para el Modelo Exponencial")
  ) %>%
  cols_label(
    Limite_inf = "Límite inferior",
    Variable = "Variable",
    Limite_sup = "Límite superior",
    Error_estandar = "Error estándar"
  ) %>%
  fmt_number(columns = everything(), decimals = 2) %>%
  tab_source_note(source_note = md("Elaborado por: Grupo 2 – Carrera de Geología"))

tabla_gt_limite

Tabla N° 4
Cálculo del Error Estándar para el Modelo Exponencial
Límite inferior	Variable	Límite superior	Error estándar
−31.78	Latitud (−50° a −20°)	−30.36	0.36
Elaborado por: Grupo 2 – Carrera de Geología

# 1. Definimos la función del modelo basada en tus cálculos previos
f_exp <- function(x) exp(b_est * x)

# 2. Calculamos la constante de normalización para el rango del grupo (-50 a -20)
C_exp <- integrate(f_exp, lower = -50, upper = -20)$value

# 3. Definimos la función de densidad normalizada
f_exp_norm <- function(x) { f_exp(x) / C_exp }

# 4. Integramos en el rango de interés: -35 a -25
prob_decimal <- integrate(f_exp_norm, lower = -35, upper = -25)$value

# 5. Convertimos a porcentaje y redondeamos (siguiendo el formato de la captura)
x <- round(prob_decimal * 100, 1)

# 6. Impresión del resultado final
print(paste("La probabilidad es de:", x, "%"))

## [1] "La probabilidad es de: 39.3 %"

4.6 CONCLUSIÓN DEL MODELO EXPONENCIAL

La variable LATITUD ENTRE (−50° a −20°) sigue un modelo de probabilidad eponencial, aprobando los test de Pearson (99.61%) y Chi-cuadrado (0.1380) con un umbral de aceptación de 3.2415. De esta manera, es posible calcular probabilidades; por ejemplo, la probabilidad de que un evento ocurra en una latitud comprendida entre −35° y −25° es del 39.3%. Además, mediante el teorema del límite central, se determina que la media aritmética poblacional se encuentra entre −31.78° y −30.36°, con un error estándar de 0.36.

5. AGRUPACIÓN 2: LATITUD ENTRE −20° Y 80°

5.1 CONJETURA DEL MODELO LOGNORMAL

# ============================================================
# 5. AGRUPACIÓN 2
# LATITUD (-20° A 80°)
# MODELO LOGNORMAL
# ============================================================

# ============================================================
# 5.1 SELECCIÓN DE LA SUBMUESTRA
# ============================================================

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

# ============================================================
# 5.2 TABLA DE FRECUENCIAS DE LA AGRUPACIÓN
# ============================================================

Li_20_80 <- seq(-20, 70, by = 10)
LS_20_80 <- Li_20_80 + 10
MC_20_80 <- (Li_20_80 + LS_20_80) / 2
k_20_80 <- length(Li_20_80)

ni_20_80 <- numeric(k_20_80)

for (i in 1:k_20_80) {
  if (i < k_20_80) {
    ni_20_80[i] <- sum(lat_20_80 >= Li_20_80[i] & lat_20_80 < LS_20_80[i])
  } else {
    ni_20_80[i] <- sum(lat_20_80 >= Li_20_80[i] & lat_20_80 <= 80)
  }
}

hi_20_80 <- (ni_20_80 / sum(ni_20_80)) * 100
NI_20_80 <- cumsum(ni_20_80)
NID_20_80 <- rev(cumsum(rev(ni_20_80)))
HI_20_80 <- cumsum(hi_20_80)
HID_20_80 <- rev(cumsum(rev(hi_20_80)))

Tabla_20_80 <- data.frame(
  Li = Li_20_80,
  LS = LS_20_80,
  MC = MC_20_80,
  ni = ni_20_80,
  hi = round(hi_20_80, 2),
  NI = NI_20_80,
  NID = NID_20_80,
  HI = round(HI_20_80, 2),
  HID = round(HID_20_80, 2)
)

tabla_gt_20_80 <- Tabla_20_80 %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N° 5**"),
    subtitle = md("Distribución de frecuencias de la variable Latitud entre (−20° a 80°) de los eventos a nivel mundial")
  ) %>%
  fmt_number(columns = c(hi, HI, HID), decimals = 2) %>%
  tab_source_note(source_note = md("Elaborado por: Grupo 2"))

tabla_gt_20_80

Tabla N° 5
Distribución de frecuencias de la variable Latitud entre (−20° a 80°) de los eventos a nivel mundial
Li	LS	MC	ni	hi	NI	NID	HI	HID
-20	-10	-15	158	1.50	158	10530	1.50	100.00
-10	0	-5	498	4.73	656	10372	6.23	98.50
0	10	5	1015	9.64	1671	9874	15.87	93.77
10	20	15	1394	13.24	3065	8859	29.11	84.13
20	30	25	1842	17.49	4907	7465	46.60	70.89
30	40	35	2554	24.25	7461	5623	70.85	53.40
40	50	45	2603	24.72	10064	3069	95.57	29.15
50	60	55	419	3.98	10483	466	99.55	4.43
60	70	65	45	0.43	10528	47	99.98	0.45
70	80	75	2	0.02	10530	2	100.00	0.02
Elaborado por: Grupo 2

# ============================================================
# 5.3 CONJETURA DEL MODELO
# ============================================================

# La variable latitud corresponde a una variable cuantitativa continua.
#
# Para el análisis probabilístico se seleccionó el intervalo comprendido entre -20° y 80°.
#
# Debido a que la latitud contiene valores negativos, se realiza una transformación reflejada para poder aplicar el modelo lognormal.
#
# La transformación utilizada es:
#
# X_transformada = máximo - latitud + 0.001
#
# Esta transformación permite trabajar con valores positivos, conservando el orden de los datos.
#
# La distribución transformada presenta una forma asimétrica, por lo que se plantea como conjetura que puede ajustarse a una distribución lognormal.
#
# H0: La distribución de la latitud entre -20° y 80° se ajusta a un modelo lognormal.
#
# H1: La distribución de la latitud entre -20° y 80° no se ajusta a un modelo lognormal.

# ============================================================
# 5.4 TRANSFORMACIÓN DE LA VARIABLE
# ============================================================

a <- max(lat_20_80)
x_ln <- a - lat_20_80 + 0.001

# ============================================================
# 5.5 CÁLCULO DE PARÁMETROS
# ============================================================

mu_ln <- mean(log(x_ln))
sd_ln <- sd(log(x_ln))

mu_ln

## [1] 3.713388

sd_ln

## [1] 0.3951638

# ============================================================
# 5.6 MODELO LOGNORMAL
# ============================================================

# ============================================================
# 5.7 GRÁFICA
# HISTOGRAMA Y CURVA DEL MODELO LOGNORMAL
# ============================================================

hist(
  lat_20_80,
  breaks = seq(-20, 80, by = 10),
  freq = TRUE,
  col = "grey",
  main = "Gráfica 5: Modelo de probabilidad lognormal\nde la variable Latitud entre (−20° a 80°)\nde los eventos a nivel mundial",
  xlab = "Latitude",
  ylab = "Densidad de probabilidad"
)

x_curve <- seq(min(x_ln), max(x_ln), length.out = 300)

y_ln <- dlnorm(
  x_curve,
  meanlog = mu_ln,
  sdlog = sd_ln
)

y_ln <- y_ln / max(y_ln) * max(ni_20_80)
x_plot <- a - x_curve

lines(x_plot, y_ln, col = "blue", lwd = 2)

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

# ============================================================
# 5.8 FRECUENCIAS OBSERVADAS
# ============================================================

Fo <- ni_20_80
Fo

##  [1]  158  498 1015 1394 1842 2554 2603  419   45    2

# ============================================================
# 5.9 PROBABILIDADES TEÓRICAS
# ============================================================

h <- length(Fo)
Li <- Li_20_80
LS <- LS_20_80

Li_ref <- a - LS + 0.001
LS_ref <- a - Li + 0.001

P <- numeric(h)

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

# ============================================================
# 5.10 FRECUENCIAS ESPERADAS
# ============================================================

Fe <- P * sum(Fo)
Fe

##  [1] 1.946451e+02 3.774608e+02 7.144347e+02 1.283103e+03 2.074053e+03
##  [6] 2.712944e+03 2.268862e+03 6.833562e+02 1.519594e+01 1.903125e-08

# ============================================================
# 5.11 TEST DE PEARSON
# ============================================================

pearson_r <- cor(Fo, Fe)
pearson_pct <- pearson_r * 100
pearson_pct

## [1] 97.91097

# ============================================================
# 5.12 GRÁFICA DE CORRELACIÓN
# ============================================================

plot(
  Fo,
  Fe,
  xlim = c(0, max(Fo, Fe)),
  ylim = c(0, max(Fo, Fe)),
  main = "Gráfica 6: Correlación entre Frecuencia observada y Frecuencia esperada\ndel Modelo lognormal de la variable Latitud entre (−20° a 80°)\na nivel mundial",
  xlab = "Frecuencia observada",
  ylab = "Frecuencia esperada",
  pch = 19,
  col = "blue3"
)

# Línea de referencia y = x que pasa por el origen (0,0)

lines(
  c(0, max(Fo, Fe)),
  c(0, max(Fo, Fe)),
  col = "red",
  lwd = 2
)

Correlación <- cor(Fo, Fe) * 100
Correlación

## [1] 97.91097

# ============================================================
# 5.13 PRUEBA DE CHI-CUADRADO
# ============================================================

Fo <- (ni_20_80 / sum(ni_20_80)) * 100
Fe <- P * 100

tabla_chi <- data.frame(
  Clase = 1:length(Fo),
  Fo = Fo,
  Fe = Fe
)

tabla_chi

##    Clase          Fo           Fe
## 1      1  1.50047483 1.848482e+00
## 2      2  4.72934473 3.584623e+00
## 3      3  9.63912631 6.784755e+00
## 4      4 13.23836657 1.218521e+01
## 5      5 17.49287749 1.969661e+01
## 6      6 24.25451092 2.576395e+01
## 7      7 24.71984805 2.154665e+01
## 8      8  3.97910731 6.489612e+00
## 9      9  0.42735043 1.443109e-01
## 10    10  0.01899335 1.807336e-10

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  6.229820  5.433105
## 2  9.639126  6.784755
## 3 13.238367 12.185212
## 4 17.492877 19.696612
## 5 24.254511 25.763949
## 6 24.719848 21.546649
## 7  4.425451  6.633923

x2 <- sum(
  (tabla_chi_final$Fo - tabla_chi_final$Fe)^2 /
    tabla_chi_final$Fe
)

x2

## [1] 2.946228

k_validas <- nrow(tabla_chi_final)
m <- 2
grados_libertad <- k_validas - 1 - m

grados_libertad

## [1] 4

nivel_significancia <- 0.05

umbral_aceptacion <- qchisq(
  1 - nivel_significancia,
  grados_libertad
)

umbral_aceptacion

## [1] 9.487729

if (x2 < umbral_aceptacion) {
  "NO se rechaza H0: el modelo lognormal es estadísticamente adecuado"
} else {
  "SE rechaza H0: el modelo lognormal NO es adecuado"
}

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

x2 < umbral_aceptacion

## [1] TRUE

# ============================================================
# 5.14 GRÁFICA DE PROBABILIDAD
# ============================================================

L_inf <- 10
L_sup <- 40

L_inf_ref <- a - L_sup
L_sup_ref <- a - L_inf

P_intervalo <- plnorm(
  L_sup_ref,
  meanlog = mu_ln,
  sdlog = sd_ln
) -
  plnorm(
    L_inf_ref,
    meanlog = mu_ln,
    sdlog = sd_ln
  )

P_total <- plnorm(
  a - (-20),
  meanlog = mu_ln,
  sdlog = sd_ln
) -
  plnorm(
    a - 80,
    meanlog = mu_ln,
    sdlog = sd_ln
  )

Probabilidad_porcentual <- (P_intervalo / P_total) * 100

Probabilidad_porcentual

## [1] 58.79752

# ============================================================
# 5.15 CÁLCULO DE PROBABILIDADES
# ============================================================

x <- round(Probabilidad_porcentual, 1)

print(
  paste(
    "La probabilidad de que un evento ocurra entre 10° y 40° es de:",
    x,
    "%"
  )
)

## [1] "La probabilidad de que un evento ocurra entre 10° y 40° es de: 58.8 %"

# ============================================================
# 5.16 GRÁFICA DEL CÁLCULO DE PROBABILIDADES
# ============================================================

x_ref <- seq(
  min(x_ln),
  max(x_ln),
  length.out = 500
)

y_ln <- dlnorm(
  x_ref,
  meanlog = mu_ln,
  sdlog = sd_ln
)

x_plot <- a - x_ref

plot(
  x_plot,
  y_ln,
  type = "l",
  lwd = 2,
  col = "blue3",
  main = "Gráfica 7: Cálculo de probabilidades – Modelo lognormal\nde la variable Latitud entre (−20° a 80°) a nivel mundial",
  xlab = "Latitude (°)",
  ylab = "Densidad de probabilidad"
)

x_sec <- seq(
  10,
  40,
  by = 0.1
)

x_sec_ref <- a - x_sec

y_sec <- dlnorm(
  x_sec_ref,
  meanlog = mu_ln,
  sdlog = sd_ln
)

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 lognormal",
    "Área de probabilidad"
  ),
  col = c(
    "blue3",
    "red"
  ),
  lwd = 2,
  bty = "n"
)

# ============================================================
# 5.17 TABLA RESUMEN DEL TEST DE BONDAD
# ============================================================

sd_lat2 <- sd(lat_20_80)
media_lat2 <- mean(lat_20_80)
n_lat2 <- length(lat_20_80)

tabla_resumen_lognorm <- data.frame(
  Variable = "Latitud (−20° a 80°)",
  Pearson = Correlación,
  Chi_cuadrado = x2,
  Umbral = umbral_aceptacion
)

tabla_gt_bondad_2 <- tabla_resumen_lognorm %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N° 6**"),
    subtitle = md("Resumen del test de bondad al modelo Lognormal")
  ) %>%
  cols_label(
    Variable = "Variable",
    Pearson = "Test de Pearson (%)",
    Chi_cuadrado = "Chi-cuadrado (f. relativa)",
    Umbral = "Umbral de aceptación"
  ) %>%
  fmt_number(
    columns = Pearson,
    decimals = 2
  ) %>%
  fmt_number(
    columns = c(Chi_cuadrado, Umbral),
    decimals = 4
  ) %>%
  tab_source_note(
    source_note = md("Elaborado por: Grupo 2 – Carrera de Geología")
  )

tabla_gt_bondad_2

Tabla N° 6
Resumen del test de bondad al modelo Lognormal
Variable	Test de Pearson (%)	Chi-cuadrado (f. relativa)	Umbral de aceptación
Latitud (−20° a 80°)	97.91	2.9462	9.4877
Elaborado por: Grupo 2 – Carrera de Geología

# ============================================================
# 5.18 TEOREMA DEL LÍMITE CENTRAL
# ============================================================

error_estandar_lat2 <- sd_lat2 / sqrt(n_lat2)

limit_inf_lat2 <- media_lat2 -
  1.96 * error_estandar_lat2

limit_sup_lat2 <- media_lat2 +
  1.96 * error_estandar_lat2

tabla_media_lognorm <- data.frame(
  Limite_inf = limit_inf_lat2,
  Variable = "Latitud (−20° a 80°)",
  Limite_sup = limit_sup_lat2,
  Error_estandar = error_estandar_lat2
)

tabla_gt_limite_2 <- tabla_media_lognorm %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N° 7**"),
    subtitle = md("Cálculo del Error Estándar para el Modelo Lognormal")
  ) %>%
  cols_label(
    Limite_inf = "Límite inferior",
    Variable = "Variable",
    Limite_sup = "Límite superior",
    Error_estandar = "Error estándar"
  ) %>%
  fmt_number(
    columns = everything(),
    decimals = 2
  ) %>%
  tab_source_note(
    source_note = md("Elaborado por: Grupo 2 – Carrera de Geología")
  )

tabla_gt_limite_2

Tabla N° 7
Cálculo del Error Estándar para el Modelo Lognormal
Límite inferior	Variable	Límite superior	Error estándar
28.29	Latitud (−20° a 80°)	28.92	0.16
Elaborado por: Grupo 2 – Carrera de Geología

CONCLUSIÓN

La variable LATITUD ENTRE (−20° a 80°)sigue un modelo de probabilidad log-normal, aprobando los test de Pearson (97.91%) y Chi-cuadrado (2.9462) con un umbral de aceptación de 9.4877. De esta manera, se pueden estimar probabilidades; por ejemplo, la probabilidad de que un evento ocurra en una latitud comprendida entre 10° y 40° es del 58.8%. Además, mediante el teorema del límite central, se establece que la media aritmética poblacional se encuentra entre 28.29° y 28.92°, con un error estándar de 0.16. ```