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

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

JUSTIFICACIÓN

DEFINICIÓN DE VARIABLES

# Variable Independiente (X)
elevacion_m <- as.numeric(Global_volcano_eruption$elevacion_m)

# Variable Dependiente (Y)
altura_pluma_km <- as.numeric(Global_volcano_eruption$altura_pluma_km)


# Limpieza de dataset
TPV_inicial <- data.frame(
  elevacion_m = elevacion_m,
  altura_pluma_km = altura_pluma_km
)

TPV_inicial <- na.omit(TPV_inicial)

# Total inicial de pares de valores
total_inicial <- nrow(TPV_inicial)

total_inicial

## [1] 898

USO INTERCUARTIL

# Límites para la Elevación (X)
q1_e <- quantile(TPV_inicial$elevacion_m, 0.25)
q3_e <- quantile(TPV_inicial$elevacion_m, 0.75)
iqr_e <- q3_e - q1_e

# Límites para la Altura de pluma (Y)
q1_h <- quantile(TPV_inicial$altura_pluma_km, 0.25)
q3_h <- quantile(TPV_inicial$altura_pluma_km, 0.75)
iqr_h <- q3_h - q1_h

# Aplicar filtro de Outliers IQR
TPV_sin_outliers <- TPV_inicial %>%
  filter(
    elevacion_m >= (q1_e - 1.5 * iqr_e) &
    elevacion_m <= (q3_e + 1.5 * iqr_e)
  ) %>%
  filter(
    altura_pluma_km >= (q1_h - 1.5 * iqr_h) &
    altura_pluma_km <= (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] 0

USO DE MEDIA ARITMETICA

# Nota: Se asignan directamente los datos sin aplicar summarise(),
# conservando cada par de valores individuales

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] 0

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

TABLA DE PARES DE VALORES

DIAGRAMA DE DISPERSIÓN

DIAGRAMA ORIGINAL

DIAGRAMA POST FILTRADO

plot(
  TPV$elevacion_m,
  TPV$altura_pluma_km,
  pch = 16,
  col = rgb(0, 0, 0.8),
  main = "Gráfica Nº1: Diagrama de Dispersión entre la\nElevación del Volcán y la Altura de la Pluma (Sin Outliers)",
  xlab = "Elevación del volcán - metros (X)",
  ylab = "Altura de la pluma eruptiva - km (Y)"
)

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

CONJETURA DEL MODELO

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

CALCULO DE PARAMETROS

# Transformación logarítmica de la variable independiente (X)
x1 <- log(TPV$elevacion_m)

# Variables del modelo
x <- TPV$elevacion_m
y <- TPV$altura_pluma_km


# ==========================================
# CÁLCULO DE PARÁMETROS
# ==========================================

regresion_logaritmica <- lm(
  y ~ x1
)


# Extraer parámetros del modelo
a <- coef(regresion_logaritmica)[1]

b <- coef(regresion_logaritmica)[2]


# Mostrar parámetros calculados
cat("--- Parámetros Calculados del Modelo Logarítmico ---\n")

## --- Parámetros Calculados del Modelo Logarítmico ---

cat("Parámetro a (Intercepto):", a, "\n")

## Parámetro a (Intercepto): -46.01256

cat("Parámetro b (Pendiente):", b, "\n\n")

## Parámetro b (Pendiente): 7.125653

MODELO Y REALIDAD

TESTS DE APROBACIÓN

PEARSON

# Coeficiente de Pearson entre ln(X) y Y
r <- cor(
  x1,
  y
)

# Resultado en porcentaje
r * 100

## [1] 95.0313

COHEFICIENTE DE DETERMINACIÖN

# Coeficiente de Determinación (R²)
r2 <- summary(regresion_logaritmica)$r.squared

# Mostrar en porcentaje
r2 * 100

## [1] 90.30948

TABLA DE RESUMEN

RESTRICCIONES DEL MODELO

CALCULO DE PRONOSTICOS

CALCULOS

# Se define un valor estimado de elevación para el pronóstico
x_pronostico <- 4000


# Extraemos los parámetros del modelo logarítmico
a <- coef(regresion_logaritmica)[1]

b <- coef(regresion_logaritmica)[2]


# Cálculo de la altura de pluma esperada
altura_esperada <- a + b * log(x_pronostico)


# Mostramos el resultado
cat(
  "Para una elevación de",
  x_pronostico,
  "metros, la altura de pluma esperada es:\n"
)

## Para una elevación de 4000 metros, la altura de pluma esperada es:

print(altura_esperada)

## (Intercept) 
##    13.08796

CONCLUSIÓN