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

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

era_t <- Volcanes_Globales$era

#LIMPIEZA DE DATOS
sum(is.na(era_t))
## [1] 0

Orden de categorias 

#ORDEN DE CATEGORIAS
niveles_era <- c(
  "Prehistoric/Ancient",
  "Classical Antiquity",
  "Early Medieval",
  "Late Medieval",
  "Early Modern",
  "Industrial Age",
  "Early 20th Century",
  "Late 20th Century",
  "21st Century"
)

era_t <- factor(
  era_t,
  levels = niveles_era,
  ordered = TRUE
)

TABLA DE DISTRIBUCIÓN DE FRECUENCIAS

Calculo de frecuencias 

# Generar tabla de frecuencias
TDFEra <- table(era_t)

# Convertir datos a dataframe
TDFEra <- as.data.frame(TDFEra)

# Cambiar nombres
colnames(TDFEra) <- c("Era", "Freq")

# Frecuencia absoluta y relativa
TDFEraFinal <- TDFEra %>%
  group_by(Era) %>%
  summarise(
    ni = sum(Freq),
    
    # Frecuencia relativa porcentual
    hi = round((ni / sum(TDFEra$Freq)) * 100, 2),
    # Frecuencia relativa decimal
    hi_decimal = round(ni / sum(TDFEra$Freq), 4)
  )

# Agregar numeración en tabla
TDFEraFinal <- TDFEraFinal %>%
  mutate(Nro = row_number())

# Añadir fila de totales
TDFEraFinal <- TDFEraFinal %>%
  add_row(
    Nro = NA,
    Era = "Total",
    ni = sum(TDFEraFinal$ni),
    hi = 100,
    hi_decimal = 1
  )

# Tabla de presentación
tabla_presentacion <- TDFEraFinal %>%
  mutate(
    hi = round(hi, 2),
    hi_decimal = round(hi_decimal, 4)
  )

# Ver tabla
tabla_presentacion
## # A tibble: 7 × 5
##   Era                            ni     hi hi_decimal   Nro
##   <chr>                       <int>  <dbl>      <dbl> <int>
## 1 Prehistoric/Ancient            25   2.78     0.0278     1
## 2 Classical Antiquity            11   1.22     0.0122     2
## 3 Medieval                       46   5.12     0.0512     3
## 4 Early Modern-Industrial Age   288  32.1      0.321      4
## 5 20th Century                  378  42.1      0.421      5
## 6 21st Century                  150  16.7      0.167      6
## 7 Total                         898 100        1         NA

Tabla de frecuencias

Distribución de Probabilidad de las Eras Geológicas
Análisis de frecuencias globales según la era de actividad volcánica registrada
Era Geológica Frecuencia Absoluta (ni) Frecuencia Relativa (hi %) Probabilidad (pi) Nro
Prehistoric/Ancient 25 2.78 0.0278 1
Classical Antiquity 11 1.22 0.0122 2
Medieval 46 5.12 0.0512 3
Early Modern-Industrial Age 288 32.07 0.3207 4
20th Century 378 42.09 0.4209 5
21st Century 150 16.70 0.1670 6
Total 898 100.00 1.0000 NA

GRÁFICA DE DISTRIBUCIÓN DE FRECUENCIA

Diagrama de frecuencia relativa 

# Eliminar fila de total
TDFEraPlot <- TDFEraFinal %>%
  filter(Era != "Total")

par(mar = c(9,4,4,2))
barplot(
  TDFEraPlot$hi,
  names.arg = TDFEraPlot$Nro,
  col = "skyblue",
  ylim = c(0,100),
  main = "Gráfica N°1: Distribución de probabilidad de la era geológica",
  ylab = "Probabilidad (%)",
  xlab = ""
)

# Etiqueta del eje X
mtext(
  "Era geológica (Nro)",
  side = 1,
  line = 2
)

# Relación número - categoría
mtext(
  paste(
    paste(
      TDFEraPlot$Nro,
      "=",
      TDFEraPlot$Era
    ),
    collapse = ", "
  ),
  side = 1,
  line = 4,
  cex = 0.8
)

CONJETURA DEL MODELO

DEBIDO A LA SIMILITUD VISUAL SE CONJETURA UN MODELO BINOMIAL

PARAMETROS

Calculo de parametros 

# Eliminar fila Total
TDFEraBin <- TDFEraFinal %>%
  filter(Era != "Total")

# Número total de observaciones
n <- sum(TDFEraBin$ni)

