# UNIVERSIDAD CENTRAL DEL ECUADOR
# Facultad de Ingeniería en Geología, Minas, Petroleos y Ambiental
# Ingeniería Ambiental
# Autor: GUERRERO MARIA GABRIELA, Puchaicela Mónica, Zurita Johanna
# fecha:14/05/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")
#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
# Obtener las estimaciones del modelo
estimaciones <- predict(modelo_mediana_bin)
# Ver los valores estimados junto a los reales
resultado <- cbind(med_bin, FRP_estimada = estimaciones)
print(resultado)
## BRIGHT_BIN BRIGHTNESS FRP_median FRP_estimada
## 1 (315,320] 317.700 2.040 1.523202
## 2 (320,325] 322.580 2.980 2.502903
## 3 (325,330] 328.400 3.410 3.671317
## 4 (330,335] 332.500 3.630 4.494427
## 5 (335,340] 337.130 4.780 5.423939
## 6 (340,345] 342.065 6.350 6.414682
## 7 (345,350] 346.800 7.655 7.365274
## 8 (350,355] 352.050 8.970 8.419256
"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%."
