# 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 EXPONENCIAL--------------------------------"
## [1] "---------------------------------REGRESIÓN EXPONENCIAL--------------------------------"
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(readxl)
library(readr)
library(tidyr)

#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" ...
# Convertir columnas a numérico
datos$BRIGHTNESS <- as.numeric(gsub(",", ".", datos$BRIGHTNESS))
datos$FRP        <- as.numeric(gsub(",", ".", datos$FRP))

# Filtrar outliers usando IQR laxo
remove_iqr_outliers_loose <- function(x, multiplier = 2.5) {
  Q1 <- quantile(x, 0.25, na.rm = TRUE)
  Q3 <- quantile(x, 0.75, na.rm = TRUE)
  IQR <- Q3 - Q1
  x >= (Q1 - multiplier * IQR) & x <= (Q3 + multiplier * IQR)
}

mask_bright <- remove_iqr_outliers_loose(datos$BRIGHTNESS)
mask_frp    <- remove_iqr_outliers_loose(datos$FRP)
datos_depu  <- datos[mask_bright & mask_frp, ]

cat("Filtrado más laxo:", nrow(datos), "→", nrow(datos_depu), "filas limpias\n")
## Filtrado más laxo: 22476 → 19814 filas limpias
# Agrupar BRIGHTNESS en bins
library(dplyr)
datos_depu <- datos_depu %>%
  mutate(BRIGHT_BIN = cut(BRIGHTNESS, breaks = seq(floor(min(BRIGHTNESS)), ceiling(max(BRIGHTNESS)), by = 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()

# Filtrar donde FRP > 0 (necesario para log)
med_bin_exp <- med_bin %>% filter(FRP_median > 0)

# Ajustar modelo lineal sobre log(FRP)
modelo_exp <- lm(log(FRP_median) ~ BRIGHTNESS, data = med_bin_exp)

# Coeficientes
coef_exp <- coef(modelo_exp)
a <- exp(coef_exp[1])
b <- coef_exp[2]

# Predicciones
x_vals <- seq(min(med_bin_exp$BRIGHTNESS), max(med_bin_exp$BRIGHTNESS), length.out = 200)
y_pred <- a * exp(b * x_vals)

# Graficar
library(ggplot2)
ggplot(med_bin_exp, aes(x = BRIGHTNESS, y = FRP_median)) +
  geom_point(color = "steelblue", size = 2) +
  geom_line(data = data.frame(x = x_vals, y = y_pred), aes(x = x, y = y), color = "darkred", linewidth = 1.2) +
  labs(
    title = "Regresión exponencial: FRP vs BRIGHTNESS",
    subtitle = paste0("Modelo: FRP = ", round(a, 2), " * exp(", round(b, 4), " * BRIGHTNESS)"),
    x = "BRIGHTNESS",
    y = "FRP (mediana por bin)"
  ) +
  theme_minimal()

# Calcular R²
Y_log <- log(med_bin_exp$FRP_median)
Y_hat <- predict(modelo_exp)
SStot <- sum((Y_log - mean(Y_log))^2)
SSres <- sum((Y_log - Y_hat)^2)
r2_exp <- 1 - (SSres / SStot)
cat("R² del modelo log(FRP) ~ BRIGHTNESS:", round(r2_exp, 4), "\n")
## R² del modelo log(FRP) ~ BRIGHTNESS: 0.9753
"CONCLUSIÓN
Se aplicó una regresión exponencial para modelar la relación entre BRIGHTNESS (brillo térmico) y la mediana de FRP (Potencia Radiativa del Fuego), 
luego de agrupar los datos depurados en intervalos de 5 unidades y excluir valores atípicos mediante el método del IQR (multiplicador 2.5).
El coeficiente de determinación R² ≈ 97%  indica qué proporción de la variabilidad en log(FRP) es explicada por BRIGHTNESS. 
Este valor representa una relación moderada a fuerte, dependiendo del resultado específico."
## [1] "CONCLUSIÓN\nSe aplicó una regresión exponencial para modelar la relación entre BRIGHTNESS (brillo térmico) y la mediana de FRP (Potencia Radiativa del Fuego), \nluego de agrupar los datos depurados en intervalos de 5 unidades y excluir valores atípicos mediante el método del IQR (multiplicador 2.5).\nEl coeficiente de determinación R² ≈ 97%  indica qué proporción de la variabilidad en log(FRP) es explicada por BRIGHTNESS. \nEste valor representa una relación moderada a fuerte, dependiendo del resultado específico."