MODELO 5: REGRESIÓN POLINÓMICA

1. LIBRERÍAS Y CARGA DEL DATASET

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

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 independiente X",
    "Variable dependiente Y"
  ),
  Descripcion = c(
    "dataset_landslides.xlsx",
    "Dataset_landslides",
    nrow(datos),
    ncol(datos),
    "Latitud",
    "Tamaño del deslizamiento / área afectada"
  )
)

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 independiente X	Latitud
Variable dependiente Y	Tamaño del deslizamiento / área afectada

2. SELECCIÓN DE VARIABLES

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

corregir_latitud <- function(variable) {
  variable <- limpiar_numerico(variable)
  
  indice <- is.finite(variable) & abs(variable) > 90
  
  while (any(indice)) {
    variable[indice] <- variable[indice] / 10
    indice <- is.finite(variable) & abs(variable) > 90
  }
  
  variable
}

datos_regresion <- data.frame(
  latitude = corregir_latitud(datos$latitude),
  area_affected_m2 = limpiar_numerico(datos$area_affected_m2)
)

datos_regresion <- datos_regresion[
  is.finite(datos_regresion$latitude) &
    is.finite(datos_regresion$area_affected_m2) &
    datos_regresion$area_affected_m2 > 0 &
    datos_regresion$latitude >= -90 &
    datos_regresion$latitude <= 90,
]

datos_regresion <- datos_regresion[
  order(datos_regresion$latitude),
]

x <- datos_regresion$latitude
y <- datos_regresion$area_affected_m2

tabla_variables <- data.frame(
  Variable = c("X", "Y"),
  Nombre_en_dataset = c(
    "latitude",
    "area_affected_m2"
  ),
  Descripcion = c(
    "Latitud",
    "Tamaño del deslizamiento / área afectada"
  ),
  Unidad = c("grados", "m²")
)

knitr::kable(
  tabla_variables,
  caption = "Variables seleccionadas para el modelo polinómico"
)

Variables seleccionadas para el modelo polinómico
Variable	Nombre_en_dataset	Descripcion	Unidad
X	latitude	Latitud	grados
Y	area_affected_m2	Tamaño del deslizamiento / área afectada	m²

3. TABLA DE PARES DE VALORES

numero_grupos <- 15

cortes <- quantile(
  datos_regresion$latitude,
  probs = seq(0, 1, length.out = numero_grupos + 1),
  na.rm = TRUE
)

cortes <- unique(cortes)

datos_regresion$grupo <- cut(
  datos_regresion$latitude,
  breaks = cortes,
  include.lowest = TRUE,
  labels = FALSE
)

datos_grafica <- aggregate(
  cbind(latitude, area_affected_m2) ~ grupo,
  data = datos_regresion,
  FUN = median
)

x_grafica <- datos_grafica$latitude
y_grafica <- datos_grafica$area_affected_m2

tabla_pares <- data.frame(
  Latitud = x_grafica,
  Tamano_deslizamiento_area_m2 = y_grafica
)

knitr::kable(
  tabla_pares,
  digits = 4,
  caption = "Pares representativos utilizados en la regresión polinómica"
)

Pares representativos utilizados en la regresión polinómica
Latitud	Tamano_deslizamiento_area_m2
-41.5621	1876.80
-0.9035	1814.60
12.1974	1842.55
17.4612	1861.10
24.5938	1896.80
27.5687	1896.90
30.2413	1860.75
33.3746	1883.40
36.0624	1862.65
38.6230	1843.20
40.9892	1785.30
44.1705	1698.10
45.8396	1733.30
48.7490	1811.50
64.0583	1780.60

resumen_variables <- data.frame(
  Variable = c("Latitud", "Tamaño del deslizamiento / área afectada"),
  Minimo = c(min(x), min(y)),
  Media = c(mean(x), mean(y)),
  Mediana = c(median(x), median(y)),
  Maximo = c(max(x), max(y))
)

