FECHA: 14/05/2025
# Configuración
knitr::opts_chunk$set(echo = TRUE)
datos <- read.csv("Focos de Calor 2021.csv", header=TRUE, sep=",", dec=".")
Longitud <- as.numeric(as.character(datos$LONGITUDE))
Longitud <- na.omit(Longitud)
Longitud <- Longitud / 1e15
summary(Longitud)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -80.90 -80.20 -79.80 -79.45 -79.20 -75.30
histograma <- hist(Longitud, freq = FALSE,
main = "Gráfica Nº12.8: Histograma de Longitud de Focos de Calor",
xlab = "Longitud (°)", ylab = "Densidad de probabilidad",
col = "skyblue")
#AGRUPACION 1
Long1 <- Longitud[Longitud >= -81 & Longitud <= -79]
HistoLong1 <- hist(Long1, breaks = seq(min(Long1), max(Long1), length.out = 5),
freq = F, main = "Gráfica Nº12.9: Modelo normal para Longitud (-81 a -79)",
xlab = "Longitud (°)", ylab = "Densidad", col = "yellow")
u <- mean(Long1); sigma <- sd(Long1)
x <- seq(min(Long1), max(Long1), 0.01)
curve(dnorm(x, u, sigma), add = TRUE, col = "skyblue", lwd = 4)
# TEST DE PEARSON
Fo <- HistoLong1$counts
h <- length(Fo)
P <- sapply(1:h, function(i) pnorm(HistoLong1$breaks[i+1], u, sigma) - pnorm(HistoLong1$breaks[i], u, sigma))
Fe <- P * length(Long1)
Correlación<-cor(Fo,Fe)*100
Correlación
## [1] 99.53051
plot(Fo, Fe, main = "Gráfica Nº12.10: Pearson entre Frecuencia Observada y Esperada",
xlab = "Fo", ylab = "Fe", col = "blue3")
abline(lm(Fe ~ Fo), col = "red", lwd = 2)
cor(Fo, Fe) * 100 # Correlación en %
## [1] 99.53051
#Test Chi-Cuadrado
Fo_rel <- (Fo / length(Longitud)) * 100
Fe_rel <- P * 100
x2 <- sum((Fe_rel - Fo_rel)^2 / Fe_rel)
gl <- length(Long1) - 1
umbral <- qchisq(0.95, gl)
umbral
## [1] 17345.79
x2 < umbral # TRUE = Aceptado
## [1] TRUE
# Resultados
Variable <- c("Longitud")
tabla_resumen <- data.frame(
Variable,
`Test Pearson (%)` = round(Correlación, 2),
`Chi Cuadrado` = round(x2, 2),
`Umbral de aceptación` = round(umbral, 2)
)
library(knitr)
kable(tabla_resumen, format = "markdown", caption = "Tabla Nº 12.1: Resumen del test de bondad al modelo de probabilidad")
Tabla Nº 12.1: Resumen del test de bondad al modelo de
probabilidad
| Longitud |
99.53 |
5.86 |
17345.79 |
# AGRUPACION 2: Longitud entre -79 y -77
Long2 <- Longitud[Longitud >= -79 & Longitud <= -77]
# Histograma de la agrupación
HistoLong2 <- hist(Long2, breaks = seq(min(Long2), max(Long2), length.out = 5),
freq = FALSE,
main = "Gráfica Nº12.11: Modelo normal para Longitud (-79 a -77)",
xlab = "Longitud (°)", ylab = "Densidad", col = "yellow")
# Parámetros de la distribución normal para Long2
u2 <- mean(Long2)
sigma2 <- sd(Long2)
# Curva normal sobre el histograma
curve(dnorm(x, u2, sigma2), from = min(Long2), to = max(Long2),
add = TRUE, col = "skyblue", lwd = 4)
# Frecuencia observada
Fo2 <- HistoLong2$counts
h2 <- length(Fo2)
# Probabilidades teóricas (frecuencia esperada relativa)
P2 <- sapply(1:h2, function(i) pnorm(HistoLong2$breaks[i+1], u2, sigma2) - pnorm(HistoLong2$breaks[i], u2, sigma2))
# Frecuencia esperada absoluta
Fe2 <- P2 * length(Long2)
# Correlación de Pearson en %
Correlación2 <- cor(Fo2, Fe2) * 100
Correlación2
## [1] 91.16231
# Gráfico correlación Fo vs Fe
plot(Fo2, Fe2, main = "Gráfica Nº 12.12: Pearson entre Frecuencia Observada y Esperada",
xlab = "Frecuencia Observada (Fo)", ylab = "Frecuencia Esperada (Fe)", col = "blue3", pch = 16)
abline(lm(Fe2 ~ Fo2), col = "red", lwd = 2)
# Test Chi-cuadrado
Fo2_rel <- (Fo2 / length(Longitud)) * 100
Fe2_rel <- P2 * 100
x2_2 <- sum((Fe2_rel - Fo2_rel)^2 / Fe2_rel)
gl2 <- length(Long2) - 1
umbral2 <- qchisq(0.95, gl2)
# Verificar aceptación del modelo
aceptado <- x2_2 < umbral2
# Resultados en tabla
Variable <- c("Longitud")
tabla_resumen2 <- data.frame(
Variable,
`Test Pearson (%)` = round(Correlación2, 2),
`Chi Cuadrado` = round(x2_2, 2),
`Umbral de aceptación` = round(umbral2, 2))
library(knitr)
kable(tabla_resumen2, format = "markdown", caption = "Tabla N º 12.2: Resumen del test de bondad al modelo de probabilidad para Longitud (-79 a -75)")
Tabla N º 12.2: Resumen del test de bondad al modelo de
probabilidad para Longitud (-79 a -75)
| Longitud |
91.16 |
64.58 |
4386.49 |
# AGRUPACION 3: Longitud entre -77 y -75
# 1. Extraer y transformar los datos
Long3 <- Longitud[Longitud >= -77 & Longitud <= -75]
Long3_pos <- Long3 - min(Long3) # Ahora todos los valores son >= 0
# 2. Histograma de densidad
HistoExp <- hist(Long3_pos, breaks = 5, freq = FALSE,
main = "Gráfica Nº 12.13: Modelo Exponencial para Longitud (-77 a -75)",
xlab = "Longitud ajustada (°)", ylab = "Densidad", col = "orange")
# 3. Parámetro lambda (λ) de la exponencial
lambda <- 1 / mean(Long3_pos)
# 4. Curva del modelo exponencial
curve(dexp(x, rate = lambda), from = 0, to = max(Long3_pos),
add = TRUE, col = "blue", lwd = 3)
# 5. Frecuencia observada y esperada
Fo_exp <- HistoExp$counts
h_exp <- length(Fo_exp)
P_exp <- sapply(1:h_exp, function(i)
pexp(HistoExp$breaks[i+1], rate = lambda) - pexp(HistoExp$breaks[i], rate = lambda)
)
Fe_exp <- P_exp * length(Long3_pos)
# 6. Correlación de Pearson
Correlacion_exp <- cor(Fo_exp, Fe_exp) * 100
Correlacion_exp
## [1] 99.14883
# 7. Chi-cuadrado
Fo_rel_exp <- (Fo_exp / length(Long3_pos)) * 100
Fe_rel_exp <- P_exp * 100
x2_exp <- sum((Fe_rel_exp - Fo_rel_exp)^2 / Fe_rel_exp)
# 8. Umbral de aceptación
gl_exp <- h_exp - 1 # grados de libertad = n - 1
umbral_exp <- qchisq(0.95, gl_exp)
# 9. Verificar si el modelo es aceptado
aceptado_exp <- x2_exp < umbral_exp
aceptado_exp # TRUE si el modelo es aceptado
## [1] TRUE
# 10. Tabla resumen
Variable <- c("Longitud ajustada")
tabla_exp <- data.frame(
Variable,
`Test Pearson (%)` = round(Correlacion_exp, 2),
`Chi Cuadrado` = round(x2_exp, 2),
`Umbral de aceptación` = round(umbral_exp, 2)
)
# Mostrar tabla bonita
library(knitr)
kable(tabla_exp, format = "markdown", caption = "Tabla Nº 12.3: Resumen del modelo exponencial para la agrupación de Longitud (-77 a -75)")
Tabla Nº 12.3: Resumen del modelo exponencial para la
agrupación de Longitud (-77 a -75)
| Longitud ajustada |
99.15 |
4.32 |
7.81 |
#probabilidad
# Suponiendo que ya tienes Long1, u, sigma definidos como en tu código
# Secuencia para graficar la curva normal
x <- seq(min(Long1), max(Long1), 0.01)
# Graficar la curva normal
plot(x, dnorm(x, u, sigma), type = "l", col = "skyblue3", lwd = 2,
main = "Gráfica Nº 12.14: Densidad de probabilidad y área entre -80.5 y -80",
xlab = "Longitud (°)", ylab = "Densidad de probabilidad")
# Definir rango para sombrear el área de probabilidad (-80.5 a -80)
x_section <- seq(-80.5, -80, 0.001)
y_section <- dnorm(x_section, u, sigma)
# Sombrear el área bajo la curva para ese rango
polygon(c(x_section, rev(x_section)), c(y_section, rep(0, length(y_section))),
col = rgb(1, 0, 0, 0.5), border = NA)
# Dibujar la curva en el rango sombreado (borde rojo)
lines(x_section, y_section, col = "red", lwd = 2)
# Calcular la probabilidad acumulada entre -80.5 y -80
probabilidad <- pnorm(-80, u, sigma) - pnorm(-80.5, u, sigma)
cat(sprintf("Probabilidad de longitud entre -80.5 y -80: %.4f (%.2f%%)\n", probabilidad, probabilidad*100))
## Probabilidad de longitud entre -80.5 y -80: 0.3982 (39.82%)
# Añadir leyenda
legend("topright", legend = c("Densidad Normal", "Área Probabilidad"),
col = c("skyblue3", "red"), lwd = 2, fill = c(NA, rgb(1, 0, 0, 0.5)), border = NA)
#Teorema de límite central
Variable <- "Longitud (°)"
n <- length(Longitud)
x<-mean(Longitud)
x
## [1] -79.44604
sigma<-sd(Longitud)
sigma
## [1] 1.066839
#P(x-2e<u<x+2e)=95%
e<-sigma/sqrt(n)
li<-x-2*e
li
## [1] -79.46027
ls<-x+2*e
ls
## [1] -79.43181
tabla_media<-data.frame(round(li,2),Variable,round(ls,2),e)
colnames(tabla_media)<-c("Limite superior","Media poblacional","Límite superior", "Desviación estándar poblacional")
library(knitr)
kable(tabla_media, format = "markdown", caption = "Tabla Nro.29: Media poblacional")
Tabla Nro.29: Media poblacional
| -79.46 |
Longitud (°) |
-79.43 |
0.0071161 |
#CONCLUSION
#La variable longitud medida en grados se explica En rangos entre -81° y -75°, se aplicaron modelos normales y
#exponenciales, obteniendo correlaciones mayores al 91% y aceptación en el test Chi-cuadrado.
#Se calculó que la probabilidad de encontrar un foco de calor entre -80.5° y -80° es de aproximadamente 39.82%.
#Además, la media poblacional de la longitud se estimó entre -79.46° y -79.43° con un 95% de confianza,
#lo que confirma la confiabilidad del modelo aplicado.