ANÁLISIS ESTADÍSTICO DE VOLCANES ACTIVOS A NIVEL GLOBAL
MODELO NORMAL

CARRERA DE GEOLOGÍA

GRUPO N°2

ANÁLISIS ESTADÍSTICO INFERENCIAL

1. CARGA DE LIBRERIAS Y DATOS

2. SELECCION DE VARIABLE

3. TABLA DE DISTRIBUCIÓN DE FRECUENCIAS

4. GRÁFICA DE DISTRIBUCION DE FRECUENCIA

5. CONJETURA DEL MODELO

6. PARAMETROS

7. MODELO Y REALIDAD

8. TESTS DE APROBACIÓN

9. PROBABILIDAD

10. INTERVALOS DE CONFIANZA

11. CONCLUSIONES

CARGA DE LIBRERIAS Y DATOS

Carga de librerias 

## Installing package into '/cloud/lib/x86_64-pc-linux-gnu-library/4.6'
## (as 'lib' is unspecified)
## Installing package into '/cloud/lib/x86_64-pc-linux-gnu-library/4.6'
## (as 'lib' is unspecified)
## Installing package into '/cloud/lib/x86_64-pc-linux-gnu-library/4.6'
## (as 'lib' is unspecified)
## Installing package into '/cloud/lib/x86_64-pc-linux-gnu-library/4.6'
## (as 'lib' is unspecified)
## 
## 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

lectura del dataset 

#CARGA DE DATASET
Volcanes_Globales <- read.csv("global_volcano_eruption_intelligence.csv", header = T, sep = ";", dec = ".")

SELECCIÓN DE VARIABLE

elevacionV <- Volcanes_Globales$elevation_m

elevacion <- elevacionV[elevacionV >= 0]

TABLA DE DISTRIBUCIÓN DE FRECUENCIAS

## [1] 887
## [1] 7
## [1] 1000
# Frecuencia absoluta
# Frecuencia absoluta ni
ni <- numeric(k)

for (i in 1:k) {
  
  if (i < k) {
    ni[i] <- sum(elevacion >= Li[i] &
                   elevacion < Ls[i],
                 na.rm = TRUE)
  } else {
    ni[i] <- sum(elevacion >= Li[i] &
                   elevacion <= Ls[i],
                 na.rm = TRUE)
  }
}

# Frecuencia relativa hi
n <- length(elevacion)
hi <- ni / n


# Dataframe

TDF <- data.frame(
  Intervalo = etiquetas,
  ni = ni,
  hi = round(hi * 100, 2)
)

# Fila de Total
fila_total <- data.frame(
  Intervalo = "TOTAL",
  ni = sum(TDF$ni),
  hi = 100
)

# Unir fila Total con la tabla
TDFelevacion <- rbind(
  TDF,
  fila_total
)

# Mostrar tabla
TDFelevacion
##       Intervalo  ni     hi
## 1    [0 - 1000] 196  22.10
## 2 (1000 - 2000] 329  37.09
## 3 (2000 - 3000] 201  22.66
## 4 (3000 - 4000] 110  12.40
## 5 (4000 - 5000]  17   1.92
## 6 (5000 - 6000]  32   3.61
## 7 (6000 - 7000]   2   0.23
## 8         TOTAL 887 100.00

Tabla de frecuencias

Distribución de Frecuencias de la Elevación de los Volcanes Activos
Análisis de frecuencias globales según los intervalos de elevación registrados
Intervalo de Elevación (m) Frecuencia Absoluta (ni) Frecuencia Relativa (hi %)
[0 - 1000] 196 22.10
(1000 - 2000] 329 37.09
(2000 - 3000] 201 22.66
(3000 - 4000] 110 12.40
(4000 - 5000] 17 1.92
(5000 - 6000] 32 3.61
(6000 - 7000] 2 0.23
TOTAL 887 100.00

GRÁFICA DE DISTRIBUCIÓN DE FRECUENCIA

Diagrama de frecuencia absoluta 

hist(
  elevacion,
  breaks = breaks_elevacion,
  freq = TRUE,
  xaxt = "n",
  col = "lightblue",
  border = "black",
  main = "Histograma de frecuencias absolutas de elevación",
  xlab = "Elevación (m.s.n.m)",
  ylab = "Cantidad de volcanes"
)


# Eje X con intervalos de 500 m
axis(
  side = 1,
  at = breaks_elevacion,
  labels = round(breaks_elevacion, 0),
  las = 2
)