knitr::kable(
  resumen_variables,
  digits = 2,
  caption = "Resumen estadístico de las variables originales"
)

Resumen estadístico de las variables originales
Variable	Minimo	Media	Mediana	Maximo
Latitud	-89.8	27.49	33.37	89.91
Tamaño del deslizamiento / área afectada	198.6	2366.48	1827.90	62703.70

4. GRÁFICA ORIGINAL: NUBE DE PUNTOS

ggplot(
  datos_grafica,
  aes(
    x = latitude,
    y = area_affected_m2
  )
) +
  geom_point(
    color = "blue",
    alpha = 1,
    size = 3.2
  ) +
  labs(
    title = "REGRESIÓN POLINÓMICA",
    subtitle = "Nube de puntos representativa entre latitud y tamaño del deslizamiento",
    x = "Latitud (X)",
    y = "Tamaño del deslizamiento / área afectada (Y)"
  ) +
  theme_bw(base_size = 15) +
  theme(
    plot.title = element_text(
      hjust = 0.5,
      face = "bold",
      size = 24,
      color = "black"
    ),
    plot.subtitle = element_text(
      hjust = 0.5,
      face = "bold",
      size = 14,
      color = "black"
    ),
    axis.title = element_text(
      face = "plain",
      size = 14,
      color = "black"
    ),
    axis.text = element_text(
      size = 12,
      color = "black"
    ),
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank(),
    panel.border = element_rect(
      color = "black",
      fill = NA,
      linewidth = 1
    ),
    plot.background = element_rect(
      fill = "white",
      color = NA
    ),
    panel.background = element_rect(
      fill = "white",
      color = NA
    )
  )

5. CONJETURA Y ESTRUCTURA MATEMÁTICA

Conjetura del modelo

La relación entre la latitud y el tamaño del deslizamiento puede presentar cambios no lineales. Por esta razón se propone una regresión polinómica de grado 4, capaz de generar una curva con cambios de dirección sobre la nube de puntos.

La estructura matemática del modelo polinómico de grado 4 es:

\[ \hat{Y} = \beta_0 + \beta_1X + \beta_2X^{2} + \beta_3X^{3} + \beta_4X^{4} \]

Donde:

\(X\) = latitud.
\(Y\) = tamaño del deslizamiento / área afectada.
\(\beta_0\) = intercepto del modelo.
\(\beta_1\) = coeficiente lineal.
\(\beta_2\) = coeficiente cuadrático.
\(\beta_3\) = coeficiente cúbico.
\(\beta_4\) = coeficiente de cuarto grado.

6. CÁLCULO DE PARÁMETROS DEL MODELO

modelo_polinomico <- lm(
  area_affected_m2 ~ latitude +
    I(latitude^2) +
    I(latitude^3) +
    I(latitude^4),
  data = datos_grafica
)

parametros <- coef(modelo_polinomico)

beta_0 <- as.numeric(parametros[1])
beta_1 <- as.numeric(parametros[2])
beta_2 <- as.numeric(parametros[3])
beta_3 <- as.numeric(parametros[4])
beta_4 <- as.numeric(parametros[5])

y_estimado <- predict(modelo_polinomico)

r_cuadrado <- summary(modelo_polinomico)$r.squared
rmse <- sqrt(mean((y_grafica - y_estimado)^2))

tabla_modelo <- data.frame(
  Parametro = c("β0", "β1", "β2", "β3", "β4", "R²", "RMSE"),
  Valor = c(
    beta_0,
    beta_1,
    beta_2,
    beta_3,
    beta_4,
    r_cuadrado,
    rmse
  ),
  Interpretacion = c(
    "Intercepto del modelo",
    "Coeficiente lineal",
    "Coeficiente cuadrático",
    "Coeficiente cúbico",
    "Coeficiente de cuarto grado",
    "Proporción de variabilidad explicada",
    "Error promedio aproximado"
  )
)

