ANÁLISIS ESTADÍSTICO

CARGA DE DATOS Y LIBRERÍAS

CARGA DE DATOS

#Carga de datos
datos <- read.csv("C:\\Users\\joeja\\Desktop\\Proyecto Estadística\\Depositos_sulfuro.csv", 
                  header = TRUE, 
                  sep = ",", 
                  dec = ".")

CARGA DE LIBRERIAS

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

TABLA DE DISTRIBUCIÓN DE CANTIDAD

# 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 CANTIDAD

#Gráfica de la variable

histograma<-hist(oro_sin_outliers,
                 freq = TRUE ,
                 main="Gráfica 1.Distribucion de cantidad de gramos de oro en 
                 los depósitos masivos de sulfuros volcánicos",
                 xlab="Gramos de oro (g/T)",
                 ylab="Cantidad",
                 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
media <- mean(oro_sin_outliers)
media
## [1] 33.75214
lamdba <- 1/mean(oro_sin_outliers)
lamdba
## [1] 0.02962775
h<-length(histograma$counts)
h
## [1] 8
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

#Tamaño muestral
n<-length(oro_sin_outliers)
n
## [1] 468
#Representar la frecuencia observada y esperada en porcentaje
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
#Grafica de correlación 

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-1), col="red",lwd=2)

#Aprueba test de pearson con mas del 80%
Correlación<-cor(Fo,Fe)*100
Correlación
## [1] 98.11919

APRUEBA EL TEST PEARSON

TEST DE CHI-CUADRADO

#Gardos de libertad
grados_libertad <- (length(histograma$counts)-1)
grados_libertad
## [1] 7
#Nivel de significancia
nivel_significancia <- 0.95

#Formula de chi-cuadrado
x2<-sum((Fe-Fo)^2/Fe)
x2
## [1] 6.205543
#Umbral de aceptación
umbral_aceptacion <- qchisq(nivel_significancia, grados_libertad)
umbral_aceptacion
## [1] 14.06714
#Aprueba test de chi cuadrado con true
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)

¿De 300 nuevos depositos de sulfuros masivos cuantos tendria un contenido de oro entre 25 g/T y 50 g/T?

# PROBABILIDAD ENTRE 25 y 50 g/T

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

# cantidad
probabilidad_oro * 300
## [1] 74.83829

INTERVALOS DE CONFIANZA

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, sean 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)

#Media aritmetica
x<-mean(oro_sin_outliers)
x
## [1] 33.75214
#Desviación estandar

sigma<-sd(oro_sin_outliers)
sigma
## [1] 35.55239
#Tamaño muestral
n<-length(oro_sin_outliers)
n
## [1] 468
#P(x-2e<u<x+2e)=95%
e<-sigma/sqrt(n)
e
## [1] 1.64341
li<-x-2*e
li
## [1] 30.46532
ls<-x+2*e
ls
## [1] 37.03896
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
Limite inferior Media poblacional Limite superior Desviación estandar poblacional
30.47 Gramos de oro (g/T) 37.04 1.64341

CONCLUSIÓN

La variable gramos de oro se explica a través del modelo exponencial siendo la media aritmética de 31.59 que se encuentra en un intervalo definido por una desviación estandar de 35.31.

De esta manera logramos calcular probabilidades como por ejemplo, que al seleccionar aleatoriamente cualquier área de la gramos de oro donde se encuentre entre 25 g/T y 50 g/T es de 24.78 %.

Mediante el teorema de limite central, sabemos que la media aritmetica poblacional de los gramos de oro se encuentran entre 28.44 y 34.75 con un 95% de confianza.