Diagrama de frecuencia absoluta de la zona analizada 

# ==============================================================================
# HISTOGRAMA DE LOS ÚLTIMOS TRES INTERVALOS (4000 a 7000 m.s.n.m)
# ==============================================================================

# 1. Filtrar los datos para mantener solo elevaciones entre 4000 y 7000 m
elevacion_ultimos <- elevacion[elevacion >= 4000 & elevacion <= 7000]

# 2. Definir los breaks exclusivamente para los últimos 3 intervalos
breaks_ultimos <- c(4000, 5000, 6000, 7000)

# 3. Dibujar el histograma
hist(
  elevacion_ultimos,
  breaks = breaks_ultimos,
  freq = TRUE,
  right = TRUE, # Garantiza intervalos del tipo (a, b]
  xaxt = "n",
  col = "lightblue",
  border = "black",
  main = "Histograma de Frecuencias Absolutas de Elevación\n(4000 - 7000 m.s.n.m)",
  xlab = "Elevación (m.s.n.m)",
  ylab = "Cantidad"
)

# 4. Eje X con los puntos de corte seleccionados
axis(
  side = 1,
  at = breaks_ultimos,
  labels = breaks_ultimos,
  las = 2
)

CONJETURA DEL MODELO

DEBIDO A LA SIMILITUD VISUAL SE CONJETURA UN MODELO NORMAL

PARAMETROS

Calculo de parametros del modelo 

# Filtrar directamente los valores exactos
elevacion_ultimos <- elevacion[elevacion >= 4000 & elevacion <= 7000]

# Parámetros exactos
mu_exacto <- mean(elevacion_ultimos, na.rm = TRUE)
sigma_exacto <- sd(elevacion_ultimos, na.rm = TRUE)

mu_exacto
## [1] 5087.02
sigma_exacto
## [1] 559.9252

MODELO Y REALIDAD

# ==============================================================================
# HISTOGRAMA REDUCIDO EN R (AJUSTE DE DIBUJO DIRECTO)
# ==============================================================================

# 1. Datos y parámetros
elevacion_ultimos <- elevacion[elevacion >= 4000 & elevacion <= 7000]
cortes_limpios <- c(4000, 5000, 6000, 7000)

mu <- mean(elevacion_ultimos, na.rm = TRUE)
sigma <- sd(elevacion_ultimos, na.rm = TRUE)

# 2. Calcular la densidad máxima para darle 40% más de espacio vertical al gráfico
# (Esto hace que las barras se vean más bajas)
densidad_max <- max(hist(elevacion_ultimos, breaks = cortes_limpios, plot = FALSE)$density)
limite_y <- densidad_max * 1.4

# 3. Configurar márgenes de la ventana gráfica
par(mar = c(4, 4, 3, 2)) 

# 4. Graficar Histograma con límite Y ampliado (achica las barras visualmente)
Histograma_Normal <- hist(
  elevacion_ultimos,
  breaks = cortes_limpios,
  freq = FALSE,
  ylim = c(0, limite_y), # Evita que ocupe todo el alto
  main = "Comparación de la realidad con el modelo normal en el intervalo de 4000 - 7000 m",
  xlab = "Elevación (m)",
  ylab = "Densidad",
  col = "grey",
  border = "black",
  xaxt = "n",
  cex.main = 0.9,
  cex.lab = 0.8,
  cex.axis = 0.75
)

# 5. Eje X
axis(
  side = 1,
  at = cortes_limpios,
  labels = cortes_limpios,
  cex.axis = 0.75
)

# 6. Curva Normal
curve(
  dnorm(x, mean = mu, sd = sigma),
  from = 4000,
  to = 7000,
  add = TRUE,
  lwd = 2,
  col = "red"
)

# 7. Leyenda
legend(
  "topright",
  legend = c("Realidad", "Modelo normal"),
  fill = c("grey", NA),
  border = c("black", NA),
  col = c(NA, "red"),
  lty = c(0, 1),
  lwd = c(0, 2),
  bty = "n",
  cex = 0.75
)

TESTS DE APROBACIÓN

Test Pearson 

# ==============================================================================
# TEST DE CORRELACIÓN DE PEARSON (ELEVACIÓN 4000 - 7000 m.s.n.m)
# ==============================================================================

# 1. Frecuencia observada en los 3 intervalos
Fo <- as.numeric(table(cut(elevacion_ultimos, breaks = cortes_limpios, include.lowest = TRUE)))
Fo
## [1] 17 32  2
# Número total de volcanes en este subconjunto
n <- length(elevacion_ultimos)