knitr::kable(
  tabla_modelo,
  digits = 6,
  caption = "Parámetros principales del modelo polinómico de grado 4"
)

Parámetros principales del modelo polinómico de grado 4
Parametro	Valor	Interpretacion
β0	1800.630201	Intercepto del modelo
β1	8.383504	Coeficiente lineal
β2	-0.116125	Coeficiente cuadrático
β3	-0.005413	Coeficiente cúbico
β4	0.000080	Coeficiente de cuarto grado
R²	0.641683	Proporción de variabilidad explicada
RMSE	34.232189	Error promedio aproximado

Resultado del modelo polinómico

Ecuación Polinómica (Grado 4)

Y = β0 + β1X + β2X² + β3X³ + β4X⁴

Y = 1800.63 + 8.38e+00X - 1.16e-01X² - 5.41e-03X³ + 7.95e-05X⁴

Donde:

X = Latitud

Y = Tamaño del deslizamiento / área afectada

R² = 0.6417

El modelo explica aproximadamente 64.17% de la variabilidad observada en los puntos representativos.

RMSE = 34.23 m²

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

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 polinómico de grado 4"
)

Resumen de coeficientes del modelo polinómico de grado 4
Parametro	Estimate	Std. Error	t value	Pr(>\|t\|)
(Intercept)	1800.630201	36.975100	48.698454	0.000000
latitude	8.383504	3.029129	2.767629	0.019868
I(latitude^2)	-0.116125	0.041332	-2.809608	0.018487
I(latitude^3)	-0.005413	0.001795	-3.015430	0.012997
I(latitude^4)	0.000080	0.000027	2.991953	0.013528

7. CURVA POLINÓMICA SOBRE LA NUBE DE PUNTOS

x_secuencia <- seq(
  min(x_grafica),
  max(x_grafica),
  length.out = 300
)

curva_polinomica <- data.frame(
  latitude = x_secuencia
)

curva_polinomica$area_estimada <- predict(
  modelo_polinomico,
  newdata = curva_polinomica
)

ggplot() +
  geom_point(
    data = datos_grafica,
    aes(
      x = latitude,
      y = area_affected_m2
    ),
    color = "blue",
    alpha = 1,
    size = 3.2
  ) +
  geom_line(
    data = curva_polinomica,
    aes(
      x = latitude,
      y = area_estimada
    ),
    color = "red",
    linewidth = 1.5
  ) +
  labs(
    title = "Gráfica N° 3: Comparación de la realidad con el modelo polinómico",
    subtitle = "Entre la latitud y el tamaño del deslizamiento",
    x = "Latitud (X)",
    y = "Tamaño del deslizamiento / área afectada (Y)"
  ) +
  theme_bw(base_size = 15) +
  theme(
    plot.title = element_text(
      hjust = 0.5,
      face = "bold",
      size = 17,
      color = "black"
    ),
    plot.subtitle = element_text(
      hjust = 0.5,
      face = "bold",
      size = 14,
      color = "black"
    ),
    axis.title = element_text(
      face = "plain",
      size = 14,
      color = "black"
    ),
    axis.text = element_text(
      size = 12,
      color = "black"
    ),
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank(),
    panel.border = element_rect(
      color = "black",
      fill = NA,
      linewidth = 1
    ),
    plot.background = element_rect(
      fill = "white",
      color = NA
    ),
    panel.background = element_rect(
      fill = "white",
      color = NA
    )
  )

8. EVALUACIÓN DEL MODELO

pearson_modelo <- cor.test(
  y_grafica,
  y_estimado,
  method = "pearson"
)

r_pearson <- as.numeric(pearson_modelo$estimate)
p_valor <- pearson_modelo$p.value

