FRECUENCIA DE MUESTRAS POR DEPÓSITO

# CARGA DE DATOS

library(readxl)
library(knitr)

datos <- read_excel("D:/dataset_variables_discretas_mineria.xlsx")

# LIMPIEZA DE LA VARIABLE

frecuencia <- as.numeric(datos$`Frecuencia de muestras por depósito`)
frecuencia <- na.omit(frecuencia)

# GRAFICA DE DISTRIBUCIÓN GENERAL

histograma_frec <- hist(frecuencia,
                        main = "Grafica Nº1: Distribución de cantidad de la frecuencia de muestras por depósito",
                        xlab = "Frecuencia de muestras por depósito",
                        ylab = "Cantidad",
                        col = "gray")

#====================================================================
# MODELO NORMAL 1
#====================================================================

# PARTICIÓN DE LA VARIABLE

frec_1 <- frecuencia[frecuencia < 60]

# HISTOGRAMA

Histograma_1 <- hist(frec_1,
                     freq = FALSE,
                     breaks = seq(0, 60, by = 10),
                     main = "Grafica Nº2: Comparación de la realidad con el modelo de probabilidad
                     normal del grupo 1 de frecuencia de muestras por depósito",
                     ylab = "Densidad de probabilidad",
                     xlab = "Frecuencia de muestras por depósito",
                     col = "lightgray",
                     border = "black")

# CALCULO DE PARAMETROS

h1 <- length(Histograma_1$counts)

u_1 <- mean(frec_1)

sigma_1 <- sd(frec_1)

x <- seq(min(frec_1), max(frec_1), 0.01)

curve(dnorm(x, u_1, sigma_1),
      type = "l",
      col = "blue",
      add = TRUE)

# TAMAÑO MUESTRAL

n1 <- length(frec_1)
n1

## [1] 1288

# FRECUENCIA OBSERVADA

Fo_1 <- Histograma_1$counts
Fo_1

## [1]   3  73 176 313 495 228

# 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]   7.039829  51.156280 192.823066 378.147046 386.499083 205.895722

# TEST DE PEARSON

Fo_1 <- (Fo_1/n1)*100
Fo_1

## [1]  0.2329193  5.6677019 13.6645963 24.3012422 38.4316770 17.7018634

Fe_1 <- (Fe_1/n1)*100
Fe_1

## [1]  0.5465706  3.9717609 14.9707349 29.3592427 30.0076928 15.9856927

# CORRELACIÓN

plot(Fo_1,
     Fe_1,
     main="Grafica Nº3: Correlación de frecuencias observadas y esperadas
     del grupo 1",
     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] 94.60803

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] 4.438589

umbral_aceptacion_1 <- qchisq(nivel_significancia,
                              grados_libertad_1)

umbral_aceptacion_1

## [1] 11.0705

# TABLA RESUMEN

Variable <- c("Frecuencia Grupo 1")

tabla_resumen_1 <- data.frame(Variable,
                              round(Correlacion_1,2),
                              round(x2_1,2),
                              round(umbral_aceptacion_1,2))

colnames(tabla_resumen_1) <- c("Variable",
                               "Test Pearson (%)",
                               "Chi Cuadrado",
                               "Umbral de aceptación")

kable(tabla_resumen_1,
      format = "markdown",
      caption = "Tabla resumen grupo 1")

Tabla resumen grupo 1

Variable	Test Pearson (%)	Chi Cuadrado	Umbral de aceptación
Frecuencia Grupo 1	94.61	4.44	11.07

#====================================================================
# MODELO NORMAL 2
#====================================================================

frec_2 <- frecuencia[frecuencia >= 60 & frecuencia < 100]

Histograma_2 <- hist(frec_2,
                     freq = FALSE,
                     breaks = seq(60, 100, by = 10),
                     main = "Grafica Nº4: Comparación de la realidad con el modelo
                     normal del grupo 2",
                     ylab = "Densidad de probabilidad",
                     xlab = "Frecuencia de muestras por depósito",
                     col = "lightgray",
                     border = "black")

h2 <- length(Histograma_2$counts)

u_2 <- mean(frec_2)

sigma_2 <- sd(frec_2)

x <- seq(min(frec_2), max(frec_2), 0.01)

curve(dnorm(x, u_2, sigma_2),
      type = "l",
      col = "blue",
      add = TRUE)

n2 <- length(frec_2)
n2

## [1] 722

Fo_2 <- Histograma_2$counts
Fo_2

## [1]  66 216 346  94

P2 <- c(0)

for (i in 1:h2) {

  P2[i] <- (pnorm(Histograma_2$breaks[i+1],u_2,sigma_2)-
            pnorm(Histograma_2$breaks[i],u_2,sigma_2))
}

Fe_2 <- P2*n2
Fe_2

## [1]  72.60059 239.89005 275.56014 110.22265

Fo_2 <- (Fo_2/n2)*100
Fo_2

## [1]  9.141274 29.916898 47.922438 13.019391

Fe_2 <- (Fe_2/n2)*100
Fe_2

## [1] 10.05548 33.22577 38.16622 15.26629

