FECHA: 14/05/2025
# Configuración
knitr::opts_chunk$set(echo = TRUE)
# importar datos
datos <- read.csv("Focos de Calor 2021.csv",
header = T, sep = ",", dec = ".")
#Estructura de los datos
str(datos)
## 'data.frame': 22476 obs. of 12 variables:
## $ ACQ_DATE : chr "20/11/2021" "20/11/2021" "06/08/2021" "10/06/2021" ...
## $ 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" ...
## $ LATITUDE : num -4.98e+15 -4.97e+15 -4.96e+15 -4.96e+15 -4.96e+15 ...
## $ LONGITUDE : num -7.90e+16 -7.90e+16 -7.91e+16 -7.91e+16 -7.92e+16 ...
## $ BRIGHTNESS: num 3.55e+17 3.42e+17 3.32e+17 3.31e+17 3.28e+17 ...
## $ SCAN : num 5.1e+14 5.1e+14 1.5e+14 5.4e+14 5.0e+14 ...
## $ TRACK : num 4.9e+14 4.9e+14 3.8e+14 4.2e+14 4.9e+14 ...
## $ INSTRUMENT: chr "VIIRS" "VIIRS" "VIIRS" "VIIRS" ...
## $ VERSION : chr "2.0NRT" "2.0NRT" "2.0NRT" "2.0NRT" ...
## $ FRP : num 1.21e+16 6.87e+15 3.77e+15 5.50e+15 2.90e+15 ...
Fecha <- datos$ACQ_DATE
datos$Fecha <- as.Date(datos$ACQ_DATE, format = "%d/%m/%Y")
# Extraer el mes en formato numérico
meses <- as.numeric(format(datos$Fecha, "%m"))
# Crear tabla de frecuencias de meses
TDFMes <- as.data.frame(table(meses))
colnames(TDFMes) <- c("Mes", "ni_mes")
TDFMes$hi_mes <- (TDFMes$ni_mes / sum(TDFMes$ni_mes)) * 100
print(TDFMes)
## Mes ni_mes hi_mes
## 1 1 771 3.4303257
## 2 2 418 1.8597615
## 3 3 149 0.6629293
## 4 4 273 1.2146289
## 5 5 298 1.3258587
## 6 6 497 2.2112476
## 7 7 1120 4.9830931
## 8 8 1335 5.9396690
## 9 9 2176 9.6814380
## 10 10 3105 13.8147357
## 11 11 8266 36.7770066
## 12 12 4068 18.0993059
# Graficar barplot con meses en el eje X
barplot(TDFMes$ni_mes,
main="Gráfica N°11.1: Frecuencia de los Meses de los focos de calor en Ecuador",
xlab="Mes", ylab="Cantidad",
names.arg = TDFMes$Mes,
las=2,
col = "lightcoral")
# Agrupar meses 1-6
TDFMes1_6 <- subset(TDFMes, as.numeric(as.character(Mes)) >= 1 & as.numeric(as.character(Mes)) <= 6)
hi1 <- TDFMes1_6$ni_mes / sum(TDFMes1_6$ni_mes)
print(hi1)
## [1] 0.32044888 0.17373234 0.06192851 0.11346633 0.12385702 0.20656692
barplot(hi1 * 100,
main = "Gráfica N°11.2: Distribución de Probabilidad de Meses 1-6",
xlab = "Mes",
ylab = "Probabilidad (%)",
names.arg = TDFMes1_6$Mes,
col = "lightcoral")
meses_numericos1 <- as.numeric(as.character(TDFMes1_6$Mes))
lambda1 <- sum(meses_numericos1 * TDFMes1_6$ni_mes) / sum(TDFMes1_6$ni_mes)
print(lambda1)
## [1] 3.166251
P1 <- dpois(meses_numericos1, lambda1)
print(P1)
## [1] 0.1334935 0.2113369 0.2230486 0.1765569 0.1118047 0.0590003
barplot(hi1 * 100,
main = "Gráfica N°11.2: Distribución de Probabilidad de Meses 1-6",
xlab = "Mes",
ylab = "Probabilidad (%)",
names.arg = TDFMes1_6$Mes,
col = "lightcoral")
meses_numericos1 <- as.numeric(as.character(TDFMes1_6$Mes))
lambda1 <- sum(meses_numericos1 * TDFMes1_6$ni_mes) / sum(TDFMes1_6$ni_mes)
print(lambda1)
## [1] 3.166251
P1 <- dpois(meses_numericos1, lambda1)
print(P1)
## [1] 0.1334935 0.2113369 0.2230486 0.1765569 0.1118047 0.0590003
barplot(rbind(hi1 * 100, P1 * 100),
main = "Gráfica N°11.3: Modelo de probabilidad Poisson para Meses 1-6",
xlab = "Mes",
ylab = "Probabilidad (%)",
names.arg = TDFMes1_6$Mes,
beside = TRUE,
col = c("lightcoral", "brown"))
legend("topright", legend = c("Real", "Modelo"),
fill = c("lightcoral", "brown"))
Fo1 <- hi1
Fe1 <- P1
Correlación1 <- cor(Fo1, Fe1) * 100
plot(Fo1, Fe1, main="Gráfica N°11.4: Correlación de frecuencias en modelo Poisson \n Meses 1-6",
xlab="Observado (hi)", ylab="Esperado (P)")
abline(lm(Fe1 ~ Fo1), col="red", lwd=2)
x2 <- sum(((Fo1 - Fe1)^2) / Fe1)
vc <- qchisq(0.95, length(Fo1) - 1)
x2 > vc
## [1] FALSE
Variable <- c("Mes 1-6")
tabla_resumen <- data.frame(
Variable,
round(Correlación1, 0),
round(x2, 2),
round(vc, 2)
)
colnames(tabla_resumen) <- c("Variable", "Test Pearson (%)", "Chi Cuadrado", "Umbral de aceptación")
library(knitr)
kable(tabla_resumen, format = "markdown", caption = "Tabla Nº11.1: Resumen de test de bondad al modelo de probabilidad")
Tabla Nº11.1: Resumen de test de bondad al modelo de
probabilidad
| Mes 1-6 |
-46 |
0.78 |
11.07 |
n1 <- sum(TDFMes1_6$ni_mes)
print(n1)
## [1] 2406
# Ejemplo de probabilidad para mes 3 en porcentaje
probabilidad_3 <- dpois(3, lambda1) * 100
cat("La probabilidad de que un foco de calor ocurra en el mes 3 es aproximadamente:",
round(probabilidad_3, 2), "%\n")
## La probabilidad de que un foco de calor ocurra en el mes 3 es aproximadamente: 22.3 %
# Agrupar meses 7-12
TDFMes7_12 <- subset(TDFMes, as.numeric(as.character(Mes)) >= 7 & as.numeric(as.character(Mes)) <= 12)
hi2 <- TDFMes7_12$ni_mes / sum(TDFMes7_12$ni_mes)
print(hi2)
## [1] 0.05580468 0.06651719 0.10842053 0.15470852 0.41185850 0.20269058
barplot(hi2 * 100,
main = "Gráfica N°11.5: Distribución de Probabilidad de Meses 7-12",
xlab = "Mes",
ylab = "Probabilidad (%)",
names.arg = TDFMes7_12$Mes,
col = "skyblue")
meses_numericos2 <- as.numeric(as.character(TDFMes7_12$Mes))
lambda2 <- sum(meses_numericos2 * TDFMes7_12$ni_mes) / sum(TDFMes7_12$ni_mes)
print(lambda2)
## [1] 10.40837
P2 <- dpois(meses_numericos2, lambda2)
print(P2)
## [1] 0.07924115 0.10309641 0.11922951 0.12409850 0.11742392 0.10184931
barplot(rbind(hi2 * 100, P2 * 100),
main = "Gráfica N°11.6: Modelo de probabilidad Poisson para Meses 7-12",
xlab = "Mes",
ylab = "Probabilidad (%)",
names.arg = TDFMes7_12$Mes,
beside = TRUE,
col = c("skyblue", "blue"))
legend("topright", legend = c("Real", "Modelo"),
fill = c("skyblue", "blue"))
Fo2 <- hi2
Fe2 <- P2
Correlación2 <- cor(Fo2, Fe2) * 100
plot(Fo2, Fe2, main="Gráfica N°11.7: Correlación de frecuencias en modelo Poisson \n Meses 7-12",
xlab="Observado (hi)", ylab="Esperado (P)")
abline(lm(Fe2 ~ Fo2), col="red", lwd=2)
x2_2 <- sum(((Fo2 - Fe2)^2) / Fe2)
vc2 <- qchisq(0.95, length(Fo2) - 1)
x2_2 > vc2
## [1] FALSE
Variable <- c("Mes 7-12")
tabla_resumen <- data.frame(
Variable,
round(Correlación2, 0),
round(x2_2, 2),
round(vc2, 2)
)
colnames(tabla_resumen) <- c("Variable", "Test Pearson (%)", "Chi Cuadrado", "Umbral de aceptación")
kable(tabla_resumen, format = "markdown", caption = "Tabla Nº11.2: Resumen de test de bondad al modelo de probabilidad")
Tabla Nº11.2: Resumen de test de bondad al modelo de
probabilidad
| Mes 7-12 |
45 |
0.87 |
11.07 |
n2 <- sum(TDFMes7_12$ni_mes)
print(n2)
## [1] 20070
# Ejemplo de probabilidad para mes 9 en porcentaje
probabilidad_9 <- dpois(9, lambda2) * 100
cat("La probabilidad de que un foco de calor ocurra en el mes 9 es aproximadamente:",
round(probabilidad_9, 2), "%\n")
## La probabilidad de que un foco de calor ocurra en el mes 9 es aproximadamente: 11.92 %