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)
library(gt)

TABLA DE DISTRIBUCION DE FRECUENCIA

# LIMPIEZA DE LA VARIABLE ORO
oro <- as.numeric(datos$augrd)
oro <- na.omit(oro)
oro <- subset(oro, oro > 0)
# SEPARAR OUTLIERS
caja <- boxplot(oro, plot = FALSE)

limite_sup <- caja$stats[5]
limite_inf <- caja$stats[1]

oro_outliers <- oro[oro < limite_inf | oro > limite_sup]
oro_sin_outliers <- oro[oro >= limite_inf & oro <= limite_sup]

# RESUMEN
cat("Cantidad con outliers:", length(oro), "\n")
## Cantidad con outliers: 509
cat("Cantidad de outliers:", length(oro_outliers), "\n")
## Cantidad de outliers: 41
cat("Cantidad sin outliers:", length(oro_sin_outliers), "\n")
## Cantidad sin outliers: 468
#TABLA DE DISTRIBUCION DE FRECUENCIA

#Crear un histograma para extraer información
histograma <- hist(oro_sin_outliers,
                   plot = FALSE)
# Frecuencia absoluta (ni)
ni <- histograma$counts
# Frecuencia relativa (hi)
hi <- ni / sum(ni)*100
# Intervalos
intervalos <- paste0(
  "[", round(histograma$breaks[-length(histograma$breaks)], 2),
  ", ",
  round(histograma$breaks[-1], 2),
  ")"
)

# TABLA FINAL
tabla_frecuencias <- data.frame(
  Intervalo = intervalos,
  ni = ni,
  hi = round(hi, 2)
)

# Mostrar la tabla
tabla_frecuencias
##    Intervalo  ni    hi
## 1    [0, 20) 230 49.15
## 2   [20, 40)  90 19.23
## 3   [40, 60)  50 10.68
## 4   [60, 80)  44  9.40
## 5  [80, 100)  19  4.06
## 6 [100, 120)  15  3.21
## 7 [120, 140)  15  3.21
## 8 [140, 160)   5  1.07
# Mejorar la Tabla

tabla_oro_gt <- tabla_frecuencias %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N° 1**"),
    subtitle = md("**Distribución de frecuencias de los Depósitos Masivos<br>
                     de Sulfuros Volcánicos por País**")
  ) %>%
  tab_source_note(
    source_note = md("Autor: Grupo 2")
  ) %>%
  tab_options(
    table.border.top.color = "black",
    table.border.bottom.color = "black",
    heading.border.bottom.color = "black",
    heading.border.bottom.width = px(2),
    column_labels.border.top.color = "black",
    column_labels.border.bottom.color = "black",
    column_labels.border.bottom.width = px(2),
    table_body.hlines.color = "gray",
    table_body.border.bottom.color = "black",
    row.striping.include_table_body = TRUE
  )

tabla_oro_gt
Tabla N° 1
Distribución de frecuencias de los Depósitos Masivos
de Sulfuros Volcánicos por País
Intervalo ni hi
[0, 20) 230 49.15
[20, 40) 90 19.23
[40, 60) 50 10.68
[60, 80) 44 9.40
[80, 100) 19 4.06
[100, 120) 15 3.21
[120, 140) 15 3.21
[140, 160) 5 1.07
Autor: Grupo 2

GRÁFICA DE DISTRIBUCIÓN DE PROBABILIDAD

#Gráfica de la variable

histograma<-hist(oro_sin_outliers,
                 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 de probabilidad exponencial

Gráfica del modelo probabilístico 

#Gráfica de modelo de probabilidad exponencial

hist(oro_sin_outliers,
     freq = FALSE,
     main = "Gráfica 2.Comparación de la realidad con el modelo exponencial de
     los gramos de oro en los depositos masivos de sulfuros volcánicos",
     xlab = "Gramos de oro (g/T)",
     ylab = "Densidad de probabilidad",
     col = "lightblue",
     border = "black")

# Parámetros exponenciales

lamdba <- 1/mean(oro_sin_outliers)
media <- mean(oro_sin_outliers)
sigma<- sd(oro_sin_outliers)
h<-length(histograma$counts)

x <- seq(min(oro_sin_outliers),max(oro_sin_outliers),0.01)
curve(dexp(x,rate = lamdba),add = TRUE,col=("black"),lwd=3)

#FECUENCIAS OBSERVADAS

Fo<-histograma$counts
Fo
## [1] 230  90  50  44  19  15  15   5
#FRECUENCIAS ESPERADAS

P<-c()
for (i in 1:h) 
{P[i] <-(pexp(histograma$breaks[i+1],rate = lamdba)- pexp(histograma$breaks[i], rate = lamdba))}

Fe<-P*length(oro_sin_outliers)
Fe
## [1] 209.236836 115.689713  63.966317  35.367792  19.555303  10.812376   5.978301
## [8]   3.305479

TEST DE APROBACIÓN

TEST DE PEARSON

#Representar la frecuencia observada y esperada en porcentaje

n<-length(oro_sin_outliers)
n
## [1] 468
Fo<-(Fo/n)*100
Fo
## [1] 49.145299 19.230769 10.683761  9.401709  4.059829  3.205128  3.205128
## [8]  1.068376
Fe<-(Fe/n)*100
Fe
## [1] 44.7087256 24.7200242 13.6680164  7.5572204  4.1784835  2.3103368  1.2774146
## [8]  0.7062988
plot(Fo,Fe,main="Gráfica 3: Correlación de frecuencias en el modelo exponencial
                 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] 98.11919

APRUEBA EL TEST PEARSON

TEST DE CHI-CUADRADO

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


x2<-sum((Fe-Fo)^2/Fe)
x2
## [1] 6.205543
umbral_aceptacion <- qchisq(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 (g/T)")
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 (g/T) 98.12 6.21 14.07

CÁLCULO DE PROBABILIDADES

¿Cuál es la probabilidad de que una muestra de mineral proveniente de un depósito masivo de sulfuros volcánicos presente un contenido de oro comprendido entre 25 g/t y 50 g/t?

# PROBABILIDAD ENTRE 25 y 50 g/T

probabilidad_oro <- pexp(50, lamdba) -
  pexp(25, lamdba)

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

# Curva exponencial
plot(x, dexp(x, lamdba),
     col = "skyblue3", lwd = 2,type = "l",
     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 (25–50 g/T)
x_area <- seq(25, 50, 0.01)
y_area <- dexp(x_area, lamdba)

# 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 exponencial", "Área de Probabilidad"),
       col = c("skyblue3", "red"),
       lwd = 2,
       cex = 0.7)

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

text(x = 80,
     y = max(dexp(x, lamdba)) * 0.7,
     labels = texto_prob,
     col = "black",
     cex = 0.9,
     font = 2)

CONCLUSIÓN