# UNIVERSIDAD CENTRAL DEL ECUADOR
# Facultad de Ingeniería en Geología, Minas, Petroleos y Ambiental
# Ingeniería Ambiental
# Autor: GUERRERO MARIA GABRIELA, PUCHAICELA MONICA, ZURITA JOHANNA
# fecha:14/07/2025
"---------------------------------REGRESIÓN POTENCIAL--------------------------------"
## [1] "---------------------------------REGRESIÓN POTENCIAL--------------------------------"
library(readxl)
library(readr)
#Cargamos Datos
datos <- read_excel("C:/Users/User/Downloads/maate_focosdecalor_bdd_2021diciembre (2).xlsx")
# Guardar como CSV
write_csv(datos, "C:/Users/User/Downloads/maate_focosdecalor_bdd_2021diciembre (2).csv")
datos <- read.csv("C:/Users/User/Downloads/maate_focosdecalor_bdd_2021diciembre (2).csv",
header = TRUE,
sep = ",",
dec = ".",
fileEncoding = "UTF-8")
str(datos)
## 'data.frame': 22476 obs. of 17 variables:
## $ MES_REPORT: int 11 11 8 6 5 6 11 9 3 3 ...
## $ DIA_REPORT: int 20 20 6 10 28 10 20 29 22 22 ...
## $ DPA_DESPRO: chr "ZAMORA CHINCHIPE" "ZAMORA CHINCHIPE" "ZAMORA CHINCHIPE" "ZAMORA CHINCHIPE" ...
## $ DPA_DESCAN: chr "CHINCHIPE" "CHINCHIPE" "CHINCHIPE" "CHINCHIPE" ...
## $ DPA_DESPAR: chr "CHITO" "CHITO" "PUCAPAMBA" "PUCAPAMBA" ...
## $ TXT_1 : chr "PARROQUIA RURAL" "PARROQUIA RURAL" "PARROQUIA RURAL" "PARROQUIA RURAL" ...
## $ LATITUDE : chr "-4,981720000000000" "-4,969160000000000" "-4,958520000000000" "-4,957820000000000" ...
## $ LONGITUDE : chr "-79,041280000000000" "-79,049490000000006" "-79,118430000000004" "-79,111859999999993" ...
## $ BRIGHTNESS: chr "354,759999999999990" "342,009999999999990" "331,860000000000010" "331,399999999999980" ...
## $ SCAN : chr "0,510000000000000" "0,510000000000000" "0,150000000000000" "0,540000000000000" ...
## $ TRACK : chr "0,490000000000000" "0,490000000000000" "0,380000000000000" "0,420000000000000" ...
## $ SATELLITE : int 1 1 1 1 1 1 1 1 1 1 ...
## $ CONFIDENCE: chr "n" "n" "n" "n" ...
## $ VERSION : chr "2.0NRT" "2.0NRT" "2.0NRT" "2.0NRT" ...
## $ BRIGHT_T31: chr "299,420000000000020" "298,149999999999980" "299,160000000000030" "296,800000000000010" ...
## $ FRP : chr "12,100000000000000" "6,870000000000000" "3,770000000000000" "5,500000000000000" ...
## $ DAYNIGHT : chr "D" "D" "D" "D" ...
# 1. Cargar paquetes
library(dplyr)
##
## Adjuntando el paquete: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(ggplot2)
library(tidyr)
# 2. Convertir columnas a numérico
datos$BRIGHTNESS <- as.numeric(gsub(",", ".", datos$BRIGHTNESS))
datos$FRP <- as.numeric(gsub(",", ".", datos$FRP))
# 3. Filtrar outliers usando IQR
remove_iqr_outliers <- function(x) {
Q1 <- quantile(x, 0.25, na.rm = TRUE)
Q3 <- quantile(x, 0.75, na.rm = TRUE)
IQR <- Q3 - Q1
x >= Q1 - 1.5 * IQR & x <= Q3 + 1.5 * IQR
}
mask_bright <- remove_iqr_outliers(datos$BRIGHTNESS)
mask_frp <- remove_iqr_outliers(datos$FRP)
datos_depu <- datos[mask_bright & mask_frp, ]
cat("Filtrado:", nrow(datos), "→", nrow(datos_depu), "filas limpias\n")
## Filtrado: 22476 → 17584 filas limpias
# 4. Agrupar por intervalos de BRIGHTNESS
datos_depu <- datos_depu %>%
mutate(BRIGHT_BIN = cut(BRIGHTNESS, breaks = seq(floor(min(BRIGHTNESS)), ceiling(max(BRIGHTNESS)), by = 5)))
# 5. Calcular medianas por bin
med_bin <- datos_depu %>%
group_by(BRIGHT_BIN) %>%
summarise(
BRIGHTNESS = median(BRIGHTNESS, na.rm = TRUE),
FRP_median = median(FRP, na.rm = TRUE)
) %>%
drop_na()
# ----------------------------------------------
# 6. REGRESIÓN POTENCIAL: log(FRP) ~ log(BRIGHTNESS)
# ----------------------------------------------
med_bin_pot <- med_bin %>% filter(FRP_median > 0 & BRIGHTNESS > 0)
modelo_pot <- lm(log(FRP_median) ~ log(BRIGHTNESS), data = med_bin_pot)
summary(modelo_pot)
##
## Call:
## lm(formula = log(FRP_median) ~ log(BRIGHTNESS), data = med_bin_pot)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.195633 -0.051965 0.002504 0.049791 0.196510
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -69.097 7.741 -8.926 0.00011 ***
## log(BRIGHTNESS) 12.158 1.332 9.130 9.71e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.1264 on 6 degrees of freedom
## Multiple R-squared: 0.9329, Adjusted R-squared: 0.9217
## F-statistic: 83.36 on 1 and 6 DF, p-value: 9.708e-05
# Coeficientes a y b
coef_pot <- coef(modelo_pot)
a_pot <- exp(coef_pot[1])
b_pot <- coef_pot[2]
# Predicción de curva
x_vals <- seq(min(med_bin_pot$BRIGHTNESS), max(med_bin_pot$BRIGHTNESS), length.out = 200)
y_pred <- a_pot * x_vals^b_pot
# Gráfico
# Crear un data frame con la curva ajustada
curva_df <- data.frame(BRIGHTNESS = x_vals, FRP_pred = y_pred)
# Graficar
ggplot(med_bin_pot, aes(x = BRIGHTNESS, y = FRP_median)) +
geom_point(color = "steelblue", size = 2) +
geom_line(data = curva_df, aes(x = BRIGHTNESS, y = FRP_pred), color = "darkgreen", linewidth = 1.3, inherit.aes = FALSE) +
labs(
title = "Regresión Potencial: FRP vs BRIGHTNESS",
subtitle = paste0("Modelo: FRP = ", round(a_pot, 2), " * BRIGHTNESS ^ ", round(b_pot, 4)),
x = "BRIGHTNESS",
y = "FRP (mediana por bin)"
) +
theme_minimal()
# 7. R² manual (modelo sobre log-log)
Y_log <- log(med_bin_pot$FRP_median)
Y_hat <- predict(modelo_pot)
SStot <- sum((Y_log - mean(Y_log))^2)
SSres <- sum((Y_log - Y_hat)^2)
r2_pot <- 1 - (SSres / SStot)
cat("R² potencial:", round(r2_pot, 4), "\n")
## R² potencial: 0.9329
# 8. Correlación de Pearson sobre log-log
cor_pot <- cor(log(med_bin_pot$BRIGHTNESS), log(med_bin_pot$FRP_median))
cat("Correlación de Pearson (log-log):", round(cor_pot, 4), "\n")
## Correlación de Pearson (log-log): 0.9658
"CONCLUSIÓN
Utilizando las medianas agrupadas por intervalos de BRIGHTNESS, y transformando ambas variables a escala logarítmica (log-log).
Esta transformación permite modelar relaciones no lineales de tipo potencia, frecuentes en fenómenos físicos como la radiación térmica.
El ajuste obtuvo un coeficiente de determinación R² ≈ 93% y una correlación de Pearson log-log = 96%,
lo que indica una relación positiva y moderada a fuerte entre BRIGHTNESS y FRP.
En el contexto de los focos de calor en Ecuador, el modelo potencia evidencia una relación escalable entre BRIGHTNESS y FRP,
lo cual es coherente con los procesos de combustión detectados por teledetección. No obstante, la complejidad ecológica y geográfica
del país implica que el BRIGHTNESS por sí solo no es suficiente para predecir completamente la magnitud del fuego."
## [1] "CONCLUSIÓN\nUtilizando las medianas agrupadas por intervalos de BRIGHTNESS, y transformando ambas variables a escala logarítmica (log-log). \nEsta transformación permite modelar relaciones no lineales de tipo potencia, frecuentes en fenómenos físicos como la radiación térmica.\n\nEl ajuste obtuvo un coeficiente de determinación R² ≈ 93% y una correlación de Pearson log-log = 96%, \nlo que indica una relación positiva y moderada a fuerte entre BRIGHTNESS y FRP.\nEn el contexto de los focos de calor en Ecuador, el modelo potencia evidencia una relación escalable entre BRIGHTNESS y FRP, \nlo cual es coherente con los procesos de combustión detectados por teledetección. No obstante, la complejidad ecológica y geográfica \ndel país implica que el BRIGHTNESS por sí solo no es suficiente para predecir completamente la magnitud del fuego."