0. Librerías 1. Datos 2. Variable 3. Tabla de frecuencias 4. Gráfica de frecuencias 5. Conjetura 6. Parámetros 7. Sobreposición lognormal 8. Test de bondad 9. Probabilidades 10. Intervalo de confianza 11. Conclusión

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

1.- CARGA DE DATOS

datos <- read_excel("dataset_deslizamientos.xlsx")

2.- SELECCIONAR VARIABLE

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

# Selección de la submuestra
lat_20_80 <- latitude[
  latitude >= -20 &
  latitude <= 80
]

3.- TABLA DE FRECUENCIA

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_options(
    table.width = pct(100)
  ) %>%
  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

4.- GRÁFICA DE DISTRIBUCIÓN DE FRECUENCIA

hist(
  lat_20_80,

  breaks = seq(
    -20,
    80,
    by = 10
  ),

  freq = TRUE,

  col = "#D8C3CA",

  border = "#4A1026",

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

5.- CONJETURA

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.

6.- PARÁMETROS

# Transformación de la variable
a <- max(
  lat_20_80
)

x_ln <- a -
  lat_20_80 +
  0.001

# 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

7.- SOBREPOSICIÓN DE LA REALIDAD CON EL MODELO LOGNORMAL

hist(
  lat_20_80,

  breaks = seq(
    -20,
    80,
    by = 10
  ),

  freq = TRUE,

  col = "#D8C3CA",

  border = "#4A1026",

  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 = "#6D213C",

  lwd = 2
)

legend(
  "topleft",

  legend = c(
    "Histograma",
    "Modelo lognormal"
  ),

  col = c(
    "#D8C3CA",
    "#6D213C"
  ),

  lwd = c(
    10,
    4
  ),

  bty = "n"
)

8.- TEST DE BONDAD

# Frecuencias observadas
Fo <- ni_20_80

Fo
##  [1]  158  498 1015 1394 1842 2554 2603  419   45    2
# 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
    )

}

# 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
# Test de Pearson
pearson_r <- cor(
  Fo,
  Fe
)

pearson_pct <- pearson_r *
  100

pearson_pct
## [1] 97.91097
# 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 = "#4A1026"
)

# Línea de referencia y = x
lines(
  c(
    0,
    max(Fo, Fe)
  ),

  c(
    0,
    max(Fo, Fe)
  ),

  col = "#6D213C",

  lwd = 2
)

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

Correlación
## [1] 97.91097
# 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
# Tabla resumen del test de bondad
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_options(
    table.width = pct(100)
  ) %>%
  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

9.- CÁLCULO DE PROBABILIDADES

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
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 %"
# 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 = "#B56A7D",

  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(
    109 / 255,
    33 / 255,
    60 / 255,
    0.45
  ),

  border = NA
)

lines(
  x_sec,
  y_sec,

  col = "#6D213C",

  lwd = 2
)

legend(
  "topleft",

  legend = c(
    "Modelo lognormal",
    "Área de probabilidad"
  ),

  col = c(
    "#B56A7D",
    "#6D213C"
  ),

  lwd = 2,

  bty = "n"
)

10.- INTERVALO DE CONFIANZA

sd_lat2 <- sd(
  lat_20_80
)

media_lat2 <- mean(
  lat_20_80
)

n_lat2 <- length(
  lat_20_80
)

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 = c(
      Limite_inf,
      Limite_sup,
      Error_estandar
    ),
    decimals = 2
  ) %>%
  tab_options(
    table.width = pct(100)
  ) %>%
  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

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.