Inicio Datos Tripleta Dispersión Modelo Ecuación Tests Restricciones Pronóstico Conclusión

ANÁLISIS ESTADÍSTICO DE DESLIZAMIENTOS

Modelo 6: Regresión Múltiple Lineal

Este modelo analiza la relación entre el índice de susceptibilidad a deslizamientos, la precipitación acumulada en 7 días y la pendiente del terreno.

MODELO 6: REGRESIÓN MÚLTIPLE LINEAL

1. CARGA DE LIBRERÍAS Y DATOS

library(readxl)
library(ggplot2)
library(knitr)
library(scatterplot3d)

datos <- read_excel("dataset_landslides.xlsx", sheet = "Dataset_landslides")
datos <- as.data.frame(datos)

options(scipen = 999)

resumen_dataset <- data.frame(
  Elemento = c(
    "Archivo utilizado",
    "Hoja utilizada",
    "Número de filas",
    "Número de columnas",
    "Variable dependiente Y",
    "Variable independiente X1",
    "Variable independiente X2"
  ),
  Descripcion = c(
    "dataset_landslides.xlsx",
    "Dataset_landslides",
    nrow(datos),
    ncol(datos),
    "Índice de susceptibilidad a deslizamientos",
    "Precipitación acumulada en 7 días",
    "Pendiente del terreno"
  )
)

knitr::kable(
  resumen_dataset,
  caption = "Resumen inicial del dataset"
)
Resumen inicial del dataset
Elemento Descripcion
Archivo utilizado dataset_landslides.xlsx
Hoja utilizada Dataset_landslides
Número de filas 11033
Número de columnas 25
Variable dependiente Y Índice de susceptibilidad a deslizamientos
Variable independiente X1 Precipitación acumulada en 7 días
Variable independiente X2 Pendiente del terreno

2. TABLA DE TRIPLETA DE VALORES

limpiar_numerico <- function(variable) {
  variable <- as.character(variable)
  variable <- gsub(",", ".", variable)
  as.numeric(variable)
}

y <- limpiar_numerico(datos$susceptibility_index)
x1 <- limpiar_numerico(datos$precipitation_7d_mm)
x2 <- limpiar_numerico(datos$terrain_slope_deg)

TPV_inicial <- data.frame(
  y = y,
  x1 = x1,
  x2 = x2
)

TPV_inicial <- TPV_inicial[
  is.finite(TPV_inicial$y) &
    is.finite(TPV_inicial$x1) &
    is.finite(TPV_inicial$x2) &
    TPV_inicial$y > 0 &
    TPV_inicial$x1 > 0 &
    TPV_inicial$x2 > 0,
]

total_inicial <- nrow(TPV_inicial)

filtro_iqr <- function(v) {
  Q1 <- quantile(v, 0.25)
  Q3 <- quantile(v, 0.75)
  IQRv <- Q3 - Q1
  
  limite_inferior <- Q1 - 1.5 * IQRv
  limite_superior <- Q3 + 1.5 * IQRv
  
  v >= limite_inferior & v <= limite_superior
}

filas_buenas <- filtro_iqr(TPV_inicial$y) &
  filtro_iqr(TPV_inicial$x1) &
  filtro_iqr(TPV_inicial$x2)

TPV_sin_outliers <- TPV_inicial[filas_buenas, ]

total_restante_outliers <- nrow(TPV_sin_outliers)
outliers_encontrados <- total_inicial - total_restante_outliers

TPV <- aggregate(
  y ~ x1 + x2,
  data = TPV_sin_outliers,
  FUN = mean
)

TPV <- TPV[order(TPV$x1, TPV$x2), ]

row.names(TPV) <- NULL

TPV_final_id <- cbind(
  Nro = 1:nrow(TPV),
  TPV
)

valores_consolidados_media <- total_restante_outliers - nrow(TPV)

tabla_control <- data.frame(
  Indicador = c(
    "Registros iniciales válidos",
    "Outliers eliminados",
    "Registros después de filtrar outliers",
    "Valores consolidados por media",
    "Tripletas finales utilizadas"
  ),
  Valor = c(
    total_inicial,
    outliers_encontrados,
    total_restante_outliers,
    valores_consolidados_media,
    nrow(TPV)
  )
)

knitr::kable(
  tabla_control,
  caption = "Control de limpieza de datos"
)
Control de limpieza de datos
Indicador Valor
Registros iniciales válidos 11033
Outliers eliminados 424
Registros después de filtrar outliers 10609
Valores consolidados por media 0
Tripletas finales utilizadas 10609 
tabla_tripleta <- head(TPV_final_id, 20)

