FRECUENCIA DE MUESTRAS POR DEPÓSITO

ANÁLISIS INFERENCIAL

CARGA DE DATOS Y LIBRERÍAS

# CARGA DE DATOS
library(dplyr)
library(gt)
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")

#====================================================================
# TABLA DE DISTRIBUCIÓN DE FRECUENCIAS
#====================================================================

library(dplyr)
library(gt)

# LÍMITE INFERIOR
lis <- histograma_frec$breaks[1:length(histograma_frec$counts)]

# LÍMITE SUPERIOR
lss <- histograma_frec$breaks[2:(length(histograma_frec$counts)+1)]

# MARCA DE CLASE
MC_frec <- histograma_frec$mids

# FRECUENCIA ABSOLUTA
ni_frec <- histograma_frec$counts

# FRECUENCIA RELATIVA (%)
hi_frec <- (ni_frec / sum(ni_frec)) * 100

# TABLA BASE
TDFrec <- round(data.frame(
  lis,
  lss,
  MC_frec,
  ni_frec,
  hi_frec
), 2)

# FILA TOTAL
fila_total_frec <- data.frame(
  lis = "TOTAL",
  lss = "",
  MC_frec = "",
  ni_frec = sum(TDFrec$ni_frec),
  hi_frec = round(sum(TDFrec$hi_frec), 2)
)

TDFrec_total <- rbind(TDFrec, fila_total_frec)

# TABLA FINAL
tabla_frecuencia <- TDFrec_total %>%
  gt() %>%
  tab_header(
    title = md("*Tabla Nº1*"),
    subtitle = md("Tabla de distribución de frecuencias de muestras por depósito")
  ) %>%
  cols_label(
    lis = "Límite inferior",
    lss = "Límite superior",
    MC_frec = "Marca de clase",
    ni_frec = "Frecuencia absoluta",
    hi_frec = "Frecuencia relativa (%)"
  ) %>%
  tab_source_note(
    source_note = md("Autor: Grupo 2")
  ) %>%
  tab_options(
    table.border.top.color = "black",
    table.border.bottom.color = "black",
    table.border.top.style = "solid",
    table.border.bottom.style = "solid",
    column_labels.border.top.color = "black",
    column_labels.border.bottom.color = "black",
    column_labels.border.bottom.width = px(2),
    row.striping.include_table_body = TRUE,
    heading.border.bottom.color = "black",
    heading.border.bottom.width = px(2),
    table_body.hlines.color = "gray",
    table_body.border.bottom.color = "black"
  )

tabla_frecuencia

Tabla Nº1
Tabla de distribución de frecuencias de muestras por depósito
Límite inferior	Límite superior	Marca de clase	Frecuencia absoluta	Frecuencia relativa (%)
0	10	5	3	0.12
10	20	15	73	2.92
20	30	25	176	7.04
30	40	35	313	12.52
40	50	45	495	19.80
50	60	55	228	9.12
60	70	65	66	2.64
70	80	75	216	8.64
80	90	85	346	13.84
90	100	95	94	3.76
100	110	105	0	0.00
110	120	115	227	9.08
120	130	125	125	5.00
130	140	135	138	5.52
TOTAL			2500	100.00
Autor: Grupo 2

CONJETURA MODELO 1

#====================================================================
# 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))
}

TEST DE APROBACIÓN

# 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

CONJETURA MODELO 2

#====================================================================
# 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))
}

TEST DE APROBACIÓN

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

CALCULO DE PROBABILIDADES

"¿Cuál es la probabilidad de que un nuevo depósito descubierto en el futuro presente entre 70 y 90 muestras registradas?"

## [1] "¿Cuál es la probabilidad de que un nuevo depósito descubierto en el futuro presente entre 70 y 90 muestras registradas?"

## CÁLCULO DE PROBABILIDADES

# ¿Cuál es la probabilidad de que un nuevo depósito
# presente entre 70 y 90 muestras?

Probabilidad_2 <- (pnorm(90, u_2, sigma_2) -
                   pnorm(70, u_2, sigma_2)) * 100

