##
## 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(stringr)
library(gt)
library(readxl)
library(knitr)
datos <- read.csv("D:/longitud.csv")
# Limpieza de la variable
longitud <- as.numeric(datos$Longitud)
longitud <- na.omit(longitud)
#Grafica de distribución de cantidad
histograma_long<-hist(longitud,
main = "Gráfica Nº1: Distribución de cantidad de la longitud
en análisis geoquímicos y geológicos de depósitos minerales",
xlab = "Longitud",
ylab = "Cantidad",
col = "gray")
# Partición de la variable
long_1 <- longitud[longitud <180]
# Histograma 120 a 180
Histograma_1<-hist(long_1,
freq = FALSE,
breaks = seq(120, 180, by = 10),
main = "Gráfica Nº2: Comparación de la realidad con el modelo de probabilidad
normal en la longitud de análisis geoquímicos y geológicos de depósitos minerales",
ylab = "Densidad de probabilidad",
xlab = "Longitud",
col = "lightgray",
border = "black")
# Calculo de Parametros
h1<-length(Histograma_1$counts)
u_1 <- mean(long_1)
sigma_1<- sd(long_1)
x <- seq(min(long_1), max(long_1), 0.01)
curve(dnorm(x, u_1, sigma_1), type = "l", col = "blue", add = TRUE)
#Tamaño muestral
n1<-length(long_1)
n1
## [1] 1886
#Frecuencia observada
Fo_1<-Histograma_1$counts
Fo_1
## [1] 2 16 91 327 687 763
#Probabilidad
P1<-c(0)
for (i in 1:h1) {
P1[i] <-(pnorm(Histograma_1$breaks[i+1],u_1,sigma_1)-
pnorm(Histograma_1$breaks[i],u_1,sigma_1))}
#Frecuencia Esperada
Fe_1<-P1*n1
Fe_1
## [1] 0.08237694 4.14323742 69.31069874 392.92146069 767.34982927
## [6] 520.29003551
#TEST DE PEARSON
#EXPRESAR FE Y FO EN PORCENTAJE
Fo_1<-(Fo_1/n1)*100
Fo_1
## [1] 0.1060445 0.8483563 4.8250265 17.3382821 36.4262990 40.4559915
Fe_1 <-(Fe_1/n1)*100
Fe_1
## [1] 0.004367812 0.219683851 3.675010538 20.833587523 40.686629336
## [6] 27.586958405
#Correlación de frecuencia esperada con la frecuencia observada
plot(Fo_1,Fe_1,main="Gráfica N3º: Correlación de frecuencias en el modelo normal
de la longitud en depósitos minerales",
xlab="Frecuencia Observada (%)",
ylab="Frecuencia esperada (%)",
col="blue3")
abline(a = 0, b=1, col="red",lwd=2)
CorrelaciOn_1<-cor(Fo_1,Fe_1)*100
CorrelaciOn_1
## [1] 93.97395
grados_libertad_1 <- (length(Histograma_1$counts)-1)
grados_libertad_1
## [1] 5
nivel_significancia <- 0.95
x2_1<-sum((Fe_1-Fo_1)^2/Fe_1)
x2_1
## [1] 11.56164
umbral_aceptacion_1 <- qchisq(nivel_significancia, grados_libertad_1)
umbral_aceptacion_1
## [1] 11.0705
#TABLA DE RESUMEN
Variable<-c("Longitud")
tabla_resumen<-data.frame(Variable,round(CorrelaciOn_1,2),round(x2_1,2),round(umbral_aceptacion_1,2))
colnames(tabla_resumen)<-c("Variable","Test Pearson (%)","Chi Cuadrado","Umbral de aceptación")
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
| Longitud |
93.97 |
11.56 |
11.07 |
#¿Cuál es la probabilidad de que una nueva observación de longitud
#en análisis geoquímicos y geológicos de depósitos minerales
#se encuentre entre 150 y 170 unidades?
# PROBABILIDAD ENTRE 150 y 170
Probabilidad_1 <- (pnorm(170, u_1, sigma_1) - pnorm(150, u_1, sigma_1)) * 100
Probabilidad_1
## [1] 61.52022
# Rango para la curva
x <- seq(min(long_1), max(long_1), 0.01)
plot(x, dnorm(x, u_1,sigma_1),
col = "skyblue3",
lwd = 1,
main="Gráfica N 4º: Cálculo de probabilidades",
ylab="Densidad de probabilidad",
xlab="Longitud")
# Definir el rango de la sección que quieres pintar
x_section <- seq(150,170, 0.001)
y_section <- dnorm(x_section, u_1,sigma_1)
# 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
# Leyenda
legend("topright",
legend = c("Modelo Normal", "Área de Probabilidad"),
col = c("skyblue3", "red"),
lwd = 2,
cex = 0.5)
#Texto
texto_prob <- paste0("Probabilidad = ",
round(Probabilidad_1, 2), " %")
text(x = 130,
y = 0.03,
labels = texto_prob,
col = "black",
cex = 0.7,
font = 2)
#¿De 300 nuevos análisis geoquímicos y geológicos de depósitos minerales
#cuantos presentarán una longitud entre 150 y 170?
cantidad_1 <- (pnorm(170, u_1, sigma_1) - pnorm(150, u_1, sigma_1)) * 300
cantidad_1
## [1] 184.5607
#intervalos de confianza
#Media aritmetica
x<-mean(longitud)
x
## [1] 171.1427
#Desviación estandar
sigma<-sd(longitud)
sigma
## [1] 11.90197
#Tamaño muestral
n<-length(longitud)
n
## [1] 2500
#P(x-2e<u<x+2e)=95%
e<-sigma/sqrt(n)
e
## [1] 0.2380394
## [1] 170.6666
## [1] 171.6187
tabla_media<-data.frame(round(li,2),Variable,round(ls,2),e)
colnames(tabla_media)<-c("Limite inferior","Media poblacional","Limite superior", "Desviación estandar poblacional")
library(knitr)
kable(tabla_media, format = "markdown", caption = "Tabla Nro.3: Media poblacional")
Tabla Nro.3: Media poblacional
| 170.67 |
Longitud |
171.62 |
0.2380394 |
#conclucion
"La variable longitud en análisis geoquímicos y geológicos de depósitos minerales
se explica adecuadamente a través del modelo normal, presentando una media
aritmética cercana a 171.14 y una desviación estándar aproximada de 11.90.
De esta manera logramos calcular probabilidades, como por ejemplo, que al
seleccionar aleatoriamente una observación de longitud asociada a depósitos
minerales, la probabilidad de que esta se encuentre entre 150 y 170 unidades
corresponde al valor calculado mediante el modelo normal.
Mediante el teorema del límite central, sabemos que la media aritmética
poblacional de la longitud en estudios geoquímicos y geológicos se encuentra
dentro del intervalo calculado con un 95% de confianza."
## [1] "La variable longitud en análisis geoquímicos y geológicos de depósitos minerales\nse explica adecuadamente a través del modelo normal, presentando una media\naritmética cercana a 171.14 y una desviación estándar aproximada de 11.90.\n\nDe esta manera logramos calcular probabilidades, como por ejemplo, que al\nseleccionar aleatoriamente una observación de longitud asociada a depósitos\nminerales, la probabilidad de que esta se encuentre entre 150 y 170 unidades\ncorresponde al valor calculado mediante el modelo normal.\n\nMediante el teorema del límite central, sabemos que la media aritmética\npoblacional de la longitud en estudios geoquímicos y geológicos se encuentra\ndentro del intervalo calculado con un 95% de confianza."