VARIABLE CUANTITATIVA CONTINUA: LATITUD

1. CARGA DE LIBRERIAS Y DATOS

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_nuevoartes.xlsx")

2. DEFINICIÓN DE LA VARIABLE

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

3. 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

4. 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)
  )
)

5. 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)

6. 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)))

7. TABLA DE FRECUENCIAS (SALIDA 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
)

# Agregamos la fila de TOTAL
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 = ""
  )
)

# Mostramos la tabla (aquí R mostrará decimales por defecto según la sesión)
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

8. TABLA DE PRESENTACIÓN

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 2 – 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 2 – Carrera de Geología

9. HISTOGRAMAS

9.1 Histograma local de (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)

10. MODELOS PROBABILÍSTICOS POR AGRUPACIÓN

10.1 Agrupación 1: Latitud (−50° a −20°) – Modelo exponencial

10.1.1 Filtrado de datos

lat_50_20 <- latitude[latitude >= -50 & latitude <= -20]

10.1.2 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)

10.1.3 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)))

10.1.4 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

10.1.5 Histograma y ajuste del modelo exponencial

HistoLat1 <- hist(
  lat_50_20,
  breaks = seq(-50, -20, by = 10),
  freq = TRUE,
  col = "grey",
  main = " Gráfica 2: Modelo de probabilidad exponencial 
  de la variable Latitud entre (−50° a −20°) de los 
  eventos a nivel mundial",
  xlab = "Latitude",
  ylab = "Densidad de probabilidad"
)

Fo_abs <- HistoLat1$counts

ni_adj <- ni_50_20
ni_adj[ni_adj == 0] <- 0.5
ajuste_exp <- lm(log(ni_adj) ~ MC_50_20)
b_est <- coef(ajuste_exp)[2]

x_exp <- seq(-50, -20, length.out = 300)
y_exp <- exp(b_est * x_exp)
y_exp <- y_exp / max(y_exp) * max(ni_50_20)

lines(x_exp, y_exp, col = "red", lwd = 2)

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

10.1.6 Cálculo de frecuencias esperadas

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)

10.1.7 Gráfica de evaluación entre la entre Frecuencia observada y Frecucuencia relativa (Test de Pearson)

pearson_r <- cor(Fo_abs, Fe_abs)
pearson_pct <- pearson_r * 100
pearson_pct

## [1] 99.60892

plot(
  Fo_abs, Fe_abs,
  main = "Gráfica 3: Correlación entre Frecuencia observada y Frecucuencia 
  relativa del Modelo exponencial de la variable Latitud 
  entre (−50° a −20°) a nivel mundial ",
  xlab = "Frecuencia observada",
  ylab = "Frecuencia esperada",
  pch = 19,
  col = "blue3"
)

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

Correlación <- cor(Fo_abs, Fe_abs) * 100
Correlación

## [1] 99.60892

10.1.8 Prueba de Chi-cuadrado

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

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

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

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

## [1] 0.1380221

k_validas <- nrow(tabla_chi_final)
m <- 1
gl <- k_validas - 1 - m
gl

## [1] 1

alpha <- 0.05
chi_crit <- qchisq(1 - alpha, gl)
chi_crit

## [1] 3.841459

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"

x2 < chi_crit

## [1] TRUE

10.1.9.1 Gráfica de probabilidad – 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
}

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"
)

10.1.9.2 Cálculo de probabilidad – Modelo exponencial

¿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 %"

10.1.10 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 <- Correlación 
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	3.8415
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 %"

CONCLUSIONES

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.

10.2 Agrupación 2: Latitud (−20° a 80°) – Modelo lognormal

10.2.1 Filtrado de datos

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

10.2.2 Definición de intervalos

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)

10.2.3 Cálculo de frecuencias

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)))

10.2.4 Tabla de frecuencias

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°) 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°) 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

10.2.5 Histograma y ajuste 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
     de la variable Latitud entre (−20° a 80°)
     de los eventos a nivel mundial",
     xlab="Latitude",
     ylab="Densidad de probabilidad")

# Curva lognormal reflejada

x_ln <- max(lat_20_80)-lat_20_80+0.001
mu_ln <- mean(log(x_ln))
sd_ln <- sd(log(x_ln))

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 <- max(lat_20_80)-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")

10.2.6 Prueba de Pearson

# Frecuencia observada
Fo <- ni_20_80
Fo

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

# Número de clases
h <- length(Fo)

# Límites de clase
Li <- Li_20_80
LS <- LS_20_80

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

# Probabilidades teóricas
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)
}

# Frecuencia esperada
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

10.2.7 Gráfica de evaluación entre Frecuencia observada y Frecuencia relativa (Test de Pearson)

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

abline(lm(Fe ~ Fo), col = "red", lwd = 2)

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

## [1] 97.91097

10.2.8 Prueba de Chi-cuadrado (modelo lognormal)

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

10.2.9 Cálculo de probabilidades (intervalo de latitud)

L_inf <- 10
L_sup <- 40

a <- max(lat_20_80)

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

10.2.10 Gráfica de probabilidad – Modelo lognormal

a <- max(lat_20_80)

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 
  de 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"
)

10.2.10.1 CÁLCULO DE PROBABILIDAD

¿Cuál es la probabilidad de que un evento ocurra en una latitud entre 10° y 40°?

# El cálculo ya fue realizado en el paso 10.2.9 como 'Probabilidad_porcentual'
x <- round(Probabilidad_porcentual, 1)

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

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

10.2.11 Tablas de Resumen Estadístico (Agrupación 2)

# --- PREPARACIÓN DE DATOS ---
sd_lat2      <- sd(lat_20_80)
media_lat2   <- mean(lat_20_80)
n_lat2       <- length(lat_20_80)

# --- 1. TABLA N° 6: RESUMEN DEL TEST DE BONDAD AL MODELO ---
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

# --- 2. TABLA N° 7: 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

10.2.11 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.