Probabilidad_2

## [1] 71.39199

# Rango para la curva

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

plot(x,
     dnorm(x, u_2, sigma_2),
     col = "skyblue3",
     lwd = 2,
     main = "Grafica Nº6: Probabilidad de depósitos con frecuencia entre 70 y 90 muestras",
     ylab = "Densidad de probabilidad",
     xlab = "Frecuencia de muestras por depósito")

# Área a sombrear

x_section_2 <- seq(70, 90, 0.001)

y_section_2 <- dnorm(x_section_2,
                     u_2,
                     sigma_2)

lines(x_section_2,
      y_section_2,
      col = "red",
      lwd = 3)

polygon(c(x_section_2,
          rev(x_section_2)),
        c(y_section_2,
          rep(0,length(y_section_2))),
        col = rgb(1,0,0,0.4),
        border = NA)

legend("topright",
       legend = c("Modelo Normal",
                  "Área de Probabilidad"),
       col = c("skyblue3","red"),
       lwd = 2)

texto_prob <- paste0(
  "Probabilidad = ",
  round(Probabilidad_2,2),
  "%"
)

text(x = 72,
     y = max(dnorm(x,u_2,sigma_2))*0.9,
     labels = texto_prob,
     font = 2)

"De 500 nuevos depósitos que se descubran en el futuro, ¿cuántos presentarían entre 70 y 90 muestras registradas?"

## [1] "De 500 nuevos depósitos que se descubran en el futuro, ¿cuántos presentarían entre 70 y 90 muestras registradas?"

# ¿De 500 nuevos depósitos cuántos tendrán
# entre 70 y 90 muestras?

cantidad_2 <- (pnorm(90, u_2, sigma_2) -
               pnorm(70, u_2, sigma_2)) * 500

cantidad_2

## [1] 356.96

INTERVALOS DE CONFIANZA

# MEDIA MUESTRAL GENERAL

media_frec <- mean(frecuencia)
media_frec

## [1] 68.44

# DESVIACIÓN ESTÁNDAR

sigma_frec <- sd(frecuencia)
sigma_frec

## [1] 34.15405

# TAMAÑO MUESTRAL

n_frec <- length(frecuencia)
n_frec

## [1] 2500

# ERROR ESTÁNDAR

e <- sigma_frec / sqrt(n_frec)
e

## [1] 0.6830811

# INTERVALO DE CONFIANZA DEL 95%

li <- media_frec - 2*e
li

## [1] 67.07384

ls <- media_frec + 2*e
ls

## [1] 69.80616

# TABLA RESUMEN

tabla_media <- data.frame(
  round(li,2),
  "Frecuencia de muestras por depósito",
  round(ls,2),
  round(sigma_frec,2)
)

colnames(tabla_media) <- c(
  "Límite inferior",
  "Variable",
  "Límite superior",
  "Desviación estándar"
)

kable(
  tabla_media,
  format = "markdown",
  caption = "Tabla Nº5: Intervalo de confianza de la media poblacional"
)

Tabla Nº5: Intervalo de confianza de la media poblacional

Límite inferior	Variable	Límite superior	Desviación estándar
67.07	Frecuencia de muestras por depósito	69.81	34.15

CONJETURA MODELO 3

#====================================================================
# 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))
}

TEST DE APROBACIÓN

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

CONCLUSION

"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."

## [1] "La frecuencia de muestras por depósito presenta una distribución multimodal,\nevidenciando la existencia de al menos tres agrupamientos principales dentro\ndel conjunto de datos.\n\nDebido a ello, la variable fue segmentada en tres subconjuntos con el objetivo\nde representar adecuadamente el comportamiento estadístico interno de cada grupo\nmediante modelos normales independientes.\n\nLos resultados obtenidos muestran que cada subconjunto presenta un ajuste\nrazonable al modelo de probabilidad normal, permitiendo aplicar herramientas\nde inferencia estadística para el análisis de frecuencias de muestreo en\ndepósitos minerales."