Variable cuantitativa continua

Profundidad

1 Extraer la variable continua

datos <- read.csv("~/DATOS_INDIA/Earthquakes (2).csv")
profundidad<-datos$depth
Profundidad<-as.numeric(profundidad)
ValorNulo<- is.na(Profundidad)
Profundidad<- na.omit(Profundidad)

Gráfica de la variable

histograma<-hist(Profundidad,freq = FALSE,main="Gráfica 103.Modelo de probabilidad log-normal",
                 xlab="Profundidad (km)",ylab="Densidad de probabilidad",col="blue")

Ajuste del modelo al histograma

histograma<-hist(Profundidad,freq = FALSE,main="Gráfica 104 .Modelo de probabilidad 
lognormal de Profundidad",
                 xlab="Profundidad",ylab="Densidad de probabilidad",col="blue")
h<-length(histograma$counts)

Logprof<-log(Profundidad)
ulog<-mean(Logprof)
sigmalog<-sd(Logprof)

x<-seq(min(Profundidad),max(Profundidad),0.01)
curve(dlnorm(x,ulog,sigmalog),type="l",add=TRUE,lwd=4,col="black")

Frecuencia simple observada

Fo<-histograma$counts
Fo
##  [1] 7213 7361 1539  630  419  255  175   95   60   21   17   13    5    2

Frecuencia simple esperada

P<-c(0)
for (i in 1:h) 
{P[i] <-(plnorm(histograma$breaks[i+1],ulog,sigmalog)-
           plnorm(histograma$breaks[i],ulog,sigmalog))}
Fe<-P*length(Profundidad)

Comparar tamaño real y el modelo

sum(Fe)
## [1] 17797.91
n<-length(Profundidad)
n
## [1] 17805

2 Test

TEST DE PEARSON

Grado de correlación entre Fe Y Fo

plot(Fo,Fe,main="Gráfica 105: Correlación de frecuencias en el modelo lognormal
                 de superficie",xlab="Frecuencia Observada",ylab="Frecuencia esperada",col="blue3")
abline(lm(Fe ~ Fo), col="red",lwd=2)

Correlación<-cor(Fo,Fe)*100
Correlación
## [1] 98.61676

TEST DE CHI-CUADRADO

Creación de grados de libertad y nivel de significancia

grados_libertad <- (length(histograma$counts)-1)
grados_libertad
## [1] 13
nivel_significancia <- 0.05

Frecuencia Observada porcentual

Fo<-(histograma$counts/n)*100
Fo
##  [1] 40.5110924 41.3423196  8.6436394  3.5383319  2.3532716  1.4321820
##  [7]  0.9828700  0.5335580  0.3369840  0.1179444  0.0954788  0.0730132
## [13]  0.0280820  0.0112328
sum(Fo)
## [1] 100
Fe<-P*100
Fe
##  [1] 43.16748113 34.29022308 12.78920418  5.10642061  2.25173576  1.08031959
##  [7]  0.55513884  0.30176555  0.17188272  0.10183989  0.06240945  0.03937888
## [13]  0.02549007  0.01687624
sum(Fe)
## [1] 99.96017
x2<-sum((Fe-Fo)^2/Fe)
x2
## [1] 4.275417

Calcular el umbral de aceptación

umbral_aceptacion <- qchisq(1 - nivel_significancia, grados_libertad)
umbral_aceptacion
## [1] 22.36203
x2<umbral_aceptacion
## [1] TRUE

3 Tabla resumen de test

Variable<-c("Profundidad")
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)
## Warning: package 'knitr' was built under R version 4.4.3
kable(tabla_resumen, format = "markdown", caption = "Tabla.Resumen de test de bondad al modelo de probabilidad")
Tabla.Resumen de test de bondad al modelo de probabilidad
Variable Test Pearson (%) Chi Cuadrado Umbral de aceptación
Profundidad 98.62 4.28 22.36

4 Cálculo de probabilidades

¿Cuál es la probabilidad de que al seleccionar cualquier área de la profundidad se encuetre entre 25 km y 75 km?

probabilidadc<-plnorm(75,ulog,sigmalog)-
  plnorm(25,ulog,sigmalog)
probabilidadc*100
## [1] 39.43735
plot(x, dlnorm(x, ulog,sigmalog), col = "skyblue3", lwd = 1, xlim = c(0,250),
     main="Gráfica. Cálculo de probabilidades",
     ylab="Densidad de probabilidad",xlab="Profundidad (km)", xaxt="n")

# Definir el rango de la sección que quieres pintar
x <- seq(80, 20,-0.001)
y_section <- dlnorm(x, ulog,sigmalog)

# Pintar la sección de la curva
lines(x, y_section, col = "red", lwd = 2)

# Pintar el área debajo de la línea roja
polygon(c(x, rev(x)), c(y_section, rep(0, length(y_section))), col = rgb(1, 0, 0, 0.6))

# Añadir leyenda
legend("topright", legend = c("Modelo", "Área de Probabilidad"), col = c("skyblue3", "red"), lwd = 2, pch = c(NA, 15))

# Ajustar la escala del eje x a intervalos de 25
axis(1, at = seq(0, 250, by = 25), labels = seq(0, 250, by = 25), las = 2)

5 Intervalos de confinza

Donde x es la media aritmética muestral y e es el margen de error (desviación estándar de la media poblacional)

x<-mean(Profundidad)
x
## [1] 30.56146
sigma<-sd(Profundidad)

sigma
## [1] 27.7744
e<-sigma/sqrt(n)
e
## [1] 0.2081487
li<-x-2*e
li
## [1] 30.14517
ls<-x+2*e
ls
## [1] 30.97776

5.1 Tabla resumen

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. media poblacional")
Tabla. media poblacional
Limite superior Media poblacional Límite superior Desviación estándar poblacional
30.15 Profundidad 30.98 0.2081487

6 Conclusión

La variable profundidad se explica a través del modelo log-normal siendo la media aritmética poblacional de 30.56 que se encuentra en un intervalo definido por una desviación estandar de 27.77.

De esta manera logramos calcular probabilidades como por ejemplo, que al seleccionar aleatoriamente cualquier área de la profundidad donde se encuentre entre 25km y 75km es de 39.43%.

Mediante el teorema de limite central, sabemos que la media aritmetica poblacional de la profundidad se encuentran entre 30.15 y 30.98 con un 95% de confianza.