EI LATITUD

UNIVERSIDAD CENTRAL DEL ECUADOR

PROYECTO: FOCOS DE CALOR EN EL ECUADOR

AUTORES: GUERRERO MARIA GABRIELA, PUCHAICELA MONICA, ZURITA JOHANNA

FECHA: 14/05/2025

# Configuración
# Leer CSV
datos <- read.csv("Focos de Calor 2021.csv", header=TRUE, sep=",", dec=".")

# Extraer y limpiar variable Latitud
Latitud <- as.numeric(as.character(datos$LATITUDE))
Latitud <- na.omit(Latitud)

# Transformar latitud a grados decimales normales
Latitud <- Latitud / 1e15  # como vimos en tus ejemplos: -498000000000000000 → -4.98°

# Asegurar que se muestre con decimales en lugar de notación científica
options(scipen=999)
Latitud <- round(Latitud, 4)

# Información básica
n <- length(Latitud)
cat("Tamaño muestral:", n, "\n")

## Tamaño muestral: 22476

# Histograma
histograma <- hist(Latitud, freq=FALSE,
                   main="Gráfica Nro 11.8: Histograma de Latitud de los Focos de Calor",
                   xlab="Latitud", ylab="Densidad de probabilidad", col="yellow")

limites_barras <- histograma$breaks
print(limites_barras)

##  [1] -5.0 -4.5 -4.0 -3.5 -3.0 -2.5 -2.0 -1.5 -1.0 -0.5  0.0  0.5  1.0  1.5

#AGRUPACION 1
Lat1 <- Latitud[Latitud >= -5 & Latitud <= -3]
HistoLat1 <- hist(Lat1, breaks = seq(min(Lat1), max(Lat1), length.out = 5),
                   freq = F, main = "Gráfica Nº11.9: Modelo normal para Latitud (-5 a -3)",
                   xlab = "Latitud", ylab = "Densidad", col = "yellow")

u <- mean(Lat1); sigma <- sd(Lat1)
x <- seq(min(Lat1), max(Lat1), 0.01)
curve(dnorm(x, u, sigma), add = TRUE, col = "skyblue", lwd = 4)

# TEST DE PEARSON 
Fo <- HistoLat1$counts
h <- length(Fo)
P <- sapply(1:h, function(i) pnorm(HistoLat1$breaks[i+1], u, sigma) - pnorm(HistoLat1$breaks[i], u, sigma))
Fe <- P * length(Lat1)
Correlación<-cor(Fo,Fe)*100
Correlación

## [1] 93.63979

