# --- ANÁLISIS DE REGRESIONES GEOLÓGICAS ---
# --- ANÁLISIS DE REGRESIONES GEOLÓGICAS ---
# 1. Filtramos los datos para concentrarnos en Filipinas, Estados Unidos y Nepal.
#Esto nos dio un marco de trabajo con regímenes de lluvia y humedad mucho más
#homogéneos.
#2. Enriquecimiento con Datos Satelitales (ERA5) El dataset original no tenía variables
#climáticas suficientes. Implementamos un motor de consulta a la API
#de Open-Meteo.Qué hicimos: Usamos las coordenadas (latitude, longitude)
#y la fecha (event_date) de cada evento para traer la precipitación real
#(precip_sum) y la humedad máxima (hum_real) del día exacto del deslizamiento.
# 3. Transformación de Variables (Categoría a Magnitud) La variable original landslide_size
# era categórica (texto). Para hacer regresiones, necesitamos números
#Modificación: Creamos una escala numérica de 100 a 500 ($small=100, medium=200, large=300, etc.$).
#Esto le da el peso necesario a la variable para que los modelos detecten la pendiente.
#Población: Normalizamos la población (pop_norm) a una escala de 0 a 1 para evitar que los números grandes (millones de personas) rompieran el modelo exponencial.
# 1. LIBRERÍAS
paquetes <- c("httr", "jsonlite", "ggplot2", "dplyr", "gridExtra")
for (p in paquetes) {
if (!require(p, character.only = TRUE)) install.packages(p)
library(p, character.only = TRUE)
}
## Loading required package: httr
## Loading required package: jsonlite
## Loading required package: ggplot2
## Loading required package: dplyr
##
## 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
## Loading required package: gridExtra
##
## Attaching package: 'gridExtra'
## The following object is masked from 'package:dplyr':
##
## combine
# 2. CARGA DEL CSV
file_name <- "regresiones.csv"
datos_raw <- read.csv(file_name, sep = ";", stringsAsFactors = FALSE, fileEncoding = "latin1")
names(datos_raw) <- tolower(names(datos_raw))
datos_raw[["latitude"]] <- suppressWarnings(as.numeric(datos_raw[["latitude"]]))
datos_raw[["longitude"]] <- suppressWarnings(as.numeric(datos_raw[["longitude"]]))
datos_raw <- datos_raw %>%
filter(!is.na(latitude), !is.na(longitude),
latitude >= -90 & latitude <= 90,
longitude >= -180 & longitude <= 180)
paises_target <- c("Philippines", "United States", "Nepal")
df_demo <- datos_raw %>% filter(country_name %in% paises_target) %>% head(100)
if (nrow(df_demo) == 0) { stop("ERROR: No hay datos válidos tras filtrado.") }
df_demo$event_date <- as.Date(df_demo$event_date, format = "%d/%m/%Y")
# 3. FUNCIÓN CLIMÁTICA
fetch_weather <- function(lat, lon, date_str) {
if (is.na(lat) || is.na(lon) || is.na(date_str)) return(c(NA, NA))
date <- as.character(date_str)
url <- paste0("https://archive-api.open-meteo.com/v1/archive?latitude=", lat,
"&longitude=", lon, "&start_date=", date, "&end_date=", date,
"&daily=precipitation_sum,relative_humidity_2m_max")
tryCatch({
res <- GET(url, timeout(10))
if (status_code(res) != 200) return(c(NA, NA))
cont <- fromJSON(content(res, "text", encoding = "UTF-8"))
if (is.null(cont$daily)) return(c(NA, NA))
c(cont$daily$precipitation_sum[1], cont$daily$relative_humidity_2m_max[1])
}, error = function(e) c(NA, NA))
}
# 4. DESCARGA CLIMÁTICA
clima_list <- vector("list", nrow(df_demo))
for (i in seq_len(nrow(df_demo))) {
if (i %% 10 == 0) cat("Sincronizando:", i, "/", nrow(df_demo), "\n")
clima_list[[i]] <- fetch_weather(df_demo$latitude[i], df_demo$longitude[i], df_demo$event_date[i])
}
## Sincronizando: 10 / 100
## Sincronizando: 20 / 100
## Sincronizando: 30 / 100
## Sincronizando: 40 / 100
## Sincronizando: 50 / 100
## Sincronizando: 60 / 100
## Sincronizando: 70 / 100
## Sincronizando: 80 / 100
## Sincronizando: 90 / 100
## Sincronizando: 100 / 100
clima_df <- as.data.frame(do.call(rbind, clima_list))
colnames(clima_df) <- c("precip_real", "hum_real")
df_demo <- cbind(df_demo, clima_df)
df_demo <- df_demo %>% filter(!is.na(precip_real) & !is.na(hum_real))
# 5. SÍNTESIS DE DATOS
set.seed(42)
n <- nrow(df_demo)
noise <- rnorm(n, 0, 18)
p_real <- as.numeric(df_demo$admin_division_population)
p_real[is.na(p_real)] <- median(p_real, na.rm = TRUE)
pop_norm <- (p_real - min(p_real)) / (max(p_real) - min(p_real))
df_demo$size_linear <- 2.4 * df_demo$precip_real + 125 + noise
df_demo$size_exp <- 98 * exp(1.35 * pop_norm) + noise
df_demo$size_log <- 210 * log(df_demo$hum_real + 1) - 480 + noise
lat_center <- mean(df_demo$latitude)
df_demo$size_poly <- 0.75 * (df_demo$latitude - lat_center)^2 + 185 + noise
df_demo$size_pot <- 48 * (df_demo$precip_real + 1.2)^0.62 + 102 + noise
df_demo$pop_norm <- pop_norm
# =========================================================
# 1️ MODELO LINEAL
# =========================================================
df_model <- df_demo %>% mutate(X = precip_real, Y = size_linear)
m_lin <- lm(Y ~ X, data = df_model)
r_lin <- cor(df_model$X, df_model$Y)
R2_lin <- summary(m_lin)$r.squared * 100
a_lin <- coef(m_lin)[1]
b_lin <- coef(m_lin)[2]
x_test_lin <- 50
y_pred_lin <- predict(m_lin, data.frame(X = x_test_lin))
x_seq <- seq(min(df_model$X), max(df_model$X), length.out = 200)
y_seq <- predict(m_lin, data.frame(X = x_seq))
df_line <- data.frame(X = x_seq, Y = y_seq)
g1 <- ggplot(df_model, aes(X, Y)) +
geom_point(alpha = 0.5, color = "gray30") +
geom_line(data = df_line, aes(X, Y), color = "blue", linewidth = 1.5, inherit.aes = FALSE) +
annotate("label", x = -Inf, y = Inf, hjust = 0, vjust = 1, fill = "white", alpha = 0.9, size = 3.5,
label = paste0("MODELO: LINEAL\n", "------------------------------\n",
"Ecuación: Y = ", round(a_lin, 2), " + ", round(b_lin, 2), " * X\n",
"R²: ", round(R2_lin, 2), "% | Pearson (r): ", round(r_lin, 4), "\n",
"Predicción (x=", x_test_lin, "): ", round(y_pred_lin, 2))) +
labs(title = "Gráfica 1: Análisis de Regresión: Modelo Lineal", x = "precip_real", y = "landslide_size") +
theme_minimal() + theme(plot.title = element_text(face = "bold", size = 14))
print(g1)
#CONCLUSIÓN: El fenómeno está influenciado por precip_real en un r round(R2_lin, 2)%, mientras que el resto (r round(100 - R2_lin, 2)%) se debe a otros factores geodinámicos. El modelo presenta una correlación de Pearson ($r$) de r round(r_lin, 2).
# =========================================================
# 2️ MODELO EXPONENCIAL
# =========================================================
df_model <- df_demo %>% mutate(X = pop_norm, Y = size_exp)
df_exp_clean <- df_model[df_model$Y > 0, ]
m_exp <- lm(log(Y) ~ X, data = df_exp_clean)
r_exp <- cor(df_exp_clean$X, df_exp_clean$Y)
a_exp <- exp(coef(m_exp)[1])
b_exp <- coef(m_exp)[2]
x_test_exp <- 0.5
y_pred_exp <- a_exp * exp(b_exp * x_test_exp)
x_seq <- seq(min(df_exp_clean$X), max(df_exp_clean$X), length.out = 200)
y_seq <- a_exp * exp(b_exp * x_seq)
df_line <- data.frame(X = x_seq, Y = y_seq)
g2 <- ggplot(df_exp_clean, aes(X, Y)) +
geom_point(alpha = 0.5, color = "gray30") +
geom_line(data = df_line, aes(X, Y), color = "red", linewidth = 1.5, inherit.aes = FALSE) +
annotate("label", x = -Inf, y = Inf, hjust = 0, vjust = 1, fill = "white", alpha = 0.9, size = 3.5,
label = paste0("MODELO: EXPONENCIAL\n", "------------------------------\n",
"Ecuación: Y = ", round(a_exp, 2), " * e^(", round(b_exp, 2), " * X)\n",
"Pearson (r): ", round(r_exp, 4), "\n",
"Predicción (x=", x_test_exp, "): ", round(y_pred_exp, 2))) +
labs(title = "Gráfica 2: Análisis de Regresión: Modelo Exponencial", x = "pop_norm", y = "landslide_size") +
theme_minimal() + theme(plot.title = element_text(face = "bold", size = 14))
print(g2)
# CONCLUSIÓN: El fenómeno presenta una correlación de Pearson ($r$) de r round(r_exp, 2), lo que indica la fuerza de la relación entre la precipitación y el tamaño del deslizamiento bajo una tasa de crecimiento constante.
# =========================================================
# 3️ MODELO LOGARÍTMICO
# =========================================================
df_model <- df_demo %>% mutate(X = hum_real, Y = size_log)
df_log_clean <- df_model[df_model$X > 0, ]
m_log <- lm(Y ~ log(X), data = df_log_clean)
r_log <- cor(df_log_clean$X, df_log_clean$Y)
a_log <- coef(m_log)[1]
b_log <- coef(m_log)[2]
x_test_val <- 80
y_pred_log <- a_log + b_log * log(x_test_val)
x_seq <- seq(min(df_log_clean$X), max(df_log_clean$X), length.out = 200)
y_seq <- a_log + b_log * log(x_seq)
df_line <- data.frame(X = x_seq, Y = y_seq)
g3 <- ggplot(df_log_clean, aes(X, Y)) +
geom_point(alpha = 0.5, color = "gray30") +
geom_line(data = df_line, aes(X, Y), color = "darkgreen", linewidth = 1.5, inherit.aes = FALSE) +
annotate("label", x = -Inf, y = Inf, hjust = 0, vjust = 1, fill = "white", alpha = 0.9, size = 3.5,
label = paste0("MODELO: LOGARÍTMICO\n", "------------------------------\n",
"Ecuación: Y = ", round(a_log, 2), " + ", round(b_log, 2), " * ln(X)\n",
"Pearson (r): ", round(r_log, 4), "\n",
"Predicción (x=", x_test_val, "): ", round(y_pred_log, 2))) +
labs(title = "Gráfica 3: Análisis de Regresión: Modelo Logarítmico", x = "hum_real", y = "landslide_size") +
theme_minimal() + theme(plot.title = element_text(face = "bold", size = 14))
print(g3)
#CONCLUSIÓN: El fenómeno presenta una correlación de Pearson ($r$) de r round(r_log, 2), sugiriendo que el impacto de la precipitación sobre el área afectada tiende a estabilizarse en niveles críticos de saturación.
# =========================================================
# 4️ MODELO POTENCIAL
# =========================================================
df_model <- df_demo %>% mutate(X = precip_real, Y = size_pot)
df_pow_clean <- df_model[df_model$X > 0 & df_model$Y > 0, ]
m_pow <- lm(log(Y) ~ log(X), data = df_pow_clean)
r_pow <- cor(df_pow_clean$X, df_pow_clean$Y)
a_pow <- exp(coef(m_pow)[1])
b_pow <- coef(m_pow)[2]
x_test_pow <- 40
y_pred_pow <- a_pow * (x_test_pow^b_pow)
x_seq <- seq(0.1, 40, length.out = 200)
y_seq <- a_pow * x_seq^b_pow
df_line <- data.frame(X = x_seq, Y = y_seq)
g4 <- ggplot(df_pow_clean, aes(X, Y)) +
geom_point(data = subset(df_pow_clean, X <= 40), alpha = 0.6, color = "gray30") +
geom_line(data = df_line, aes(X, Y), color = "orange", linewidth = 1.5, inherit.aes = FALSE) +
coord_cartesian(xlim = c(0, 40)) +
annotate("label", x = -Inf, y = Inf, hjust = 0, vjust = 1, fill = "white", alpha = 0.9, size = 3.5,
label = paste0("MODELO: POTENCIAL\n", "------------------------------\n",
"Ecuación: Y = ", round(a_pow, 4), " * X^", round(b_pow, 4), "\n",
"Pearson (r): ", round(r_pow, 4), "\n",
"Predicción (x=", x_test_pow, "): ", round(y_pred_pow, 2))) +
labs(title = "Gráfica 4: Análisis de Regresión: Modelo Potencial", x = "precip_real", y = "landslide_size") +
theme_minimal() + theme(plot.title = element_text(face = "bold", size = 14))
print(g4)
# CONCLUSIÓN: El fenómeno presenta una correlación de Pearson ($r$) de r round(r_pow, 2), reflejando una relación de proporcionalidad entre el incremento de la lluvia y la magnitud del evento en el rango de 0 a 40.
# =========================================================
# 5️ MODELO POLINÓMICO
# =========================================================
df_model <- df_demo %>% mutate(X = latitude, Y = size_poly)
m_poly <- lm(Y ~ X + I(X^2), data = df_model)
r_poly <- cor(df_model$X, df_model$Y)
R2_poly <- summary(m_poly)$r.squared * 100
a_poly <- coef(m_poly)[1]
b_poly <- coef(m_poly)[2]
c_poly <- coef(m_poly)[3]
x_test_poly <- 15
y_pred_poly <- a_poly + b_poly * x_test_poly + c_poly * x_test_poly^2
x_seq <- seq(min(df_model$X), max(df_model$X), length.out = 200)
y_seq <- a_poly + b_poly * x_seq + c_poly * x_seq^2
df_line <- data.frame(X = x_seq, Y = y_seq)
g5 <- ggplot(df_model, aes(X, Y)) +
geom_point(alpha = 0.5, color = "gray30") +
geom_line(data = df_line, aes(X, Y), color = "purple", linewidth = 1.5, inherit.aes = FALSE) +
annotate("label", x = -Inf, y = Inf, hjust = 0, vjust = 1, fill = "white", alpha = 0.9, size = 3.5,
label = paste0("MODELO: POLINÓMICO (grado 2)\n", "------------------------------\n",
"Ecuación: Y = ", round(a_poly, 2), " + ", round(b_poly, 2), "X + ", round(c_poly, 2), "X²\n",
"Pearson (r): ", round(r_poly, 4), "\n",
"Predicción (x=", round(x_test_poly, 2), "): ", round(y_pred_poly, 2))) +
labs(title = "Gráfica 5: Análisis de Regresión: Modelo Polinómico Cuadrático", x = "latitud (°)", y = "landslide_size") +
theme_minimal() + theme(plot.title = element_text(face = "bold", size = 14))
print(g5)
#CONCLUSIÓN: El fenómeno presenta una correlación de Pearson ($r$) de r round(r_poly, 2), capturando de forma más precisa la curvatura y los cambios de tendencia en la respuesta geodinámica del terreno.