# 2. Probabilidad = P(X <= Ls) - P(X <= Li) para cada intervalo
p <- diff(pnorm(cortes_limpios, mean = mu, sd = sigma))

# 3. Frecuencia esperada = Probabilidad * n
Fe <- p * n
Fe
## [1] 21.019188 26.023178  2.610004
# 4. Cálculo del Coeficiente de Correlación
Correlacion <- cor(Fo, Fe) * 100
Correlacion
## [1] 94.94699

Test Chi cuadrado 

# ==============================================================================
# TEST DE CHI-CUADRADO Y UMBRAL DE ACEPTACIÓN (4000 - 7000 m.s.n.m)
# ==============================================================================

# Fo y Fe en fracción
Fo_fraccion <- Fo / n
Fo_fraccion
## [1] 0.33333333 0.62745098 0.03921569
Fe_fraccion <- p
Fe_fraccion
## [1] 0.41214094 0.51025838 0.05117655
# Estadístico Chi-cuadrado (x2)
x2 <- sum((Fo_fraccion - Fe_fraccion)^2 / Fe_fraccion)
x2
## [1] 0.04478065
# Grados de libertad (k - 1)
k <- length(Fo)
grados_libertad <- k - 1
grados_libertad
## [1] 2
# Umbral de aceptación (al 95% de confianza, alpha = 0.05)
umbral_aceptacion <- qchisq(0.95, df = grados_libertad)
umbral_aceptacion
## [1] 5.991465
# Evaluativo de hipótesis (TRUE = Se acepta el modelo, FALSE = Se rechaza)
x2 < umbral_aceptacion
## [1] TRUE

Tabla de resumen

Resumen de pruebas estadísticas para la validación del modelo Normal
Variable Test Pearson (%) Chi Cuadrado Umbral de aceptación
Elevación de los volcanes activos (4000 - 7000 m.s.n.m) 94.95 0.0448 5.99

CALCULO DE PROBABILIDAD

Pregunta

Calculo de valores 

# Probabilidad en porcentaje (%) usando los parámetros mu y sigma del modelo
probabilidad <- (pnorm(6000, mean = mu, sd = sigma) - pnorm(5000, mean = mu, sd = sigma)) * 100
probabilidad
## [1] 51.02584

Area de probabilidad

Probabilidad 2

Calculo de valores 2 

# 1. Probabilidad del intervalo [6000, 7000]
probabilidad_6000_7000 <- pnorm(7000, mean = mu, sd = sigma) - pnorm(6000, mean = mu, sd = sigma)

# 2. Cantidad esperada de observaciones (volcanes)
Cantidad <- probabilidad_6000_7000 * n

# 3. Mostrar el valor exacto
Cantidad
## [1] 2.610004
# 4. Cantidad redondeada a número entero de volcanes
round(Cantidad)
## [1] 3

INTERVALOS DE CONFIANZA

Cálculo de parámetros e intervalos 

media <- mean(elevacion_ultimos)
sigma <- sd(elevacion_ultimos)
n <- length(elevacion_ultimos)

# Error estándar (e)
e <- 2 * (sigma / sqrt(n))

# Límites del intervalo de confianza
limite_inferior <- round(media - e, 2)
limite_superior <- round(media + e, 2)

# Tabla estructurada
tabla_intervalo <- data.frame(
  `Limite inferior` = limite_inferior,
  `Media poblacional` = "µ",
  `Limite superior` = limite_superior,
  `Error estandar` = round(e, 2),
  check.names = FALSE
)

tabla_intervalo
##   Limite inferior Media poblacional Limite superior Error estandar
## 1         4930.21                 µ         5243.83         156.81

Tabla de resumen 

## [1] 5087.02
## [1] 559.9252
Tabla Nro.3: Media poblacional de la elevación de los volcanes activos
Limite inferior Media poblacional Limite superior Error estandar
4930.21 µ 5243.83 156.81

CONCLUSIÓN

Parte de la variable elevación de los volcanes se explica mediante un modelo probabilístico normal, donde la media aritmética en los intervalos de analisis es de 5087.02, con una desviación estándar de 559.92, representando la variabilidad de las elevaciones.

Mediante el teorema del límite central, se establece que la media aritmética poblacional de la elevación de los volcanes se encuentra entre 4930.21 y 5243.83 con un 95% de confianza.

.