Variable Cuantitativa Continua

Longitud

La longitud es una cordenada geográfica asociada con los meridianos

1 Cargar datos

Importamos el archivo “Earthquakes (2).csv” desde una ruta local y lo almacena en el objeto datos, usando espacios o tabulaciones como separador. Luego, la función str() muestra la estructura del data frame.

library(readxl)
datos <- read.csv("C:/Users/inesa/Downloads/Earthquakes (2).csv")
str(datos)
## 'data.frame':    17805 obs. of  22 variables:
##  $ time           : chr  "2024-10-31T01:32:40.503Z" "2024-10-30T23:51:31.217Z" "2024-10-29T02:35:27.930Z" "2024-10-28T13:08:40.107Z" ...
##  $ latitude       : num  29.86 28.21 4.72 27.87 32.75 ...
##  $ longitude      : num  92.2 67.1 96.2 94 90.4 ...
##  $ depth          : num  10 10 42.1 36.3 10 ...
##  $ mag            : num  4.4 4.3 4.6 4.6 4 4.6 4.7 4.3 5.3 4.4 ...
##  $ magType        : chr  "mb" "mb" "mb" "mb" ...
##  $ nst            : int  35 36 27 62 22 44 39 34 80 27 ...
##  $ gap            : num  89 195 91 98 79 170 169 105 65 140 ...
##  $ dmin           : num  6.45 9.37 0.87 6.69 6.64 ...
##  $ rms            : num  0.82 0.72 0.55 0.65 0.72 0.74 0.81 0.54 0.92 0.9 ...
##  $ net            : chr  "us" "us" "us" "us" ...
##  $ id             : chr  "us7000np4h" "us7000np47" "us7000nnqs" "us7000nnml" ...
##  $ updated        : chr  "2024-10-31T01:54:50.040Z" "2024-10-31T00:07:19.040Z" "2024-10-29T03:36:02.040Z" "2024-10-29T04:19:35.951Z" ...
##  $ place          : chr  "113 km ENE of Lhasa, China" "64 km NE of Khuzdar, Pakistan" "55 km S of Reuleuet, Indonesia" "35 km NNE of Ziro, India" ...
##  $ type           : chr  "earthquake" "earthquake" "earthquake" "earthquake" ...
##  $ horizontalError: num  7.45 12.2 5.1 8.9 9.39 ...
##  $ depthError     : num  1.88 1.99 8.27 7.33 1.98 ...
##  $ magError       : num  0.114 0.092 0.146 0.078 0.139 0.078 0.097 0.107 0.11 0.102 ...
##  $ magNst         : int  22 33 14 49 14 49 32 25 8 28 ...
##  $ status         : chr  "reviewed" "reviewed" "reviewed" "reviewed" ...
##  $ locationSource : chr  "us" "us" "us" "us" ...
##  $ magSource      : chr  "us" "us" "us" "us" ...

Extraemos la variable longitud de datos, omitimos las celdas en blanco y verificamos el tamaño muestral

Longitud<-datos$longitude
Longitud<-as.numeric(Longitud)
valoresnulos <- is.na(Longitud)
Longitud<- na.omit(Longitud)

n<-length(Longitud)
n
## [1] 17805

2 Gráfica

histograma<-hist(Longitud,freq = FALSE,main=" Gráfica Nº97: Histograma de Longitud de los Sismos del
     Subcontinente Indio",
                 xlab="Longitud",ylab="Densidad de probabilidad",col="grey")

3 Agrupación de longitud 1

limites_barras<-histograma$breaks
print(limites_barras)
##  [1]  60  62  64  66  68  70  72  74  76  78  80  82  84  86  88  90  92  94  96
## [20]  98 100 102

Extraemos intervalos de 60 a 80

#Agrupación 1
Long1<- Longitud[Longitud >=60  & Longitud<=80 ]

3.1 Conjetura del modelo

