UNIVERSIDAD CENTRAL DEL ECUADOR

PROYECTO: FOCOS DE CALOR EN EL ECUADOR

AUTORES: GUERRERO MARIA GABRIELA, PUCHAICELA MONICA, ZURITA JOHANNA

FECHA: 14/05/2025

# ========================
# Leer y preparar los datos
# ========================
df <- read.csv("Focos de Calor 2021.csv", header = TRUE, sep = ",", dec = ".")

df$FRP <- as.numeric(df$FRP) / 1e16
df$BRIGHTNESS <- as.numeric(df$BRIGHTNESS) / 1e16
df$SCAN <- as.numeric(df$SCAN) / 1e16

# ========================
# Eliminar NAs
# ========================
datos_limpios <- na.omit(df[, c("FRP", "BRIGHTNESS", "SCAN")])

# ========================
# Función para eliminar outliers (usando IQR)
# ========================
eliminar_outliers <- function(x) {
  q1 <- quantile(x, 0.25)
  q3 <- quantile(x, 0.75)
  iqr <- q3 - q1
  lim_inf <- q1 - 1.5 * iqr
  lim_sup <- q3 + 1.5 * iqr
  return(x >= lim_inf & x <= lim_sup)
}

# ========================
# Aplicar filtro a todas las columnas
# ========================
filtro <- with(datos_limpios, eliminar_outliers(FRP) & eliminar_outliers(BRIGHTNESS) & eliminar_outliers(SCAN))
datos_limpios <- datos_limpios[filtro, ]

# ========================
# Agregar columnas transformadas
# ========================
datos_limpios$LOG_BRIGHTNESS <- log(datos_limpios$BRIGHTNESS + 1)
datos_limpios$LOG_SCAN <- log(datos_limpios$SCAN + 1)

# ========================
# MODELO DE REGRESIÓN
# ========================
modelo_frp_scan_br <- lm(FRP ~ BRIGHTNESS + SCAN, data = datos_limpios)
summary(modelo_frp_scan_br)
## 
## Call:
## lm(formula = FRP ~ BRIGHTNESS + SCAN, data = datos_limpios)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.60733 -0.18110 -0.06606  0.10517  1.56493 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -8.854448   0.110931  -79.82   <2e-16 ***
## BRIGHTNESS   0.261895   0.003246   80.69   <2e-16 ***
## SCAN        13.579953   0.309303   43.91   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.2779 on 16837 degrees of freedom
## Multiple R-squared:  0.3273, Adjusted R-squared:  0.3272 
## F-statistic:  4096 on 2 and 16837 DF,  p-value: < 2.2e-16
modelo_frp_scan_br 
## 
## Call:
## lm(formula = FRP ~ BRIGHTNESS + SCAN, data = datos_limpios)
## 
## Coefficients:
## (Intercept)   BRIGHTNESS         SCAN  
##     -8.8544       0.2619      13.5800
# ========================
# Intervalos
# ========================
min_x1 <- min(datos_limpios$LOG_BRIGHTNESS)
max_x1 <- max(datos_limpios$LOG_BRIGHTNESS)
min_x2 <- min(datos_limpios$LOG_SCAN)
max_x2 <- max(datos_limpios$LOG_SCAN)
min_y  <- min(datos_limpios$FRP)
max_y  <- max(datos_limpios$FRP)
n <- nrow(datos_limpios)

tabla_intervalos <- data.frame(
  "Min.x1" = min_x1, "Max.x1" = max_x1,
  "Min.x2" = min_x2, "Max.x2" = max_x2,
  "Min.y" = min_y, "Max.y" = max_y,
  "N" = n
)

library(knitr)
kable(tabla_intervalos, format = "markdown", caption = "Tabla 1 :Resumen de depuración")
Tabla 1 :Resumen de depuración
Min.x1 Max.x1 Min.x2 Max.x2 Min.y Max.y N
3.490429 3.602777 0.0314987 0.0620354 0.027 1.75 16840
# ========================
# Graficar modelo
# ========================
x1 <- datos_limpios$LOG_BRIGHTNESS
x2 <- datos_limpios$LOG_SCAN
y_pre <- fitted(modelo_frp_scan_br)
modelo_frp_scan_br <- lm(y_pre ~ x1 + x2)

library(scatterplot3d)

relacion <- scatterplot3d(x1, x2, y_pre,
                          main = "Grafica 1 = Contenido de FRP en función de BRIGHTNESS y SCAN",
                          xlab = "BRIGHTNESS", ylab = "SCAN", zlab = "FRP",
                          angle = 310, color = "red", pch =16 )