names(tabla_tripleta) <- c(
  "N°",
  "Precipitación 7 días X1",
  "Pendiente del terreno X2",
  "Susceptibilidad Y"
)

knitr::kable(
  tabla_tripleta,
  digits = 3,
  caption = "Tabla Nº1. Tabla de tripleta de valores"
)
Tabla Nº1. Tabla de tripleta de valores
N° Precipitación 7 días X1 Pendiente del terreno X2 Susceptibilidad Y
1 0.5 12.41 36.77
2 0.5 13.55 35.27
3 0.5 13.88 34.71
4 0.5 15.75 45.33
5 0.5 17.41 36.44
6 0.5 18.27 35.78
7 0.5 19.47 40.56
8 0.5 19.82 48.89
9 0.5 20.16 40.31
10 0.5 20.47 45.90
11 0.5 20.60 39.94
12 0.5 20.88 33.70
13 0.5 21.88 33.39
14 0.5 22.03 40.29
15 0.5 22.99 35.89
16 0.5 23.03 47.33
17 0.5 24.48 55.10
18 0.5 26.28 48.95
19 0.5 26.35 53.09
20 0.5 28.53 54.35 
tabla_variables <- data.frame(
  Variable = c("Y", "X1", "X2"),
  Nombre_en_dataset = c(
    "susceptibility_index",
    "precipitation_7d_mm",
    "terrain_slope_deg"
  ),
  Descripcion = c(
    "Índice de susceptibilidad a deslizamientos",
    "Precipitación acumulada en 7 días",
    "Pendiente del terreno"
  ),
  Unidad = c(
    "índice",
    "mm",
    "grados"
  )
)

knitr::kable(
  tabla_variables,
  caption = "Variables seleccionadas para la regresión múltiple lineal"
)
Variables seleccionadas para la regresión múltiple lineal
Variable Nombre_en_dataset Descripcion Unidad
Y susceptibility_index Índice de susceptibilidad a deslizamientos índice
X1 precipitation_7d_mm Precipitación acumulada en 7 días mm
X2 terrain_slope_deg Pendiente del terreno grados

3. DIAGRAMA DE DISPERSIÓN

scatterplot3d(
  TPV_inicial$x1,
  TPV_inicial$x2,
  TPV_inicial$y,
  angle = 225,
  pch = 16,
  color = rgb(0, 0, 0, 0.55),
  cex.symbols = 0.6,
  main = "Gráfica N°1: Diagrama de dispersión inicial\nSusceptibilidad, precipitación y pendiente",
  xlab = "Precipitación acumulada 7 días (X1)",
  ylab = "Pendiente del terreno (X2)",
  zlab = "Susceptibilidad (Y)"
)

x1 <- TPV$x1
x2 <- TPV$x2
y <- TPV$y

par(mar = c(5, 6, 4, 2))

grafica_filtrada <- scatterplot3d(
  x1,
  x2,
  y,
  angle = 225,
  pch = 16,
  color = "blue",
  cex.symbols = 0.7,
  main = "Gráfica N°2: Diagrama de dispersión filtrado\nSusceptibilidad, precipitación y pendiente",
  xlab = "Precipitación 7 días (X1)",
  ylab = "Pendiente del terreno (X2)",
  zlab = "Susceptibilidad (Y)",
  y.margin.add = 0.7,
  las = 1
)

4. CONJETURA DEL MODELO

Conjetura del modelo

Se plantea que el índice de susceptibilidad a deslizamientos puede explicarse mediante una combinación lineal entre la precipitación acumulada en 7 días y la pendiente del terreno.

La estructura matemática de la regresión múltiple lineal es:

\[ \hat{Y} = a + bX_1 + cX_2 \]

Donde:

  • \(Y\) = índice de susceptibilidad a deslizamientos.
  • \(X_1\) = precipitación acumulada en 7 días.
  • \(X_2\) = pendiente del terreno.
  • \(a\) = intercepto del modelo.
  • \(b\) = coeficiente asociado a \(X_1\).
  • \(c\) = coeficiente asociado a \(X_2\).

5. CÁLCULO DE PARÁMETROS Y ECUACIÓN

regresion_multiple <- lm(
  y ~ x1 + x2,
  data = TPV
)