tabla_evaluacion <- data.frame(
  Indicador = c(
    "Coeficiente de Pearson",
    "p-value",
    "R²",
    "RMSE"
  ),
  Valor = c(
    round(r_pearson, 4),
    format.pval(p_valor, digits = 4),
    round(r_cuadrado, 4),
    round(rmse, 2)
  ),
  Interpretacion = c(
    "Relación entre los valores observados y los valores estimados por la curva polinómica",
    "Significancia estadística de la relación observada-estimada",
    "Variabilidad explicada por el modelo",
    "Error promedio aproximado del modelo"
  )
)

knitr::kable(
  tabla_evaluacion,
  caption = "Evaluación del modelo polinómico"
)

Evaluación del modelo polinómico
Indicador	Valor	Interpretacion
Coeficiente de Pearson	0.8011	Relación entre los valores observados y los valores estimados por la curva polinómica
p-value	0.0003316	Significancia estadística de la relación observada-estimada
R²	0.6417	Variabilidad explicada por el modelo
RMSE	34.23	Error promedio aproximado del modelo

Test de evaluación del modelo polinómico

Coeficiente de Pearson observado-estimado: r = 0.8011

p-value: 0.0003316

Con un nivel de significancia de 0.05, la relación entre los valores observados y los valores estimados por el modelo es estadísticamente significativa.

8.1. RESTRICCIONES DEL MODELO

Restricciones del modelo

Sí existe restricción matemática y estadística, ya que el modelo polinómico fue construido con valores de latitud entre x = -41.5621° y x = 64.0583°.

El tamaño del deslizamiento representado por el área afectada se encuentra entre 1698.1 m² y 1896.9 m².

Al introducir valores fuera del rango observado, el modelo puede generar predicciones poco consistentes, ya que una función polinómica de grado alto puede variar rápidamente fuera del intervalo analizado.

9. PRONÓSTICO DEL MODELO POLINÓMICO

valor_propuesto <- median(x_grafica)

if (
  valor_propuesto < min_latitud ||
  valor_propuesto > max_latitud
) {
  
  valor_estimado <- median(x_grafica)
  
  observacion_estimacion <- paste(
    "El valor propuesto está fuera del rango observado.",
    "Se usó la mediana de la latitud para la demostración."
  )
  
} else {
  
  valor_estimado <- valor_propuesto
  
  observacion_estimacion <- "El valor propuesto está dentro del rango observado."
}

nuevo_evento <- data.frame(
  latitude = valor_estimado
)

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

area_estimada <- estimacion[1, "fit"]
limite_inferior <- max(0, estimacion[1, "lwr"])
limite_superior <- estimacion[1, "upr"]

tabla_estimacion <- data.frame(
  Latitud = valor_estimado,
  Tamano_deslizamiento_area_m2 = area_estimada,
  Limite_inferior_95 = limite_inferior,
  Limite_superior_95 = limite_superior
)

knitr::kable(
  tabla_estimacion,
  digits = 2,
  caption = "Pronóstico generado por el modelo polinómico"
)

Pronóstico generado por el modelo polinómico
Latitud	Tamano_deslizamiento_area_m2	Limite_inferior_95	Limite_superior_95
33.37	1848.55	1749.78	1947.33

Pronóstico del modelo polinómico

Para una latitud de:

33.3746°

El tamaño estimado del deslizamiento, representado por el área afectada, es:

1848.55 m²

Intervalo de predicción 95%:
1749.78 m² a 1947.33 m²

Observación: El valor propuesto está dentro del rango observado.

10. CONCLUSIÓN DEL MODELO

Conclusión del modelo polinómico

El modelo permitió evaluar la relación entre la latitud y el tamaño del deslizamiento, representado por el área afectada, mediante una función polinómica de grado 4.

La ecuación utilizada corresponde a la forma Y = β0 + β1X + β2X² + β3X³ + β4X⁴, donde X representa la latitud y Y el tamaño del deslizamiento / área afectada.

El coeficiente de Pearson entre los valores observados y los valores estimados fue r = 0.801, con un p-value = 0.0003316. La relación observada-estimada resultó estadísticamente significativa.