CARGA DE LIBRERIAS Y DATOS

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

DEFINICIÓN DE VARIABLES

Volcanes_Globales <- read_delim(
  "global_volcano_eruption_intelligence.csv",
  delim = ";",
  locale = locale(encoding = "UTF-8")
)

## Rows: 898 Columns: 77
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ";"
## chr (26): volcanoLocationNum, volcano_name, location_description, country, v...
## dbl (43): noaa_event_id, year, month, day, linked_tsunami_event_id, linked_e...
## num  (1): ejecta_volume_km3_min
## lgl  (7): is_significant, publish, is_eruption, tsunami_confirmed, ring_of_f...
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

# Variables
altura_columna<- Volcanes_Globales$est_plume_height_km
energia_julios <- Volcanes_Globales$energy_release_joules_approx

JUSTIFICACIÓN

LIMPIEZA DE DATASET

TPV_inicial <- data.frame(
  altura_pluma_km = datos_volcan$altura_pluma_km,
  energia_liberada_J = datos_volcan$energia_liberada_J
)

# 2. Eliminar valores nulos (NAs)
TPV_inicial <- na.omit(TPV_inicial)

# 3. Filtrar valores strictly positivos (> 0)
TPV_inicial <- TPV_inicial[TPV_inicial$altura_pluma_km > 0 & TPV_inicial$energia_liberada_J > 0, ]

# 4. Asignar identificador secuencial (Nro) y reiniciar índices de filas
TPV_final_id <- cbind(Nro = 1:nrow(TPV_inicial), TPV_inicial)
row.names(TPV_final_id) <- NULL

# 5. Registrar el total inicial de observaciones válidas
total_inicial <- nrow(TPV_inicial)

# Verificar los primeros registros
head(TPV_final_id)

##   Nro altura_pluma_km energia_liberada_J
## 1   1            7.90               4369
## 2   2           19.92              34916
## 3   3           10.82              11328
## 4   4           22.19              36326
## 5   5           23.57              42103
## 6   6            2.09                625

USO INTERCUARTIL

# Límites para Altura de Pluma (X)
q1_e <- quantile(TPV_inicial$altura_pluma_km, 0.25)
q3_e <- quantile(TPV_inicial$altura_pluma_km, 0.75)
iqr_e <- q3_e - q1_e

# Límites para Energía Liberada (Y)
q1_h <- quantile(TPV_inicial$energia_liberada_J, 0.25)
q3_h <- quantile(TPV_inicial$energia_liberada_J, 0.75)
iqr_h <- q3_h - q1_h

# Aplicar filtro de Outliers IQR
TPV_sin_outliers <- TPV_inicial %>%
  filter(
    altura_pluma_km >= (q1_e - 1.5 * iqr_e) &
      altura_pluma_km <= (q3_e + 1.5 * iqr_e)
  ) %>%
  filter(
    energia_liberada_J >= (q1_h - 1.5 * iqr_h) &
      energia_liberada_J <= (q3_h + 1.5 * iqr_h)
  )

# Número de datos después del filtro
total_restante_outliers <- nrow(TPV_sin_outliers)

# Cantidad de outliers encontrados
outliers_encontrados <- total_inicial - total_restante_outliers
outliers_encontrados

## [1] 3

USO DE MEDIA ARITMETICA

# Asignar directamente los datos conservando cada par individual
TPV <- TPV_sin_outliers

# Reiniciar índices de filas
row.names(TPV) <- NULL

# Crear identificador de cada par de valores
TPV_final_id <- cbind(
  Nro = 1:nrow(TPV),
  TPV
)

# No existen valores consolidados por media aritmética
valores_consolidados_media <- 0

OUTLIERS ENCONTRADOS Y REDUCCIÓN DE FILAS REPETIDAS

# Outliers encontrados por Intercuartil
outliers_encontrados <- total_inicial - nrow(TPV_sin_outliers)
outliers_encontrados

## [1] 3

# Reducción de filas repetidas por Media Aritmética
reduccion_media <- nrow(TPV_sin_outliers) - nrow(TPV)
reduccion_media

## [1] 0

# Total de pares de valores utilizados en la regresión
total_pares <- nrow(TPV)
total_pares

## [1] 895

TABLA DE PARES DE VALORES

DIAGRAMA DE DISPERSIÓN

DIAGRAMA ORIGINAL

DIAGRAMA POST FILTRADO

# Asignación de variables x e y desde el conjunto filtrado (TPV)
x <- TPV$altura_pluma_km
y <- TPV$energia_liberada_J

# Gráfica de dispersión post-filtrado
par(oma = c(1, 1, 1, 1))
plot(
  x, y,
  pch = 16,
  col = rgb(0, 0, 0.8),
  main = "Gráfica N°2: Diagrama de dispersión entre Altura de Pluma\ny Energía Liberada de los eventos volcánicos",
  xlab = "Altura de Pluma (km)",
  ylab = "Energía Liberada (J)"
)

box(which = "outer", col = "black")

CONJETURA DEL MODELO

DEBIDO A LA SIMILITUD VISUAL EN LA NUBE DE PUNTOS CONJETURAMOS UN MODELO EXPONENCIAL

CALCULO DE PARAMETROS

# ------------------------------------------------------------------------------
# REGRESIÓN POTENCIAL: TRANSFORMACIÓN LOGARÍTMICA Y CÁLCULO DE PARÁMETROS
# ------------------------------------------------------------------------------

# Transformación logarítmica para linealizar el modelo potencial
x1 <- log(x)
y1 <- log(y)

# Cálculo de Parámetros
regresion_Potencial <- lm(y1 ~ x1)

# Extracción de coeficientes
beta0 <- coef(regresion_Potencial)[1]
beta1 <- coef(regresion_Potencial)[2]

# Parámetro a
a <- exp(beta0)
a

## (Intercept) 
##     146.589

# Parámetro b
b <- beta1
b

##       x1 
## 1.758293

MODELO Y REALIDAD

TESTS DE APROBACIÓN

PEARSON

r <- cor(x1, y1)
r*100

## [1] 98.75556

RESTRICCIONES DEL MODELO

CALCULO DE PRONOSTICOS

CALCULOS

# ------------------------------------------------------------------------------
# CÁLCULO DE LA PREDICCIÓN (X = 18 km)
# ------------------------------------------------------------------------------

# Variable de entrada
x_pronostico <- 18  # Altura de pluma en km

# Cálculo con la ecuación potencial: Y = a * X^b
energia_estimada <- a * (x_pronostico ^ b)
energia_estimada

## [1] 23619.98

CONCLUSIÓN