Tema: Estadistica inferencial de variables cuantitativas continuas
Temperatura máxima
Cargamos las librería
library(PASWR)
## Loading required package: lattice
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(readr)
library(MASS)
##
## Attaching package: 'MASS'
## The following object is masked from 'package:dplyr':
##
## select
Carga los datos (Conjunto de datos)
setwd("/cloud/project")
read_csv("weatherdataANTISANA.csv")
## Rows: 366 Columns: 10
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): Date
## dbl (9): Longitude, Latitude, Elevation, Max Temperature, Min Temperature, P...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
## # A tibble: 366 × 10
## Date Longitude Latitude Elevation `Max Temperature` `Min Temperature`
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 01/01/2012 -78.1 -0.468 4048 16.1 6.91
## 2 01/02/2012 -78.1 -0.468 4048 15.5 9.23
## 3 01/03/2012 -78.1 -0.468 4048 11.5 8.69
## 4 01/04/2012 -78.1 -0.468 4048 12.0 9.53
## 5 01/05/2012 -78.1 -0.468 4048 11.7 7.90
## 6 01/06/2012 -78.1 -0.468 4048 12.1 7.84
## 7 01/07/2012 -78.1 -0.468 4048 13.1 6.39
## 8 01/08/2012 -78.1 -0.468 4048 11.5 9.76
## 9 01/09/2012 -78.1 -0.468 4048 12.9 10.1
## 10 01/10/2012 -78.1 -0.468 4048 13.4 8.41
## # ℹ 356 more rows
## # ℹ 4 more variables: Precipitation <dbl>, Wind <dbl>,
## # `Relative Humidity` <dbl>, Solar <dbl>
datos<- read.csv("weatherdataANTISANA.csv", header = T, sep = ",", dec = ".")
EXTRAER LA VARIABLE CONTINUA
TemperaturaMax<-datos$Max.Temperature
min(TemperaturaMax)
## [1] 10.322
n<-length(TemperaturaMax)
# Ajustar modelo log-normal
logn_params <- fitdistr(TemperaturaMax, "lognormal")
# Graficar histograma
Histo_TemMax<-hist(TemperaturaMax, freq = FALSE,main = "Gráfica No.9.1: Modelo de probabilidad - Log-normal",
xlab = "Solar (j/m)", ylab = "Densidad de probabilidad",col = "salmon")
Conjeturamos el modelo
h<-length(Histo_TemMax$counts)
Logarea<-log(TemperaturaMax)
u<-mean(Logarea)
sigma<-sd(Logarea)
x <- seq(min(TemperaturaMax), max(TemperaturaMax), 0.01)
Histo_TemMax<-hist(TemperaturaMax, freq = FALSE,main = "Gráfica No.9.2: Modelo de probabilidad - Log-normal",
xlab = "Temperatura (°C)", ylab = "Densidad de probabilidad",col = "salmon")
# 6. Superponer la curva log-normal
curve(dlnorm(x, u,sigma),add = TRUE, col = "darkgreen",lwd = 3)
#El modelo si se acopla, para verificar la correlacion entre la frecuencia observada y la esperada realizaremos el test de Pearson y Chi-cuadrado.
#Frecuencia observada
Fo<-Histo_TemMax$counts
Fo
## [1] 7 23 41 53 37 40 41 42 28 22 16 9 4 3
# Frecuencia esperada
P<-c(0)
for (i in 1:h)
{P[i] <-(plnorm(Histo_TemMax$breaks[i+1],u,sigma)-
plnorm(Histo_TemMax$breaks[i],u,sigma))}
Fe <- P * n
sum(Fe)
## [1] 360.2608
n
## [1] 366
Test de Pearson
Mide el grado de correlación entre la frecuencia observada y la frecuencia esperada.
plot(Fo,Fe,main="Gráfica 9.4:Correlación de frecuencias en el modelo log-normal
de la profundidad",xlab="Frecuencia Observada",ylab="Frecuencia esperada",col="blue3")
Correlación<-cor(Fo,Fe)*100
Correlación
## [1] 92.48593
Test de Chi-Cuadrado El test de Chi-Cuadrado utiliza dos parámetro: grados de libertad (se refiere al numero de valores libres de variar dentro de intervalos de la variable, k-1), y nivel de significancia (probabilidad de cometer un error, valores de 0.05,0.1,0.15)¨
#Grados de libertad
grados_libertad <- length(Histo_TemMax$counts)-1
grados_libertad
## [1] 13
# Nivel de significancia
nivel_significancia <- 0.05
#Frecuencia Observada porcentual
Fo<-(Histo_TemMax$counts/n)*100
Fo
## [1] 1.9125683 6.2841530 11.2021858 14.4808743 10.1092896 10.9289617
## [7] 11.2021858 11.4754098 7.6502732 6.0109290 4.3715847 2.4590164
## [13] 1.0928962 0.8196721
sum(Fo)
## [1] 100
#Frecuencia esperada
Fe<-P*100
Fe
## [1] 2.1652505 5.0143775 8.7504129 12.1831134 14.1359162 14.1374289
## [7] 12.5138127 10.0117347 7.3630656 5.0463893 3.2593998 2.0023459
## [13] 1.1790068 0.6696611
sum(Fe)
## [1] 98.43192
x2<-sum((Fe-Fo)^2/Fe)
x2
## [1] 4.417066
# Calcular el umbral de aceptación
umbral_aceptacion <- qchisq(1 - nivel_significancia, grados_libertad)
umbral_aceptacion
## [1] 22.36203
x2<umbral_aceptacion
## [1] TRUE
RESUMEN TEST DE BONDAD
Variable<-c("Temperatura máxima")
tabla_resumen<-data.frame(Variable,round(Correlación,2),round(x2,2),round(umbral_aceptacion,2))
colnames(tabla_resumen)<-c("Variable","Test Pearson (%)","Chi Cuadrado","Umbral de aceptación")
library(knitr)
kable(tabla_resumen, format = "markdown", caption = "Tabla 9.1:Resumen de test de bondad al modelo de probabilidad")
Variable | Test Pearson (%) | Chi Cuadrado | Umbral de aceptación |
---|---|---|---|
Temperatura máxima | 92.49 | 4.42 | 22.36 |
Cálculo de probabilidades
Cálculo de la probabilidad para temperatura máxima entre 13 °C y 17 °C
probabilidad <- plnorm(17, u, sigma) - plnorm(13, u, sigma)
cat("Probabilidad entre 13 °C y 17 °C:", round(probabilidad * 100, 2), "%\n")
## Probabilidad entre 13 °C y 17 °C: 52.97 %
# Secuencia para la curva (temperatura máxima)
x_full <- seq(min(TemperaturaMax), max(TemperaturaMax), length.out = 1000)
# Graficar la curva log-normal completa
plot(x_full, dlnorm(x_full, u, sigma), type = "l", col = "skyblue3", lwd = 2,
main = "Cálculo de probabilidades: Temperatura máxima",
ylab = "Densidad de probabilidad", xlab = "Temperatura máxima (°C)")
# Área sombreada entre 13 °C y 17 °C
x_sombreado <- seq(13, 17, length.out = 1000)
y_sombreado <- dlnorm(x_sombreado, u, sigma)
polygon(c(x_sombreado, rev(x_sombreado)),
c(y_sombreado, rep(0, length(y_sombreado))),
col = rgb(1, 0, 0, 0.4), border = NA)
# Leyenda
legend("topright",
legend = c("Modelo log-normal", paste0("Área 13-17 °C (P = ", round(probabilidad * 100, 2), "%)")),
col = c("skyblue3", rgb(1, 0, 0, 0.4)), lwd = 2, pch = c(NA, 15))
Teorema de límite central
El teorema de límite central nos indica que, aunque las variables individuales no sigan una distribución normal, la distribución de las medias aritméticas de n conjuntos muestrales, ses normal, y por lo tanto, podemos obtener la media poblacional mediante intervalos de confianza
# Nuestra media aritmetica muestral es nuestro "u"
x<-mean(TemperaturaMax)
x
## [1] 15.74001
sigmap<-sd(TemperaturaMax)
sigmap
## [1] 2.867474
e<-sigmap/sqrt(n)
e
## [1] 0.1498853
#P(x-2e<u<x+2e)=95%
li<-(x-2*e) #limite inferior
li
## [1] 15.44023
ls<-x+2*e #limite superior
ls
## [1] 16.03978
tabla_media<-data.frame(round(li,2),x,round(ls,2),e)
colnames(tabla_media)<-c("Limite inferior","Media poblacional","Límite superior", "Desviación estándar poblacional")
library(knitr)
kable(tabla_media, format = "markdown", caption = "Tabla 9.2: media poblacional de la temperatura máxima de cada uno de los registros de clima en el
volcán Antisana")
Limite inferior | Media poblacional | Límite superior | Desviación estándar poblacional |
---|---|---|---|
15.44 | 15.74001 | 16.04 | 0.1498853 |
CONCLUSIONES: La variable temperatura máxima (°C) sigue un modelo de probabilidad log-normal aprobando los test de Pearson y Chi-Cuadrado, de esta manera, logramos calcular probabilidades, como por ejemplo, que al seleccionar aleatoriamente una temperatura máxima en el volcán Antisana la probabilidad de que su temperatura este entre 13 (°C) y 17 (°C) es del 52.97 % y, mediante el teorema de límite central, sabemos que, su media aritmética poblacional se encuentra entre 15.44 (°C) y 16.04 (°C) con una confianza del 95%.
.