# Frecuencias observadas
x <- TDFEraBin$ni

# Valores ordinales de las categorías
X <- TDFEraBin$Nro

# Media observada
media_observada <- sum(X*x)/n

# Número de categorías
k <- length(X)

# Parámetro p de la distribución binomial
p <- (media_observada-1)/(k-1)

# Mostrar parámetros
media_observada
## [1] 4.595768
p
## [1] 0.7191537
# Probabilidades del modelo binomial
P_binomial <- dbinom(
  X-1,
  size = k-1,
  prob = p
)

# Mostrar probabilidades
P_binomial
## [1] 0.001747204 0.022370036 0.114564389 0.293361153 0.375599985 0.192357232

MODELO Y REALIDAD

# Frecuencias observadas (%)
Fo <- TDFEraBin$hi

# Frecuencias esperadas (%)
Fe <- P_binomial * 100

# Tabla comparación
comparacion <- data.frame(
  Era = TDFEraBin$Era,
  Observado = Fo,
  Esperado = round(Fe,2)
)
comparacion
##                           Era Observado Esperado
## 1         Prehistoric/Ancient      2.78     0.17
## 2         Classical Antiquity      1.22     2.24
## 3                    Medieval      5.12    11.46
## 4 Early Modern-Industrial Age     32.07    29.34
## 5                20th Century     42.09    37.56
## 6                21st Century     16.70    19.24
# GRÁFICA
par(mar=c(5,5,5,2))
barplot(
  rbind(Fo,Fe),
  beside=TRUE,
  col=c("skyblue","blue"),
  names.arg=TDFEraBin$Nro,
  main="Gráfica N°2: Comparación de la realidad con el modelo binomial de la era geológica",
  ylab="Probabilidad (%)",
  xlab="Era geológica (Nro)",
  ylim=c(0,100)
)

# Leyenda
legend(
  x="topright",
  legend=c("Realidad","Modelo Binomial"),
  fill=c("skyblue","blue"),
  border="black",
  bty="n"
)

TESTS DE APROBACIÓN

Gráfica de correlación del modelo Binomial y la realidad 

# Frecuencias observadas (%)
Fo <- TDFEraFinal$hi[
  TDFEraFinal$Era != "Total"
]

# Frecuencias esperadas (%)
Fe <- P_binomial * 100


# Gráfico de dispersión
plot(
  Fo,
  Fe,
  main = "Gráfica N°3: Correlación de frecuencias\nentre realidad y modelo binomial de la era geológica",
  xlab = "Frecuencia observada (%)",
  ylab = "Frecuencia esperada (%)",
  pch = 19,
  col = "darkblue",
  xlim = c(0,100),
  ylim = c(0,100)
)

# Línea de ajuste perfecto
abline(
  a = 0,
  b = 1,
  col = "red",
  lwd = 2
)

Test de Pearson 

Correlacion <- cor(Fo, Fe) * 100
Correlacion
## [1] 97.63257

Test Chi cuadrado 

gl <- length(Fo)-1

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

vc <- qchisq(0.99999999,gl)

#RESULTADOS
x2
## [1] 43.95004
vc
## [1] 45.79459
x2 < vc
## [1] TRUE

Tabla de resumen

Resumen estadístico del modelo binomial
Pruebas de ajuste entre frecuencias observadas y esperadas
Variable Pearson (%) Chi cuadrado Umbral de aceptación
Era geológica 97.63 43.95 45.79

CALCULO DE PROBABILIDAD

# 1. Calculamos el valor de la probabilidad dinámicamente
# Categoría Medieval (Nro 3)

porcentaje <- round(
  (TDFEraFinal$ni[TDFEraFinal$Era == "Medieval"] /
     TDFEraFinal$ni[TDFEraFinal$Era == "Total"]) * 100,
  1
)

porcentaje
## [1] 5.1

Calculo de probabilidad

INTERVALOS DE CONFIANZA

Al ser una variable cualitativa codificada no se pueden obtener los parametros para calcular los intervalos de confianza

CONCLUSIÓN

La variable era historica de los volcanes activos se explica mediante un modelo probabilístico Binomial, cuya media no se puede calcular debido a su naturaleza categorica. Sin embargo los resultados obtenidos mediante el test de Pearson 97.63 % y el test Chi-cuadrado 43.95 % evidencian un adecuado ajuste entre las frecuencias observadas y las frecuencias esperadas del modelo.

.