# 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 POLINOMICA--------------------------------"
## [1] "---------------------------------REGRESIÓN POLINOMICA--------------------------------"
library(readxl)
library(readr)
library(knitr)
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ purrr 1.1.0
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.2 ✔ tibble 3.2.1
## ✔ lubridate 1.9.4 ✔ tidyr 1.3.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
#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 (por si hay comas)
datos$BRIGHTNESS <- as.numeric(gsub(",", ".", datos$BRIGHTNESS))
datos$FRP <- as.numeric(gsub(",", ".", datos$FRP))
# Filtrar outliers usando IQR laxo (multiplicador 2.5)
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, multiplier = 2.5)
mask_frp <- remove_iqr_outliers_loose(datos$FRP, multiplier = 2.5)
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
# Crear intervalos de BRIGHTNESS (bins de 5)
datos_depu <- datos_depu %>%
mutate(BRIGHT_BIN = cut(BRIGHTNESS, breaks = seq(floor(min(BRIGHTNESS)), ceiling(max(BRIGHTNESS)), by = 5)))
# Calcular medianas de FRP y BRIGHTNESS 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()
# Ajustar modelo polinómico grado 2
modelo_mediana_bin_poly <- lm(FRP_median ~ poly(BRIGHTNESS, 2, raw = TRUE), data = med_bin)
summary(modelo_mediana_bin_poly)
##
## Call:
## lm(formula = FRP_median ~ poly(BRIGHTNESS, 2, raw = TRUE), data = med_bin)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.61964 -0.34814 -0.05945 0.32632 1.01231
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.448e+02 8.716e+01 5.104 0.000925 ***
## poly(BRIGHTNESS, 2, raw = TRUE)1 -2.863e+00 5.274e-01 -5.429 0.000624 ***
## poly(BRIGHTNESS, 2, raw = TRUE)2 4.627e-03 7.963e-04 5.810 0.000400 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.5641 on 8 degrees of freedom
## Multiple R-squared: 0.9789, Adjusted R-squared: 0.9737
## F-statistic: 185.9 on 2 and 8 DF, p-value: 1.968e-07
# Graficar datos y curva polinómica ajustada
plot(med_bin$BRIGHTNESS, med_bin$FRP_median,
xlab = "BRIGHTNESS (binned)", ylab = "Mediana de FRP",
main = "Regresión polinómica grado 2: FRP vs BRIGHTNESS",
pch = 19, col = "skyblue")
# Crear secuencia para curva suave
x_seq <- seq(min(med_bin$BRIGHTNESS), max(med_bin$BRIGHTNESS), length.out = 200)
# Predecir valores usando el modelo polinómico
y_pred <- predict(modelo_mediana_bin_poly, newdata = data.frame(BRIGHTNESS = x_seq))
# Dibujar la curva ajustada
lines(x_seq, y_pred, col = "red", lwd = 2)
# Calcular y mostrar coeficiente de determinación (R^2) polinómico
r2_poly <- summary(modelo_mediana_bin_poly)$r.squared * 100
cat("R² polinómico grado 2 =", round(r2_poly, 2), "%\n")
## R² polinómico grado 2 = 97.89 %
"CONCLUSIÓN
El analisis estadístico nos da como resultado una regresión polinómica de segundo grado muestra la relación entre la variable independiente BRIGHTNESS y la variable dependiente FRP (mediana por intervalo).
Previamente, se eliminaron valores atípicos mediante el método del IQR con un multiplicador de 2.5 y se agruparon los datos en intervalos de 5 unidades para BRIGHTNESS.
El modelo obtuvo un coeficiente de determinación R² de aproximadamente 97.89%, lo cual indica que el modelo explica ese porcentaje de la variabilidad en la mediana de FRP.
Este valor nos explica el Brillo y la Frecuencia Radiativa observados en Ecuador, pero otros factores externos influyen fuertemente en la potencia del fuego, limitando el valor predictivo exclusivo del brillo térmico."
## [1] "CONCLUSIÓN\nEl analisis estadístico nos da como resultado una regresión polinómica de segundo grado muestra la relación entre la variable independiente BRIGHTNESS y la variable dependiente FRP (mediana por intervalo). \nPreviamente, se eliminaron valores atípicos mediante el método del IQR con un multiplicador de 2.5 y se agruparon los datos en intervalos de 5 unidades para BRIGHTNESS.\nEl modelo obtuvo un coeficiente de determinación R² de aproximadamente 97.89%, lo cual indica que el modelo explica ese porcentaje de la variabilidad en la mediana de FRP. \nEste valor nos explica el Brillo y la Frecuencia Radiativa observados en Ecuador, pero otros factores externos influyen fuertemente en la potencia del fuego, limitando el valor predictivo exclusivo del brillo térmico."