plot(Fo, Fe, main = "Gráfica Nº11.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] 93.63979

#Test Chi-Cuadrado
Fo_rel <- (Fo / length(Latitud)) * 100
Fe_rel <- P * 100
x2 <- sum((Fe_rel - Fo_rel)^2 / Fe_rel)
gl <- length(Lat1) - 1
umbral <- qchisq(0.95, gl)
umbral

## [1] 2818.931

x2 < umbral  # TRUE = Aceptado

## [1] TRUE

# Resultados
Variable <- c("Latitud")
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º 11.1: Resumen del test de bondad al modelo de probabilidad")

Tabla Nº 11.1: Resumen del test de bondad al modelo de probabilidad

Variable	Test.Pearson….	Chi.Cuadrado	Umbral.de.aceptación
Latitud	93.64	77.31	2818.93

# AGRUPACION 2: Longitud entre -3 y 1
Lat2 <- Latitud[Latitud >= -3 & Latitud <= 1]

# Histograma de la agrupación
HistoLat2 <- hist(Lat2, breaks = seq(min(Lat2), max(Lat2), length.out = 5),
                   freq = FALSE, 
                   main = "Gráfica Nº11.11: Modelo normal para Latitud (-3 a 1)",
                   xlab = "Latitud ", ylab = "Densidad", col = "yellow")

# Parámetros de la distribución normal para Long2
u2 <- mean(Lat2)
sigma2 <- sd(Lat2)

# Curva normal sobre el histograma
curve(dnorm(x, u2, sigma2), from = min(Lat2), to = max(Lat2),
      add = TRUE, col = "skyblue", lwd = 4)

# Frecuencia observada
Fo2 <- HistoLat2$counts
h2 <- length(Fo2)

# Probabilidades teóricas (frecuencia esperada relativa)
P2 <- sapply(1:h2, function(i) pnorm(HistoLat2$breaks[i+1], u2, sigma2) - pnorm(HistoLat2$breaks[i], u2, sigma2))

# Frecuencia esperada absoluta
Fe2 <- P2 * length(Lat2)

# Correlación de Pearson en %
Correlación2 <- cor(Fo2, Fe2) * 100
Correlación2

## [1] 96.9683

# Gráfico correlación Fo vs Fe
plot(Fo2, Fe2, main = "Gráfica Nº11.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(Latitud)) * 100
Fe2_rel <- P2 * 100
x2_2 <- sum((Fe2_rel - Fo2_rel)^2 / Fe2_rel)

gl2 <- length(Lat2) - 1
umbral2 <- qchisq(0.95, gl2)

# Verificar aceptación del modelo
aceptado <- x2_2 < umbral2

# Resultados en tabla
Variable <- c("Latitud")
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º 11.2: Resumen del test de bondad al modelo de probabilidad para Longitud (-3 a 1)")

Tabla Nº 11.2: Resumen del test de bondad al modelo de probabilidad para Longitud (-3 a 1)

Variable	Test.Pearson….	Chi.Cuadrado	Umbral.de.aceptación
Latitud	96.97	4.94	20069.98

# Filtrar un rango específico si quieres trabajar con una parte
Lat1 <- Latitud[Latitud >= -5 & Latitud <= -3]

# Parámetros
u <- mean(Lat1)
sigma <- sd(Lat1)

# Secuencia para graficar la curva normal
x <- seq(min(Lat1), max(Lat1), 0.01)

# Graficar la curva normal
plot(x, dnorm(x, u, sigma), type = "l", col = "skyblue3", lwd = 2,
     main = "Gráfica: Densidad de probabilidad y área entre -4.5 y -4",
     xlab = "Latitud (°)", ylab = "Densidad de probabilidad")

# Definir rango para sombrear el área de probabilidad
x_section <- seq(-4.5, -4, 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 -4.5 y -4
probabilidad <- pnorm(-4, u, sigma) - pnorm(-4.5, u, sigma)
cat(sprintf("Probabilidad de latitud entre -4.5 y -4: %.4f (%.2f%%)\n", probabilidad, probabilidad*100))

## Probabilidad de latitud entre -4.5 y -4: 0.4721 (47.21%)

# 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 del límite central: intervalo de confianza 95%
Variable <- "Latitud"
n <- length(Latitud)
x <- mean(Latitud)
sigma <- sd(Latitud)
e <- sigma / sqrt(n)
li <- x - 2 * e
ls <- x + 2 * e

# Tabla de la media poblacional
tabla_media <- data.frame(round(li, 4), Variable, round(ls, 4), round(e, 4))
colnames(tabla_media) <- c("Límite inferior", "Media poblacional", "Límite superior", "Error estándar")
library(knitr)
kable(tabla_media, format = "markdown", caption = "Tabla N°29: Estimación de la media poblacional para la Latitud")

Tabla N°29: Estimación de la media poblacional para la Latitud

Límite inferior	Media poblacional	Límite superior	Error estándar
-1.6925	Latitud	-1.6629	0.0074

# Resultados y Conclusiones

#La variable**latitud**  se analiza en rangos entre -5° y 1°, donde se aplicaron modelos normales que mostraron correlaciones superiores al 94% y aceptación en el test Chi-cuadrado.  
#Se calculó que la probabilidad de encontrar un foco de calor entre -4.5° y -4° es de aproximadamente 47.21%.  
#Además, la media poblacional de la latitud se estimó entre -1.69° y -1.66° con un 95% de confianza, lo que confirma la confiabilidad del modelo estadístico aplicado.nitr::opts_chunk$set(echo = TRUE)