ANÁLISIS ESTADÍSTICO

CARGA DE DATOS Y LIBRERÍAS

CARGA DE DATOS

#Carga de datos
setwd("~/UNI/ESTADISTICA")
datos  <- read.csv("Depositos_Sulfuro.csv", sep = ";", dec = ".", header = TRUE)

CARGA DE LIBRERIAS

#Carga de librerias
library(dplyr)
library(knitr)

GRÁFICA DE DISTRIBUCIÓN DE PROBABILIDAD

# GRAFICA DE DISTRIBUCION DE PROBABILIDA – VARIABLE GRAMOS DE ORO

# Limpieza de la variable
oro <- as.numeric(datos$augrd)
oro <- na.omit(oro)
oro <- subset(oro, oro > 0)  

#Gráfica de la variable

histograma<-hist(oro,
                 freq = FALSE,
                 main="Gráfica 1.Distribucion de probabilidad de gramos de oro en 
                 los depósitos masivos de sulfuros volcánicos",
                 xlab="Gramos de oro (g/T)",
                 ylab="Densidad de probabilidad",
                 col="blue")

CONJETURA DEL MODELO

Debido a la similitud de las barras asociamos con el modelo probabilístico log-normal

Gráfica del modelo probabiliístico 

#Gráfica de modelo de probabilidad log-normal

hist(oro,
     freq = FALSE,
     main = "Gráfica 2. Modelo de probabilidad lognormal de gramos de oro",
     xlab = "Gramos de oro (g/T)",
     ylab = "Densidad de probabilidad",
     col = "lightblue",
     border = "black")

# Parámetros lognormales

h<-length(histograma$counts)
medialog <- mean(log(oro))
sd_log<-sd(log(oro))
sd_log
## [1] 1.54045
medialog
## [1] 3.010767
x <- seq(min(oro),max(oro),0.01)
curve(dlnorm(x,meanlog = medialog,sdlog = sd_log),add = TRUE,col=("black"),lwd=3)

#FECUENCIAS OBSERVADAS

Fo<-histograma$counts
Fo
## [1] 433  50  14   6   5   0   0   1
#FRECUENCIAS ESPERADAS

P<-c(0)
for (i in 1:h) 
{P[i] <-(plnorm(histograma$breaks[i+1],medialog,sd_log)-
           plnorm(histograma$breaks[i],medialog,sd_log))}
Fe<-P*length(oro)
Fe
## [1] 432.482642  41.511673  14.536427   6.981746   3.932796   2.444655   1.625964
## [8]   1.136476
#COMPARAR TAMAÑO REAL Y MODELO
sum(Fe)
## [1] 504.6524
n<-length(oro)
n
## [1] 509

TEST DE APROBACIÓN

TEST DE PEARSON

plot(Fo,Fe,main="Gráfica 3: Correlación de frecuencias en el modelo lognormal
                 de gramos de oro",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] 99.97451

APRUEBA TEST PEARSON

TEST DE CHI-CUADRADO

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

Fo<-(histograma$counts/n)*100
Fo
## [1] 85.0687623  9.8231827  2.7504912  1.1787819  0.9823183  0.0000000  0.0000000
## [8]  0.1964637
Fe<-P*100
Fe
## [1] 84.9671203  8.1555350  2.8558797  1.3716594  0.7726516  0.4802858  0.3194429
## [8]  0.2232762
x2<-sum((Fe-Fo)^2/Fe)
x2
## [1] 1.231977
umbral_aceptacion <- qchisq(1 - nivel_significancia, grados_libertad)
umbral_aceptacion
## [1] 14.06714
x2<umbral_aceptacion
## [1] TRUE

APRUEBA TEST DE CHI-CUADRADO

TABLA DE RESUMEN

Variable<-c("Gramos de oro")
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.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
Gramos de oro 99.97 1.23 14.07

CÁLCULO DE PROBABILIDADES

¿Cuál es la probabilidad de que el contenido de oro esté entre 50 g/t y 150 g/t ?

# PROBABILIDAD ENTRE 50 y 150 g/T

probabilidad_oro <- plnorm(150, meanlog = medialog, sdlog = sd_log) -
  plnorm(50,  meanlog = medialog, sdlog = sd_log)

# En porcentaje
probabilidad_oro * 100
## [1] 18.21506
# Rango para la curva
x <- seq(min(oro), max(oro), 0.01)

# Curva log-normal
plot(x, dlnorm(x, meanlog = medialog, sdlog = sd_log),
     col = "skyblue3", lwd = 2,
     main = "Gráfica 4. Cálculo de probabilidades del contenido de oro en los 
     depositos masivos de sulfuros volcanicos",
     ylab = "Densidad de probabilidad",
     xlab = "Gramos de oro (g/T)")

# Área de probabilidad (50–150 g/T)
x_area <- seq(50, 150, 0.01)
y_area <- dlnorm(x_area, meanlog = medialog, sdlog = sd_log)

# Línea del área
lines(x_area, y_area, col = "red", lwd = 2)

# Área sombreada
polygon(c(x_area, rev(x_area)),
        c(y_area, rep(0, length(y_area))),
        col = rgb(1, 0, 0, 0.5),
        border = NA)

# Leyenda
legend("topright",
       legend = c("Modelo Log-normal", "Área de Probabilidad"),
       col = c("skyblue3", "red"),
       lwd = 2,
       cex = 0.5)

#Texto 
texto_prob <- paste0("Probabilidad = ",
                     round(probabilidad_oro*100, 2), " %")

text(x = 250,
     y = max(dlnorm(x, medialog, sd_log)) * 0.7,
     labels = texto_prob,
     col = "black",
     cex = 0.9,
     font = 2)

CONCLUSIÓN