HistoLong1 <- hist(Long1,
                   breaks = seq(min(Long1), max(Long1), length.out = 5),
                   freq = F, 
                   main = "Gráfica Nº98: Modelo de probabilidad normal de Longitud de los Sismos del
     Subcontinente Indio", 
                   xlab = "Longitud",
                   ylab = "Densidad de probabilidad",
                   col = "grey")
h<-length(HistoLong1$counts)
u<-mean(Long1)
sigma<-sd(Long1)

x<-seq(min(Long1),max(Long1),0.01)
curve(dnorm(x,u,sigma),type="l",add=TRUE,lwd=4,col="blue3")

3.2 Test de Pearson

#Frecuencia simple observada
Fo<-HistoLong1$counts
Fo
## [1]  574 1002 1236  401
P<-c(0)
for (i in 1:h) {
  P[i] <-(pnorm(HistoLong1$breaks[i+1],u,sigma)-
            pnorm(HistoLong1$breaks[i],u,sigma))}
Fe<-P*length(Long1)
plot(Fo,Fe,main="Gráfica Nº99: Correlación de frecuencias en el modelo normal
                 de la Longitud de los Sismos del Subcontinente Indio",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] 94.77912

3.3 Test de Chi-Cuadrado

grados_libertad <- length(Long1)-1
grados_libertad
## [1] 3212
# Nivel de significancia
nivel_significancia <- 0.05


#Frecuencia Observada porcentual
Fo<-(HistoLong1$counts/n)*100
Fo
## [1] 3.223814 5.627633 6.941870 2.252176
#Frecuencia esperada
Fe<-P*100
Fe
## [1] 13.99184 35.18175 34.02789 12.65613
x2<-sum((Fe-Fo)^2/Fe)
x2
## [1] 63.22657
umbral_aceptacion <- qchisq(1 - nivel_significancia, grados_libertad)
umbral_aceptacion
## [1] 3344.962
x2<umbral_aceptacion
## [1] TRUE

3.4 Resumen de test de bondad

Variable<-c("Longitud")
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 Nro.27:Resumen de test de bondad al modelo de probabilidad")
## Warning in attr(x, "align"): 'xfun::attr()' está en desuso.
## Utilizar 'xfun::attr2()' en su lugar.
## Ver help("Deprecated")
## Warning in attr(x, "format"): 'xfun::attr()' está en desuso.
## Utilizar 'xfun::attr2()' en su lugar.
## Ver help("Deprecated")
Tabla Nro.27:Resumen de test de bondad al modelo de probabilidad
Variable Test Pearson (%) Chi Cuadrado Umbral de aceptación
Longitud 94.78 63.23 3344.96

4 Agrupación de longitud 2

Long2 <- Longitud[Longitud >=80  & Longitud<=102 ]

4.1 Conjetura del modelo

HistoLong2 <- hist(Long2,
                   breaks = seq(min(Long2), max(Long2), length.out = 5),
                   freq = F, 
                   main = "Gráfica Nº100: Modelo de probabilidad normal de Longitud de los Sismos del
     Subcontinente Indio", 
                   xlab = "Longitud",
                   ylab = "Densidad de probabilidad",
                   col = "Grey")
h<-length(HistoLong2$counts)
u<-mean(Long2)
sigma<-sd(Long2)

x<-seq(min(Long2),max(Long2),0.01)
curve(dnorm(x,u,sigma),type="l",add=TRUE,lwd=4,col="blue3")

4.2 Test de Pearson

#Frecuencia simple observada
Fo<-HistoLong2$counts
Fo
## [1] 1052 1260 8942 3338
P<-c(0)
for (i in 1:h) {
  P[i] <-(pnorm(HistoLong2$breaks[i+1],u,sigma)-
            pnorm(HistoLong2$breaks[i],u,sigma))}
Fe<-P*length(Long2)
plot(Fo,Fe,main="Gráfica Nº101: Correlación de frecuencias en el modelo normal
                 de la Longitud de los Sismos del Subcontinente Indio",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] 90.83929

4.3 Test de Chi-Cuadrado

grados_libertad <- length(Long2)-1
grados_libertad
## [1] 14591
# Nivel de significancia
nivel_significancia <- 0.05


#Frecuencia Observada porcentual
Fo<-(HistoLong2$counts/length(Long2))*100
Fo
## [1]  7.209430  8.634868 61.280154 22.875548
#Frecuencia esperada
Fe<-P*100
Fe
## [1]  2.342183 22.662546 48.610456 23.708132
x2<-sum((Fe-Fo)^2/Fe)
x2
## [1] 22.12883
umbral_aceptacion <- qchisq(1 - nivel_significancia, grados_libertad)
umbral_aceptacion
## [1] 14873.12
x2<umbral_aceptacion
## [1] TRUE

4.4 Resumen de test de bondad

Variable<-c("Longitud(°)")
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 Nro.28: Resumen de test de bondad al modelo de probabilidad")
## Warning in attr(x, "align"): 'xfun::attr()' está en desuso.
## Utilizar 'xfun::attr2()' en su lugar.
## Ver help("Deprecated")
## Warning in attr(x, "format"): 'xfun::attr()' está en desuso.
## Utilizar 'xfun::attr2()' en su lugar.
## Ver help("Deprecated")
Tabla Nro.28: Resumen de test de bondad al modelo de probabilidad
Variable Test Pearson (%) Chi Cuadrado Umbral de aceptación
Longitud(°) 90.84 22.13 14873.12

5 Cálculo de probabilidades

¿Cuál es la probabilidad de que, al seleccionar cualquier sismo ocurrido en el subcontinente indio, este tenga una Longitud entre 100° y 95.5°?

Tomar en cuenta que la muestra está en el rango de 80° y 102°

probabilidad<-pnorm(100,u,sigma)- pnorm(95.5,u,sigma)
probabilidad*100
## [1] 23.44484
plot(x, dnorm(x, u,sigma), col = "skyblue3", lwd = 1, xlim = c(80,100),main="Gráfica Nº102: Cálculo de probabilidades",
     ylab="Densidad de probabilidad",xlab="Longitud (°)", xaxt="n")

# Definir el rango de la sección que quieres pintar
x_section <- seq(95.5,100, 0.001)
y_section <- dnorm(x_section, u,sigma)

# Pintar la sección de la curva
lines(x_section, y_section, col = "red", 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(1, 0, 0, 0.6))

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

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

6 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, con tres postulados principales: (x-e<u<x+e)=68% (x-2e<u<x+2e)=95% (x-3e<u<x+3e)=99%

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

x<-mean(Longitud)
x
## [1] 88.99298
sigma<-sd(Longitud)
sigma
## [1] 9.76107
#P(x-2e<u<x+2e)=95%
e<-sigma/sqrt(n)
e
## [1] 0.07315204
li<-x-2*e
li
## [1] 88.84667
ls<-x+2*e
ls
## [1] 89.13928
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")
## Warning in attr(x, "align"): 'xfun::attr()' está en desuso.
## Utilizar 'xfun::attr2()' en su lugar.
## Ver help("Deprecated")
## Warning in attr(x, "format"): 'xfun::attr()' está en desuso.
## Utilizar 'xfun::attr2()' en su lugar.
## Ver help("Deprecated")
Tabla Nro.29: Media poblacional
Limite superior Media poblacional Límite superior Desviación estándar poblacional
88.85 Longitud(°) 89.14 0.073152

7 Conclusiones

La variable longitud medida en grados se explica atravez del modelo normal en dos grupos, con parámetros de media aritmética de 88.99 y desviación estandar de 9.76107 de esta manera, logramos calcular probabilidades, como por ejemplo, que al seleccionar aleatoriamente cualquier longitud dentro de 80° y 102°, su area se encuentre entre 100 y 95.5 es de 23.44%. Mediante el teorema de limite central, sabemos que la media aritmética poblacional de la longitud se encuentran entre 88.85 y 89.14° con un 95 % de confianza.