relacion$plane3d(modelo_frp_scan_br, col = "black")

relacion350 <- scatterplot3d(x1, x2, y_pre,
                             main = "Grafica 2 (ángulo 350)",
                             xlab = "BRIGHTNESS", ylab = "SCAN", zlab = "FRP",
                             angle = 350, color = "red", pch =16 )
relacion350$plane3d(modelo_frp_scan_br, col = "black")

relacion210 <- scatterplot3d(x1, x2, y_pre,
                             main = "Grafica 3 (ángulo 210)",
                             xlab = "BRIGHTNESS", ylab = "SCAN", zlab = "FRP",
                             angle = 210, color = "red", pch = 16)
relacion210$plane3d(modelo_frp_scan_br, col = "black")

# ========================
# Correlaciones
# ========================
r <- cor(y_pre, x1 + x2) * 100
r
## [1] 98.61024
y_obs <- datos_limpios$FRP
r_total <- cor(y_obs, y_pre) * 100
r1 <- cor(y_obs, x1) * 100
r1_sq <- cor(y_obs, x1)^2 * 100
r2 <- cor(y_obs, x2) * 100
r2_sq <- cor(y_obs, x2)^2 * 100

# ========================
# Tabla resumen
# ========================
Variables <- c("BRIGHTNESS", "SCAN", "FRP")
Tipo <- c("independiente", "independiente", "dependiente")
Test <- c(round(r1, 2), round(r2, 2), "")
Correlacion <- c(round(r1_sq, 2), round(r2_sq, 2), "")
Unidades <- c("Kelvin(K)", "Metro(m)", "Megavatios por píxel (MW)")

Tabla_resumen <- data.frame(Variables, Unidades, Tipo, Test, Correlacion)
kable(Tabla_resumen, format = "markdown", caption = "Tabla 2 : Resumen de variables")
Tabla 2 : Resumen de variables
Variables Unidades Tipo Test Correlacion
BRIGHTNESS Kelvin(K) independiente 49.88 24.89
SCAN Metro(m) independiente 25.92 6.72
FRP Megavatios por píxel (MW) dependiente
# ========================
# Ecuación del modelo
# ========================
a <- coef(modelo_frp_scan_br)[2]
b <- coef(modelo_frp_scan_br)[3]
c <- coef(modelo_frp_scan_br)[1]

cat("Ecuación del modelo:\n")
## Ecuación del modelo:
cat(paste("FRP = ", round(c, 4),
          " + ", round(a, 4), " * log(BRIGHTNESS + 1)",
          " + ", round(b, 4), " * log(SCAN + 1)\n"))
## FRP =  -32.4373  +  9.134  * log(BRIGHTNESS + 1)  +  14.2191  * log(SCAN + 1)
# ========================
# Pregunta de probabilidad
# ========================
cat("\n¿CUÁL SERÁ LA CANTIDAD FRP (Potencia Radiativa del Fuego) EN UN FOCO DE CALOR QUE TIENE BRIGHTNESS = 25 (K) Y SCAN = 50 (m)?\n")
## 
## ¿CUÁL SERÁ LA CANTIDAD FRP (Potencia Radiativa del Fuego) EN UN FOCO DE CALOR QUE TIENE BRIGHTNESS = 25 (K) Y SCAN = 50 (m)?
x1_new <- 25
x2_new <- 50
log_x1 <- log(x1_new + 1)
log_x2 <- log(x2_new + 1)
y_new <- c + a * log_x1 + b * log_x2

cat(paste("Respuesta: FRP ≈ ", round(y_new, 4), "\n"))
## Respuesta: FRP ≈  53.229

Existe una relación lineal múltiple entre la Potencia Radiativa del Fuego (FRP), el brillo térmico (BRIGHTNESS) y el tamaño del píxel de escaneo (SCAN), representada por la ecuación: FRP=−32.4373+9.1340log(BRIGHTNESS+1)+14.2191log(SCAN+1) Este modelo permite estimar la FRP a partir de valores positivos de BRIGHTNESS y SCAN. Por ejemplo, si BRIGHTNESS = 25 y SCAN = 50, entonces FRP ≈ 53.229 MW/píxel. Los datos fueron depurados para mejorar la precisión del modelo. Este modelo no presenta restricciones en el conjunto de los números reales para valores positivos de BRIGHTNESS y SCAN, y puede usarse para predecir la Potencia Radiativa del Fuego en función de estas variables.