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
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
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.