0. Librerías 1. Datos 2. Variable 3. Tabla de frecuencias 4. Gráfica de frecuencias 5. Conjetura 6. Parámetros 7. Sobreposición exponencial 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)

#Filtro de datos
lat_50_20 <- latitude[
  latitude >= -50 &
  latitude <= -20
]

3.- TABLA DE FRECUENCIA

#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_options(
    table.width = pct(100)
  ) %>%
  tab_source_note(
    source_note = md(
      "Elaborado por: Grupo 2 – Carrera de Geología"
    )
  )

tabla_gt_50_20

Li	LS	MC	ni	hi	NI	NID	HI	HID
Tabla N° 2
Distribución de frecuencias de la variable Latitud entre (−50° a −20°) de los eventos a nivel mundial
-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

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

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

  border = "#4A1026",

  main = "Gráfica Nº 2: Distribución de frecuencias de la variable\nLatitud entre (-50° y -20°)",

  xlab = "Latitud (°)",

  ylab = "Frecuencia absoluta (ni)"
)

5.- CONJETURA

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.

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

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

# Histograma de las frecuencias observadas
HistoLat1 <- hist(
  lat_50_20,

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

  freq = TRUE,

  col = "#D8C3CA",

  border = "#4A1026",

  main = "Gráfica Nº 3: Modelo de probabilidad exponencial\nde 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 = "#6D213C",

  lwd = 2
)

# Leyenda
legend(
  "topleft",

  legend = c(
    "Frecuencia observada",
    "Modelo exponencial"
  ),

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

  lwd = c(
    10,
    2
  ),

  bty = "n"
)

8.- TEST DE BONDAD

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 = "#4A1026"
)

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

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

  col = "#6D213C",

  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

#Tablas de Resumen Estadístico

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

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_options(
    table.width = pct(100)
  ) %>%
  tab_source_note(
    source_note = md(
      "Elaborado por: Grupo 2 – Carrera de Geología"
    )
  )

tabla_gt_bondad

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

9.- CÁLCULO DE PROBABILIDADES

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

#Gráfica de probabilidades
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 = "#B56A7D",

  main = "Gráfica 4: Cálculo de probabilidades – Modelo exponencial de\nla 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(
    109 / 255,
    33 / 255,
    60 / 255,
    0.45
  ),

  border = NA
)

lines(
  x_sec,
  y_sec,

  col = "#6D213C",

  lwd = 2
)

legend(
  "topleft",

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

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

  lwd = 4,

  bty = "n"
)

# Cálculo basado en la Gráfica 4
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 entre -35 y -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.- INTERVALO DE CONFIANZA

# 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 = 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

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

11.- CONCLUSIÓN

La variable LATITUD ENTRE (−50° a −20°) sigue un modelo de probabilidad exponencial, aprobando los test de Pearson (99.61%) y Chi-cuadrado (0.1380) con un umbral de aceptación de 5.9915. 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.

ESTADÍSTICA INFERENCIAL - MODELO EXPONENCIAL - VARIABLE LATITUD

Geología Grupo 1

2026