plot(Fo_2,
     Fe_2,
     main="Grafica Nº5: Correlación de frecuencias observadas y esperadas
     del grupo 2",
     xlab="Frecuencia Observada (%)",
     ylab="Frecuencia Esperada (%)",
     col="blue3")

abline(a = 0,
       b = 1,
       col = "red",
       lwd = 2)

Correlacion_2 <- cor(Fo_2,Fe_2)*100
Correlacion_2

## [1] 95.98361

grados_libertad_2 <- (length(Histograma_2$counts)-1)
grados_libertad_2

## [1] 3

x2_2 <- sum((Fe_2-Fo_2)^2/Fe_2)
x2_2

## [1] 3.237264

umbral_aceptacion_2 <- qchisq(nivel_significancia,
                              grados_libertad_2)

umbral_aceptacion_2

## [1] 7.814728

Variable <- c("Frecuencia Grupo 2")

tabla_resumen_2 <- data.frame(Variable,
                              round(Correlacion_2,2),
                              round(x2_2,2),
                              round(umbral_aceptacion_2,2))

colnames(tabla_resumen_2) <- c("Variable",
                               "Test Pearson (%)",
                               "Chi Cuadrado",
                               "Umbral de aceptación")

kable(tabla_resumen_2,
      format = "markdown",
      caption = "Tabla resumen grupo 2")

Tabla resumen grupo 2

Variable	Test Pearson (%)	Chi Cuadrado	Umbral de aceptación
Frecuencia Grupo 2	95.98	3.24	7.81

#====================================================================
# MODELO NORMAL 3
#====================================================================

frec_3 <- frecuencia[frecuencia >= 100]

Histograma_3 <- hist(frec_3,
                     freq = FALSE,
                     breaks = seq(100, 150, by = 10),
                     main = "Grafica Nº6: Comparación de la realidad con el modelo
                     normal del grupo 3",
                     ylab = "Densidad de probabilidad",
                     xlab = "Frecuencia de muestras por depósito",
                     col = "lightgray",
                     border = "black")

h3 <- length(Histograma_3$counts)

u_3 <- mean(frec_3)

sigma_3 <- sd(frec_3)

x <- seq(min(frec_3), max(frec_3), 0.01)

curve(dnorm(x, u_3, sigma_3),
      type = "l",
      col = "blue",
      add = TRUE)

n3 <- length(frec_3)
n3

## [1] 490

Fo_3 <- Histograma_3$counts
Fo_3

## [1]   0 227 125 138   0

P3 <- c(0)

for (i in 1:h3) {

  P3[i] <- (pnorm(Histograma_3$breaks[i+1],u_3,sigma_3)-
            pnorm(Histograma_3$breaks[i],u_3,sigma_3))
}

Fe_3 <- P3*n3
Fe_3

## [1]  42.45659 134.58508 179.60018 101.08071  23.90743

Fo_3 <- (Fo_3/n3)*100
Fo_3

## [1]  0.00000 46.32653 25.51020 28.16327  0.00000

Fe_3 <- (Fe_3/n3)*100
Fe_3

## [1]  8.664609 27.466342 36.653098 20.628717  4.879068

plot(Fo_3,
     Fe_3,
     main="Grafica Nº7: Correlación de frecuencias observadas y esperadas
     del grupo 3",
     xlab="Frecuencia Observada (%)",
     ylab="Frecuencia Esperada (%)",
     col="blue3")

abline(a = 0,
       b = 1,
       col = "red",
       lwd = 2)

Correlacion_3 <- cor(Fo_3,Fe_3)*100
Correlacion_3

## [1] 78.53072

grados_libertad_3 <- (length(Histograma_3$counts)-1)
grados_libertad_3

## [1] 4

x2_3 <- sum((Fe_3-Fo_3)^2/Fe_3)
x2_3

## [1] 32.63382

umbral_aceptacion_3 <- qchisq(nivel_significancia,
                              grados_libertad_3)

umbral_aceptacion_3

## [1] 9.487729

Variable <- c("Frecuencia Grupo 3")

tabla_resumen_3 <- data.frame(Variable,
                              round(Correlacion_3,2),
                              round(x2_3,2),
                              round(umbral_aceptacion_3,2))

colnames(tabla_resumen_3) <- c("Variable",
                               "Test Pearson (%)",
                               "Chi Cuadrado",
                               "Umbral de aceptación")

kable(tabla_resumen_3,
      format = "markdown",
      caption = "Tabla resumen grupo 3")

Tabla resumen grupo 3

Variable	Test Pearson (%)	Chi Cuadrado	Umbral de aceptación
Frecuencia Grupo 3	78.53	32.63	9.49

1 Conclusión

La frecuencia de muestras por depósito presenta una distribución multimodal, evidenciando la existencia de al menos tres agrupamientos principales dentro del conjunto de datos.

Debido a ello, la variable fue segmentada en tres subconjuntos con el objetivo de representar adecuadamente el comportamiento estadístico interno de cada grupo mediante modelos normales independientes.

Los resultados obtenidos muestran que cada subconjunto presenta un ajuste razonable al modelo de probabilidad normal, permitiendo aplicar herramientas de inferencia estadística para el análisis de frecuencias de muestreo en depósitos minerales.