a_val <- as.numeric(coef(regresion_multiple)[1])
b_val <- as.numeric(coef(regresion_multiple)[2])
c_val <- as.numeric(coef(regresion_multiple)[3])

y_estimado <- predict(regresion_multiple)

r2 <- summary(regresion_multiple)$r.squared
r2_ajustado <- summary(regresion_multiple)$adj.r.squared
r_multiple <- sqrt(r2)
rmse <- sqrt(mean((y - y_estimado)^2))

tabla_modelo <- data.frame(
  Parametro = c("a", "b", "c", "R²", "R múltiple", "R² ajustado", "RMSE"),
  Valor = c(
    a_val,
    b_val,
    c_val,
    r2,
    r_multiple,
    r2_ajustado,
    rmse
  ),
  Interpretacion = c(
    "Intercepto del modelo",
    "Coeficiente de la precipitación acumulada en 7 días",
    "Coeficiente de la pendiente del terreno",
    "Coeficiente de determinación",
    "Coeficiente de correlación múltiple",
    "Coeficiente de determinación ajustado",
    "Error promedio aproximado del modelo"
  )
)

knitr::kable(
  tabla_modelo,
  digits = 5,
  caption = "Parámetros principales del modelo de regresión múltiple lineal"
)
Parámetros principales del modelo de regresión múltiple lineal
Parametro Valor Interpretacion
a 39.47952 Intercepto del modelo
b 0.33780 Coeficiente de la precipitación acumulada en 7 días
c 0.58808 Coeficiente de la pendiente del terreno
R² 0.73619 Coeficiente de determinación
R múltiple 0.85802 Coeficiente de correlación múltiple
R² ajustado 0.73614 Coeficiente de determinación ajustado
RMSE 8.15692 Error promedio aproximado del modelo 
par(mar = c(5, 6, 4, 2))

grafica_modelo <- scatterplot3d(
  x1,
  x2,
  y,
  angle = 225,
  pch = 16,
  color = "blue",
  cex.symbols = 0.75,
  main = "Gráfica N°3: Comparación de la realidad con el\nmodelo multivariable lineal",
  xlab = "Precipitación 7 días",
  ylab = "Pendiente del terreno",
  zlab = "Susceptibilidad",
  y.margin.add = 0.7,
  las = 1
)

grafica_modelo$plane3d(
  regresion_multiple,
  col = "red",
  lwd = 1.5
)

Resultado del modelo multivariable lineal

Ecuación Múltiple Lineal

Y = a + bX1 + cX2

Y = 39.47952 + 0.3378X1 + 0.58808X2

Donde:

Y = Índice de susceptibilidad

X1 = Precipitación acumulada en 7 días

X2 = Pendiente del terreno

R² = 0.7362

El modelo explica aproximadamente 73.62% de la variabilidad observada en el índice de susceptibilidad.

RMSE = 8.1569 

tabla_coeficientes <- as.data.frame(coef(summary(regresion_multiple)))

tabla_coeficientes$Parametro <- rownames(tabla_coeficientes)

rownames(tabla_coeficientes) <- NULL

tabla_coeficientes <- tabla_coeficientes[
  ,
  c(
    "Parametro",
    "Estimate",
    "Std. Error",
    "t value",
    "Pr(>|t|)"
  )
]

knitr::kable(
  tabla_coeficientes,
  digits = 6,
  caption = "Resumen de coeficientes del modelo multivariable lineal"
)
Resumen de coeficientes del modelo multivariable lineal
Parametro Estimate Std. Error t value Pr(>|t|)
(Intercept) 39.479515 0.272225 145.02553 0
x1 0.337803 0.002080 162.37407 0
x2 0.588081 0.010274 57.23939 0

6. TEST DE APROBACIÓN DEL MODELO

modelo_resumen <- summary(regresion_multiple)

f_estadistico <- modelo_resumen$fstatistic[1]
gl_1 <- modelo_resumen$fstatistic[2]
gl_2 <- modelo_resumen$fstatistic[3]

p_valor_modelo <- pf(
  f_estadistico,
  gl_1,
  gl_2,
  lower.tail = FALSE
)

tabla_tests <- data.frame(
  Indicador = c(
    "Coeficiente de Pearson múltiple",
    "Coeficiente de determinación",
    "Coeficiente de determinación ajustado",
    "p-value del modelo",
    "RMSE"
  ),
  Valor = c(
    paste0(round(r_multiple * 100, 2), " %"),
    paste0(round(r2 * 100, 2), " %"),
    paste0(round(r2_ajustado * 100, 2), " %"),
    format.pval(p_valor_modelo, digits = 4),
    round(rmse, 4)
  )
)

