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 exponencial",
                 xlab="Profundidad",ylab="Densidad de probabilidad",col="blue")

Ajuste del modelo al histograma

lambda <-1/mean(Profundidad)
x <- seq(0, max(Profundidad),0.001)
y <- dexp(x,lambda)
histograma<-hist(Profundidad,freq = FALSE,main="Gráfica 104.Modelo de probabilidad exponencial",
                 xlab="Profundidad",ylab="Densidad de probabilidad",col="blue")

lines(x, y, col = "black", lwd=3)

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:14) {
  P[i] <-(pexp(histograma$breaks[i+1],lambda)-
           pexp(histograma$breaks[i],lambda))
  }
P
##  [1] 4.802560e-01 2.496102e-01 1.297334e-01 6.742815e-02 3.504537e-02
##  [6] 1.821462e-02 9.466940e-03 4.920385e-03 2.557340e-03 1.329162e-03
## [11] 6.908241e-04 3.590517e-04 1.866149e-04 9.699199e-05
Fe<-P*length(Profundidad)
sum(Fe)
## [1] 17803.13

2 Test

TEST DE PEARSON

plot(Fo,Fe, main="Gráfica 105.Correlación de las frecuencias del modelo exponencial",col="skyblue3",
     xlab = "Frecuencia Observada",ylab="Frecuencia Esperada")
abline(lm(Fe ~ Fo), col="red",lwd=2)

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

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

n<-length(Profundidad)
n
## [1] 17805
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

Frecuencia esperada

Fe<-P*100
Fe
##  [1] 48.025602063 24.961017528 12.973338579  6.742814619  3.504537302
##  [6]  1.821462163  0.946693993  0.492038503  0.255734050  0.132916233
## [11]  0.069082412  0.035905168  0.018661495  0.009699199
sum(Fe)
## [1] 99.9895
x2<-sum((Fe-Fo)^2/Fe)
x2
## [1] 15.44155

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

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

4 Cálculo de probabilidades

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

min(Profundidad)
## [1] 0.6
max(Profundidad)
## [1] 264
probabilidadc<-pexp(80,lambda)-
  pexp(20,lambda)
probabilidadc*100
## [1] 44.67717
plot(x, dexp(x, lambda), col = "blue", lwd = 2
     , xlim = c(0,250),main="Gráfica 106. Cálculo de probabilidades",
     ylab="Densidad de probabilidad",xlab="Profundidad(km)")
# Definir el rango de la sección que quieres pintar
x_section <- seq(20, 80, by = 0.1)
y_section <- dexp(x_section, lambda)
# Pintar la sección de la curva
lines(x_section, y_section, col = "black", lwd = 2)
# Pintar el área debajo de la línea roja
polygon(c(x_section, rev(x_section)), c(y_section, rep(0, length(y_section))), col = rgb(0, 0, 1, 0.6))
# Añadir leyenda
legend("topright", legend = c("Modelo", "Área de Probabilidad"),
       col = c("blue", "black"), lwd = 2, pch = c(NA, 15))

5 Teorema del límite central

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 31. media poblacional")
Tabla 31. 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 exponencial 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 20 y 80 es de 44.67%.

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