# 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 LINEAL--------------------------------------------------"
## [1] "------------REGRESIÓN LINEAL--------------------------------------------------"
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" ...
#Depuramos datos de las variables "BRIGHTNESS" Y "FRP"
# Asegúrate que las columnas sean numéricas (convertir comas a puntos)
datos$BRIGHTNESS <- as.numeric(gsub(",", ".", datos$BRIGHTNESS))
datos$FRP <- as.numeric(gsub(",", ".", datos$FRP))
#Función para filtrar outliers IQR en una columna
remove_iqr_outliers <- function(x) {
Q1 <- quantile(x, 0.25, na.rm = TRUE)
Q3 <- quantile(x, 0.75, na.rm = TRUE)
IQR <- Q3 - Q1
lower <- Q1 - 1.5 * IQR
upper <- Q3 + 1.5 * IQR
x >= lower & x <= upper
}
# Aplicar filtro en BRIGHTNESS y FRP
mask_bright <- remove_iqr_outliers(datos$BRIGHTNESS)
mask_frp <- remove_iqr_outliers(datos$FRP)
datos_depu <- datos[mask_bright & mask_frp, ]
cat("Filtrado:", nrow(df), "→", nrow(datos_depu), "filas limpias\n")
## Filtrado: → 17584 filas limpias
# Inspeccionar distribución antes y después
par(mfrow=c(2,2))
boxplot(datos$BRIGHTNESS, main="Brightness original")
boxplot(datos_depu$BRIGHTNESS, main="Brightness limpio")
boxplot(datos$FRP, main="FRP original")
boxplot(datos_depu$FRP, main="FRP limpio")
# Ajustar Regresión lineal
modelo_ols <- lm(FRP ~ BRIGHTNESS, data = datos_depu)
cooks <- cooks.distance(modelo_ols)
umbral <- 4 / nrow(datos_depu)
datos2 <- datos_depu[cooks < umbral, ]
modelo2 <- lm(FRP ~ BRIGHTNESS, data = datos2)
summary(modelo2)
##
## Call:
## lm(formula = FRP ~ BRIGHTNESS, data = datos2)
##
## Residuals:
## Min 1Q Median 3Q Max
## -5.2395 -1.6673 -0.4541 1.2802 8.7057
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -76.242684 0.957748 -79.61 <2e-16 ***
## BRIGHTNESS 0.242195 0.002841 85.26 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.285 on 16390 degrees of freedom
## Multiple R-squared: 0.3072, Adjusted R-squared: 0.3072
## F-statistic: 7269 on 1 and 16390 DF, p-value: < 2.2e-16
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
# Crear intervalos de BRIGHTNESS (por ejemplo, de 5 en 5)
datos2 <- datos2 %>%
mutate(BRIGHT_BIN = cut(BRIGHTNESS, breaks = seq(floor(min(BRIGHTNESS)), ceiling(max(BRIGHTNESS)), by = 5)))
library(tidyr)
# Calcular mediana de FRP por intervalo de BRIGHTNESS
med_bin <- datos2 %>%
group_by(BRIGHT_BIN) %>%
summarise(BRIGHTNESS = median(BRIGHTNESS, na.rm = TRUE),
FRP_median = median(FRP, na.rm = TRUE)) %>%
drop_na()
# Ajustar modelo
modelo_mediana_bin <- lm(FRP_median ~ BRIGHTNESS, data = med_bin)
summary(modelo_mediana_bin)
##
## Call:
## lm(formula = FRP_median ~ BRIGHTNESS, data = med_bin)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.8644 -0.3570 0.1125 0.4870 0.5507
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -62.2578 6.3324 -9.832 6.38e-05 ***
## BRIGHTNESS 0.2008 0.0189 10.623 4.10e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.5939 on 6 degrees of freedom
## Multiple R-squared: 0.9495, Adjusted R-squared: 0.9411
## F-statistic: 112.9 on 1 and 6 DF, p-value: 4.098e-05
# Graficar
plot(med_bin$BRIGHTNESS, med_bin$FRP_median,
xlab = "BRIGHTNESS (binned)", ylab = "Mediana de FRP",
main = "Regresión por grupos de BRIGHTNESS", pch = 19, col = "skyblue")
abline(modelo_mediana_bin, col = "red", lwd = 2)
# Usando med_data, que contiene BRIGHTNESS y FRP_median
X <- med_bin$BRIGHTNESS
Y <- med_bin$FRP_median
# Test de correlación de Pearson
r <- cor(X, Y, method = "pearson")
r
## [1] 0.9744329
#Coeficiente de determinación para regresión lineal
r2 <- r^2*100
r2
## [1] 94.95194
"Conclusión
El análisis estadístico realizado muestra que existe una correlación lineal positiva entre la variable BRIGHTNESS (nivel de brillo) y la FRP (potencia radiativa del fuego) en los focos de calor registrados. El coeficiente de correlacion de Pearson nos dio un valor de 0.97, Su coeficiente de determinacion mostró un valor del 94.95%."
## [1] "Conclusión\nEl análisis estadístico realizado muestra que existe una correlación lineal positiva entre la variable BRIGHTNESS (nivel de brillo) y la FRP (potencia radiativa del fuego) en los focos de calor registrados. El coeficiente de correlacion de Pearson nos dio un valor de 0.97, Su coeficiente de determinacion mostró un valor del 94.95%."