knitr::kable(
  tabla_tests,
  caption = "Tests de aprobación del modelo multivariable"
)
Tests de aprobación del modelo multivariable
Indicador Valor
Coeficiente de Pearson múltiple 85.8 %
Coeficiente de determinación 73.62 %
Coeficiente de determinación ajustado 73.61 %
p-value del modelo < 0.00000000000000022
RMSE 8.1569

Test de aprobación del modelo

Coeficiente de Pearson múltiple: 85.8 %

Coeficiente de determinación: 73.62 %

p-value del modelo: < 0.00000000000000022

Con un nivel de significancia de 0.05, el modelo de regresión múltiple lineal es estadísticamente significativo.

7. RESTRICCIONES DEL MODELO

Restricciones del modelo

Sí tiene restricciones. El modelo es válido únicamente dentro de los rangos observados:

0.5 ≤ Precipitación acumulada en 7 días ≤ 178.76 mm
1.5 ≤ Pendiente del terreno ≤ 42.79 grados

El índice de susceptibilidad observado se encuentra entre 28.41 y 98.52.

Cualquier estimación fuera de estos rangos debe interpretarse con cuidado, porque corresponde a una extrapolación del modelo.

8. CÁLCULO DE ESTIMACIONES

x1_test <- median(x1)
x2_test <- median(x2)

nuevo_evento <- data.frame(
  x1 = x1_test,
  x2 = x2_test
)

estimacion <- predict(
  regresion_multiple,
  newdata = nuevo_evento,
  interval = "prediction",
  level = 0.95
)

susceptibilidad_estimada <- estimacion[1, "fit"]
limite_inferior <- estimacion[1, "lwr"]
limite_superior <- estimacion[1, "upr"]

tabla_estimacion <- data.frame(
  Precipitacion_7d_mm = x1_test,
  Pendiente_terreno_grados = x2_test,
  Susceptibilidad_estimada = susceptibilidad_estimada,
  Limite_inferior_95 = limite_inferior,
  Limite_superior_95 = limite_superior
)

knitr::kable(
  tabla_estimacion,
  digits = 4,
  caption = "Pronóstico generado por el modelo múltiple lineal"
)
Pronóstico generado por el modelo múltiple lineal
Precipitacion_7d_mm Pendiente_terreno_grados Susceptibilidad_estimada Limite_inferior_95 Limite_superior_95
61.2 21.33 72.6968 56.7047 88.6889

Pronóstico del modelo multivariable

¿Qué índice de susceptibilidad se espera con una precipitación acumulada de 7 días de:

61.2 mm

y una pendiente del terreno de:

21.33 grados?

El índice de susceptibilidad estimado es:

72.6968

Intervalo de predicción 95%:
56.7047 a 88.6889

Observación: Los valores usados para el pronóstico corresponden a las medianas de las variables independientes dentro del rango observado.

9. CONCLUSIÓN

Conclusión del modelo múltiple lineal

Entre el índice de susceptibilidad a deslizamientos, la precipitación acumulada en 7 días y la pendiente del terreno existe una relación de tipo lineal multivariable.

El modelo obtenido se expresa como Y = 39.47952 + 0.3378X1 + 0.58808X2, donde Y representa el índice de susceptibilidad, X1 la precipitación acumulada en 7 días y X2 la pendiente del terreno.

El coeficiente de determinación fue 73.62%, lo que indica el porcentaje de variabilidad de la susceptibilidad que es explicado por las dos variables independientes seleccionadas.

El coeficiente de Pearson múltiple fue 85.8%, y el modelo resultó estadísticamente significativo según el p-value calculado.

El modelo debe utilizarse únicamente dentro de los rangos observados de precipitación y pendiente, ya que fuera de esos límites las predicciones pueden perder coherencia estadística.

Para una precipitación acumulada de 61.2 mm y una pendiente de 21.33 grados, se espera un índice de susceptibilidad aproximado de 72.6968.

FIN DEL MODELO

Modelo finalizado

La regresión múltiple lineal fue desarrollada usando como variable dependiente el índice de susceptibilidad y como variables independientes la precipitación acumulada en 7 días y la pendiente del terreno. La representación visual principal corresponde a un diagrama de dispersión tridimensional con el plano de ajuste del modelo multivariable.