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
# Convertir fechas a formato Date
datos$Fecha <- as.Date(datos$ACQ_DATE, format = "%d/%m/%Y")
# Extraer el día en formato numérico
dias <- as.numeric(format(datos$Fecha, "%d"))
# Crear tabla de frecuencias de días
TDFDia <- as.data.frame(table(dias))
# Renombrar columnas para mejor claridad
colnames(TDFDia) <- c("Dia", "ni_dia")
# Calcular frecuencia relativa (hi) en porcentaje
TDFDia$hi_dia <- (TDFDia$ni_dia / sum(TDFDia$ni_dia)) * 100
# Mostrar el dataframe final
print(TDFDia)
## Dia ni_dia hi_dia
## 1 1 458 2.037729
## 2 2 336 1.494928
## 3 3 981 4.364656
## 4 4 443 1.970991
## 5 5 524 2.331376
## 6 6 844 3.755117
## 7 7 756 3.363588
## 8 8 1101 4.898558
## 9 9 521 2.318028
## 10 10 378 1.681794
## 11 11 449 1.997686
## 12 12 554 2.464851
## 13 13 317 1.410393
## 14 14 579 2.576081
## 15 15 296 1.316960
## 16 16 2650 11.790354
## 17 17 735 3.270155
## 18 18 249 1.107848
## 19 19 741 3.296850
## 20 20 1515 6.740523
## 21 21 829 3.688379
## 22 22 383 1.704040
## 23 23 1142 5.080975
## 24 24 619 2.754049
## 25 25 498 2.215697
## 26 26 249 1.107848
## 27 27 430 1.913152
## 28 28 1305 5.806193
## 29 29 760 3.381385
## 30 30 1316 5.855134
## 31 31 518 2.304681
# Graficar barplot con días en el eje X
barplot(TDFDia$ni,
main="Gráfica Nro 10.8: Frecuencia de los Días de los Sismos del focos de calor en Ecuador",
xlab="Día", ylab="Cantidad",
names.arg = TDFDia$Dia,
las=2,
col = "pink")
# Agrupar solo días del 1 al 10
TDFDia1_10 <- subset(TDFDia, as.numeric(as.character(Dia)) >= 1 & as.numeric(as.character(Dia)) <= 10)
# Calcular frecuencias relativas para el grupo 1-10
hi1 <- TDFDia1_10$ni_dia / sum(TDFDia1_10$ni_dia)
print(hi1)
## [1] 0.07221697 0.05298013 0.15468307 0.06985178 0.08262378 0.13308105
## [7] 0.11920530 0.17360454 0.08215074 0.05960265
barplot(hi1 * 100,
main = "Gráfica N°10.9: Distribución de Probabilidad de Día (1-10)",
xlab = "Día",
ylab = "Probabilidad (%)",
names.arg = TDFDia1_10$Dia,
col = "pink")
dias_numericos <- as.numeric(as.character(TDFDia1_10$Dia))
# Calcular lambda1 (media ponderada)
lambda1 <- sum(dias_numericos * TDFDia1_10$ni_dia) / sum(TDFDia1_10$ni_dia)
print(lambda1)
## [1] 5.691895
#Calculamos las probabilidades teóricas usando la distribución de Poisson
dias_numericos <- as.numeric(as.character(TDFDia1_10$Dia))
P1 <- dpois(dias_numericos, lambda1)
print(P1)
## [1] 0.01919987 0.05464181 0.10367182 0.14752229 0.16793629 0.15931263
## [7] 0.12954154 0.09216711 0.05828951 0.03317778
barplot(rbind(hi1 * 100, P1 * 100),
main = "Gráfica N°10.10: Modelo de probabilidad Poisson para Días 1-10",
xlab = "Día",
ylab = "Probabilidad (%)",
names.arg = TDFDia1_10$Dia,
beside = TRUE,
col = c("pink", "red"))
legend("topright", legend = c("Real", "Modelo"),
fill = c("pink", "red"))
Fo1<-hi1
Fo1
## [1] 0.07221697 0.05298013 0.15468307 0.06985178 0.08262378 0.13308105
## [7] 0.11920530 0.17360454 0.08215074 0.05960265
Fe1<-P1
Fe1
## [1] 0.01919987 0.05464181 0.10367182 0.14752229 0.16793629 0.15931263
## [7] 0.12954154 0.09216711 0.05828951 0.03317778
#correlacion
Correlación1<-cor(Fo1,Fe1)*100
plot(Fo1,Fe1, main="Gráfica N°10.11: Correlación de frecuencias en el modelo Poison
de los dias de los Focos de calor en ecuador",
xlab="Observado (hi)", ylab="Esperado (P)")
abline(lm(Fe1 ~ Fo1), col="red",lwd=2)
x2<-sum(((Fo1-Fe1)^2)/Fe1)
x2
## [1] 0.3636956
vc<-qchisq(0.95,9)
vc
## [1] 16.91898
x2 >vc
## [1] FALSE
#Tabla resumen de test
Variable <- c("Día")
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º10.1: Resumen de test de bondad al modelo de probabilidad")
Tabla Nº10.1: Resumen de test de bondad al modelo de
probabilidad
| Día |
36 |
0.36 |
16.92 |
# calculo de probabilidad
n1 <- sum(TDFDia1_10$ni_dia)
print(n1)
## [1] 6342
#¿De los 6342 focos de calor entre el dia 1 y 10, cuál es la probabilidad de que un foco de calor ocurra en el dia 7?
probabilidad_7 <- dpois(7, lambda1) * 100
cat("La probabilidad de que un foco de calor ocurra en el día 7 es aproximadamente:",
round(probabilidad_7, 2), "%\n")
## La probabilidad de que un foco de calor ocurra en el día 7 es aproximadamente: 12.95 %
# Agrupar solo días del 11 al 20
TDFDia11_20 <- subset(TDFDia, as.numeric(as.character(Dia)) >= 11 & as.numeric(as.character(Dia)) <= 20)
# Calcular frecuencias relativas para el grupo 11-20
hi2 <- TDFDia11_20$ni_dia / sum(TDFDia11_20$ni_dia)
print(hi2)
## [1] 0.05553494 0.06852195 0.03920841 0.07161410 0.03661101 0.32776747
## [7] 0.09090909 0.03079777 0.09165121 0.18738404
# Gráfico de barras para días 11-20
barplot(hi2 * 100,
main = "Gráfica N°10.12: Distribución de Probabilidad de Día (11-20)",
xlab = "Día",
ylab = "Probabilidad (%)",
names.arg = TDFDia11_20$Dia,
col = "lightblue")
# Extraer días numéricos
dias_numericos_11_20 <- as.numeric(as.character(TDFDia11_20$Dia))
# Calcular lambda para días 11-20 (media ponderada)
lambda2 <- sum(dias_numericos_11_20 * TDFDia11_20$ni_dia) / sum(TDFDia11_20$ni_dia)
print(lambda2)
## [1] 16.32777
# Probabilidades teóricas usando distribución Poisson
P2 <- dpois(dias_numericos_11_20, lambda2)
print(P2)
## [1] 0.04466629 0.06077506 0.07633239 0.08902411 0.09690433 0.09888946
## [7] 0.09497906 0.08615534 0.07403812 0.06044386
# Comparar observados vs modelo Poisson
barplot(rbind(hi2 * 100, P2 * 100),
main = "Gráfica N°10.13: Modelo de probabilidad Poisson para Días 11-20",
xlab = "Día",
ylab = "Probabilidad (%)",
names.arg = TDFDia11_20$Dia,
beside = TRUE,
col = c("lightblue", "darkblue"))
legend("topright", legend = c("Real", "Modelo"),
fill = c("lightblue", "darkblue"))
# Valores observados y esperados
Fo2 <- hi2
Fe2 <- P2
# Correlación entre observados y esperados
Correlación2 <- cor(Fo2, Fe2) * 100
plot(Fo2, Fe2, main = "Gráfica N°10.14:Correlación de frecuencias en modelo Poisson \n para días 11-20",
xlab = "Observado (hi)", ylab = "Esperado (P)")
abline(lm(Fe2 ~ Fo2), col = "red", lwd = 2)
# Cálculo Chi-cuadrado
x2_2 <- sum(((Fo2 - Fe2)^2) / Fe2)
print(x2_2)
## [1] 0.8988653
# Valor crítico Chi-cuadrado para 95% y grados de libertad = 9 (10 días -1)
vc2 <- qchisq(0.95, 9)
print(vc2)
## [1] 16.91898
# Comparar si x2 es mayor que el valor crítico
x2_2 > vc2
## [1] FALSE
# Tabla resumen de test
Variable <- c("Día 11-20")
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")
library(knitr)
kable(tabla_resumen, format = "markdown", caption = "Tabla Nº10.3: Resumen de test de bondad al modelo de probabilidad")
Tabla Nº10.3: Resumen de test de bondad al modelo de
probabilidad
| Día 11-20 |
21 |
0.9 |
16.92 |
# Cálculo total de observaciones para días 11-20
n2 <- sum(TDFDia11_20$ni_dia)
print(n2)
## [1] 8085
# Calcular la probabilidad estimada para el día 15 en porcentaje
probabilidad_15 <- dpois(15, lambda2) * 100
cat("La probabilidad de que un foco de calor ocurra en el día 15 es aproximadamente:",
round(probabilidad_15, 2), "%\n")
## La probabilidad de que un foco de calor ocurra en el día 15 es aproximadamente: 9.69 %
# Agrupar solo días del 21 al 31
TDFDia21_31 <- subset(TDFDia, as.numeric(as.character(Dia)) >= 21 & as.numeric(as.character(Dia)) <= 31)
# Calcular frecuencias relativas para el grupo 21-31
hi3 <- TDFDia21_31$ni_dia / sum(TDFDia21_31$ni_dia)
print(hi3)
## [1] 0.10299416 0.04758355 0.14188098 0.07690396 0.06187104 0.03093552
## [7] 0.05342279 0.16213194 0.09442167 0.16349857 0.06435582
# Gráfico de barras para días 21-31
barplot(hi3 * 100,
main = "Gráfica N°10.15: Distribución de Probabilidad de Día (21-31)",
xlab = "Día",
ylab = "Probabilidad (%)",
names.arg = TDFDia21_31$Dia,
col = "lightgreen")
# Extraer días numéricos
dias_numericos_21_31 <- as.numeric(as.character(TDFDia21_31$Dia))
# Calcular lambda para días 21-31 (media ponderada)
lambda3 <- sum(dias_numericos_21_31 * TDFDia21_31$ni_dia) / sum(TDFDia21_31$ni_dia)
print(lambda3)
## [1] 26.2901
# Probabilidades teóricas usando distribución Poisson
P3 <- dpois(dias_numericos_21_31, lambda3)
print(P3)
## [1] 0.04893819 0.05848135 0.06684698 0.07322557 0.07700430 0.07786348
## [7] 0.07581624 0.07118630 0.06453431 0.05655377 0.04796143
# Comparar observados vs modelo Poisson
barplot(rbind(hi3 * 100, P3 * 100),
main = "Gráfica N°10.16: Modelo de probabilidad Poisson para Días 21-31",
xlab = "Día",
ylab = "Probabilidad (%)",
names.arg = TDFDia21_31$Dia,
beside = TRUE,
col = c("lightgreen", "darkgreen"))
legend("topright", legend = c("Real", "Modelo"),
fill = c("lightgreen", "darkgreen"))
# Valores observados y esperados
Fo3 <- hi3
Fe3 <- P3
# Correlación entre observados y esperados
Correlación3 <- cor(Fo3, Fe3) * 100
plot(Fo3, Fe3, main = "Correlación de frecuencias en modelo Poisson \n para días 21-31",
xlab = "Observado (hi)", ylab = "Esperado (P)")
abline(lm(Fe3 ~ Fo3), col = "red", lwd = 2)
# Cálculo Chi-cuadrado
x2_3 <- sum(((Fo3 - Fe3)^2) / Fe3)
print(x2_3)
## [1] 0.5218906
# Valor crítico Chi-cuadrado para 95% y grados de libertad = 10 (11 días -1)
vc3 <- qchisq(0.95, 10)
print(vc3)
## [1] 18.30704
# Comparar si x2 es mayor que el valor crítico
x2_3 > vc3
## [1] FALSE
# Tabla resumen de test
Variable <- c("Día 21-31")
tabla_resumen <- data.frame(
Variable,
round(Correlación3, 0),
round(x2_3, 2),
round(vc3, 2)
)
colnames(tabla_resumen) <- c("Variable", "Test Pearson (%)", "Chi Cuadrado", "Umbral de aceptación")
library(knitr)
kable(tabla_resumen, format = "markdown", caption = "Tabla Nº10.4: Resumen de test de bondad al modelo de probabilidad")
Tabla Nº10.4: Resumen de test de bondad al modelo de
probabilidad
| Día 21-31 |
-23 |
0.52 |
18.31 |
# Cálculo total de observaciones para días 21-31
n3 <- sum(TDFDia21_31$ni_dia)
print(n3)
## [1] 8049
# Calcular la probabilidad estimada para el día 25 en porcentaje
probabilidad_25 <- dpois(25, lambda3) * 100
cat("La probabilidad de que un foco de calor ocurra en el día 25 es aproximadamente:",
round(probabilidad_25, 2), "%\n")
## La probabilidad de que un foco de calor ocurra en el día 25 es aproximadamente: 7.7 %