ANÁLISIS INFERENCIAL

CARGA DE DATOS Y LIBRERÍAS

CARGA DE LIBRERÍAS

library(readxl)
library(gt)
library(dplyr)
library(knitr)

CARGA DE DATOS

datos <- read_excel(
  "C:/Users/klaus/Downloads/GOLD_PPM_modelo_binomial_2500.xlsx",
  sheet = "Datos_GOLD_PPM"
)

SELECCIÓN DE LA VARIABLE

# Selección de la variable GOLD_PPM

GOLD_PPM <- datos$GOLD_PPM

GOLD_PPM <- as.numeric(GOLD_PPM)

GOLD_PPM <- GOLD_PPM[!is.na(GOLD_PPM)]

# Se define el umbral de alta concentración de oro
# usando el percentil 75.

umbral_oro <- quantile(GOLD_PPM, 0.75, na.rm = TRUE)

# Variable binomial:
# Éxito = alta concentración de oro
# Fracaso = no alta concentración de oro

GOLD_ALTO <- ifelse(GOLD_PPM >= umbral_oro, 1, 0)

TABLA DE FRECUENCIA

# TABLA DE FRECUENCIA - MODELO BINOMIAL GOLD_PPM

# En el modelo binomial se trabaja con grupos de 50 muestras.
# En cada grupo se cuenta cuántas muestras presentan alta concentración de oro.
# Sin embargo, la base total sigue teniendo 2500 muestras.

n_ensayo <- 50

set.seed(123)

datos_binomial <- data.frame(
  GOLD_PPM = GOLD_PPM,
  GOLD_ALTO = GOLD_ALTO
)

datos_grupos <- datos_binomial %>%
  sample_frac(1) %>%
  mutate(
    ID = row_number(),
    Grupo = ceiling(ID / n_ensayo)
  ) %>%
  group_by(Grupo) %>%
  summarise(
    Exitos_oro_alto = sum(GOLD_ALTO),
    Total_muestras = n(),
    .groups = "drop"
  )

# Agrupación de éxitos de oro alto

categorias_binomiales <- c("0 - 8", "9 - 11", "12 - 14", "15 o más")

intervalos_binomiales <- cut(
  datos_grupos$Exitos_oro_alto,
  breaks = c(-Inf, 8, 11, 14, Inf),
  labels = categorias_binomiales,
  right = TRUE
)

# Frecuencia de grupos

ni_grupos <- as.numeric(table(
  factor(intervalos_binomiales, levels = categorias_binomiales)
))

# Frecuencia de muestras representadas
# Cada grupo tiene 50 muestras

ni <- ni_grupos * n_ensayo

# Total real de muestras

N <- sum(ni)

# Frecuencia relativa

hi <- (ni / N) * 100

p_s <- ni / N

TDF_GOLD <- data.frame(
  Intervalo = categorias_binomiales,
  ni = ni,
  hi = round(hi, 2),
  p_s = round(p_s, 4)
)

colnames(TDF_GOLD) <- c("Intervalo", "ni", "hi(%)", "p(s)")

totales <- data.frame(
  Intervalo = "Totales",
  ni = sum(ni),
  hi = 100,
  p_s = 1
)

colnames(totales) <- c("Intervalo", "ni", "hi(%)", "p(s)")

TDF_GOLD_final <- rbind(TDF_GOLD, totales)

TDF_GOLD_final %>%
  gt() %>%
  fmt_number(
    columns = c("hi(%)", "p(s)"),
    decimals = 2
  ) %>%
  tab_header(
    title = md("*Tabla Nro. 1*"),
    subtitle = md("**Distribución de frecuencia de muestras representadas con alta concentración de oro por grupos de 50 muestras**")
  ) %>%
  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),
    heading.border.bottom.color = "black",
    heading.border.bottom.width = px(2),
    
    row.striping.include_table_body = TRUE,
    table_body.hlines.color = "gray",
    table_body.border.bottom.color = "black",
    
    table.border.left.color = "black",
    table.border.left.style = "solid",
    table.border.left.width = px(1),
    table.border.right.color = "black",
    table.border.right.style = "solid",
    table.border.right.width = px(1),
    
    column_labels.vlines.color = "black",
    column_labels.vlines.style = "solid",
    column_labels.vlines.width = px(1),
    table_body.vlines.color = "black",
    table_body.vlines.style = "solid",
    table_body.vlines.width = px(1)
  )

Intervalo	ni	hi(%)	p(s)
Tabla Nro. 1
Distribución de frecuencia de muestras representadas con alta concentración de oro por grupos de 50 muestras
0 - 8	300	12.00	0.12
9 - 11	550	22.00	0.22
12 - 14	950	38.00	0.38
15 o más	700	28.00	0.28
Totales	2500	100.00	1.00
Autor: Grupo 2

GRÁFICA DE DISTRIBUCIÓN DE FRECUENCIA

par(mar = c(6.1, 5.1, 4.1, 2.1))

porcentajes_plot <- hi

barras <- barplot(
  height = porcentajes_plot,
  names.arg = categorias_binomiales,
  space = 0.4,
  col = "gray",
  border = "black",
  main = "Gráfica N°1: Distribución porcentual de 
  muestras con alta concentración de oro
  por grupos de 50 muestras",
  xlab = "Número de muestras con alta concentración de oro",
  ylab = "Porcentaje",
  las = 1,
  ylim = c(0, max(porcentajes_plot) * 1.20),
  cex.names = 0.9
)

abline(
  h = pretty(c(0, max(porcentajes_plot))),
  col = "gray70",
  lty = 2,
  lwd = 0.8
)

barplot(
  height = porcentajes_plot,
  space = 0.4,
  col = "gray",
  border = "black",
  add = TRUE,
  axes = FALSE,
  names.arg = rep("", length(categorias_binomiales))
)

box()

CONJETURA DEL MODELO

Se conjetura que la variable GOLD_PPM, al ser analizada mediante la presencia de alta concentración de oro, se ajusta a un modelo de probabilidad binomial. Esto se debe a que, dentro de cada grupo de 50 muestras geoquímicas, se cuenta cuántas muestras presentan alta concentración de oro.

La base total está compuesta por 2500 registros, los cuales fueron organizados en grupos de 50 muestras. Para cada grupo se contabiliza el número de muestras que cumplen con el criterio de alta concentración de oro en GOLD_PPM.

Por ello, el modelo binomial permite estimar la probabilidad de obtener una determinada cantidad de muestras con alta concentración de oro dentro de un grupo fijo de 50 muestras analizadas.

PARÁMETROS

# CÁLCULO DE LOS PARÁMETROS DEL MODELO BINOMIAL

# Total de muestras individuales

N_total <- length(GOLD_ALTO)

# Número de éxitos

exitos <- sum(GOLD_ALTO)

# Número de fracasos

fracasos <- N_total - exitos

# Probabilidad de éxito

p <- exitos / N_total

# Probabilidad de fracaso

q <- 1 - p

cat("Total de muestras =", N_total, "\n")

## Total de muestras = 2500

cat("Éxitos =", exitos, "\n")

## Éxitos = 626

cat("Fracasos =", fracasos, "\n")

## Fracasos = 1874

cat("Parámetro del modelo binomial (p) =", round(p, 4), "\n")

## Parámetro del modelo binomial (p) = 0.2504

cat("Probabilidad de fracaso (q) =", round(q, 4), "\n")

## Probabilidad de fracaso (q) = 0.7496

cat("Tamaño del ensayo binomial =", n_ensayo, "\n")

## Tamaño del ensayo binomial = 50

COMPARACIÓN DE LA REALIDAD VS MODELO BINOMIAL

# PROBABILIDADES TEÓRICAS DEL MODELO BINOMIAL

P_teorica <- c(
  pbinom(8, size = n_ensayo, prob = p),
  pbinom(11, size = n_ensayo, prob = p) - pbinom(8, size = n_ensayo, prob = p),
  pbinom(14, size = n_ensayo, prob = p) - pbinom(11, size = n_ensayo, prob = p),
  1 - pbinom(14, size = n_ensayo, prob = p)
)

hi_modelo <- P_teorica * 100

datos_comparacion <- rbind(
  Realidad = hi,
  Modelo = hi_modelo
)

par(mar = c(6.1, 4.1, 4.1, 2.1))

grafica_comp <- barplot(
  datos_comparacion,
  beside = TRUE,
  names.arg = categorias_binomiales,
  col = c("skyblue", "blue"),
  main = "Gráfica N°2: Comparación de la realidad con el modelo binomial
  de GOLD_PPM en muestras geoquímicas",
  xlab = "Número de muestras con alta concentración de oro",
  ylab = "Probabilidad (%)",
  ylim = c(0, max(datos_comparacion) * 1.35),
  las = 1,
  cex.names = 0.85
)

abline(
  h = pretty(c(0, max(datos_comparacion))),
  col = "gray80",
  lty = 2
)

barplot(
  datos_comparacion,
  beside = TRUE,
  col = c("skyblue", "blue"),
  add = TRUE,
  axes = FALSE,
  names.arg = rep("", length(categorias_binomiales))
)

legend(
  "top",
  legend = c("Realidad", "Modelo binomial"),
  fill = c("skyblue", "blue"),
  horiz = TRUE,
  bty = "n",
  inset = c(0, 0),
  cex = 0.9
)

box()

TEST DE BONDAD

TEST DE PEARSON

fo_pearson <- ni_grupos
N_grupos <- sum(ni_grupos)

fe_pearson <- N_grupos * P_teorica

Coef_Pearson <- cor(fo_pearson, fe_pearson) * 100

cat("Coeficiente de Pearson (%):", round(Coef_Pearson, 2), "\n")

## Coeficiente de Pearson (%): 91.77

TEST DE CHI-CUADRADO

# Frecuencia relativa observada

fo <- ni_grupos / N_grupos

# Probabilidades teóricas esperadas

fe <- P_teorica

# Número de categorías

k <- length(fo)

# Grados de libertad: categorías - 1 - parámetro estimado p

gl <- k - 2

# Chi-cuadrado calculado

Chi_Calculado <- sum((fo - fe)^2 / fe)

# Valor crítico

Chi_Critico <- qchisq(0.95, df = gl)

cat("\nChi Calculado:", round(Chi_Calculado, 4), "\n")

## 
## Chi Calculado: 0.029

cat("Chi Crítico:", round(Chi_Critico, 4), "\n")

## Chi Crítico: 5.9915

if (Chi_Calculado < Chi_Critico) {
  print("Evalúa H0: El modelo binomial es adecuado.")
} else {
  print("Se rechaza H0: El modelo binomial no es adecuado.")
}

## [1] "Evalúa H0: El modelo binomial es adecuado."

TABLA RESUMEN

Variable <- c("GOLD_PPM")

tabla_resumen <- data.frame(
  Variable,
  round(Coef_Pearson, 2),
  round(Chi_Calculado, 4),
  round(Chi_Critico, 4)
)

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

kable(
  tabla_resumen,
  format = "markdown",
  caption = "Tabla Nro. 2: Resumen de test de bondad al modelo binomial"
)

Tabla Nro. 2: Resumen de test de bondad al modelo binomial
Variable	Test Pearson (%)	Chi Cuadrado	Umbral de aceptación
GOLD_PPM	91.77	0.029	5.9915

CÁLCULO DE PROBABILIDADES

# Probabilidad de que en un grupo de 50 muestras
# entre 10 y 15 presenten alta concentración de oro

prob_10_15 <- (
  pbinom(15, size = n_ensayo, prob = p) -
  pbinom(9, size = n_ensayo, prob = p)
) * 100

prob_10_15

## [1] 67.31405

# Gráfico de texto explicativo

plot(1, type = "n", axes = FALSE, xlab = "", ylab = "")

text(
  x = 1, y = 1,
  labels = paste(
    "Cálculo de probabilidad\n",
    "¿Cuál es la probabilidad de que en un grupo\n",
    "de 50 muestras, entre 10 y 15 presenten\n",
    "alta concentración de oro?\n",
    "Probabilidad = ", round(prob_10_15, 2), " (%)",
    sep = ""
  ),
  cex = 1.3,
  col = "black",
  font = 2
)

# Cantidad esperada en 300 futuras muestras

cantidad_esperada <- p * 300

cantidad_esperada

## [1] 75.12

INTERVALO DE CONFIANZA

# Proporción muestral

p_muestral <- p

# Número de observaciones

n_gold <- length(GOLD_ALTO)

# Nivel de confianza del 95%

error_gold <- 1.96 * sqrt((p_muestral * (1 - p_muestral)) / n_gold)

# Límites del intervalo de confianza

limite_inferior_gold <- p_muestral - error_gold

limite_superior_gold <- p_muestral + error_gold

# Creamos la tabla

tabla_intervalo_gold <- data.frame(
  Intervalo = paste0(
    "P [",
    round(limite_inferior_gold * 100, 2),
    "% < p < ",
    round(limite_superior_gold * 100, 2),
    "%] = 95%"
  )
)

tabla_intervalo_gold %>%
  gt() %>%
  tab_header(
    title = md("*Tabla Nro. 3*"),
    subtitle = md("**Intervalo de confianza de la proporción de muestras con alta concentración de oro en GOLD_PPM**")
  ) %>%
  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",
    table.border.left.color = "black",
    table.border.left.style = "solid",
    table.border.left.width = px(1),
    table.border.right.color = "black",
    table.border.right.style = "solid",
    table.border.right.width = px(1)
  )

Intervalo
Tabla Nro. 3
Intervalo de confianza de la proporción de muestras con alta concentración de oro en GOLD_PPM
P [23.34% < p < 26.74%] = 95%
Autor: Grupo 2

CONCLUSIÓN

La variable GOLD_PPM se ajusta a un modelo binomial con un parámetro de probabilidad (p = 0.2504), con un coeficiente de Pearson de 91.77%. Con un 95% de confianza, la proporción poblacional de muestras con alta concentración de oro se encuentra entre 23.34% y 26.74%. Además, existe una probabilidad del 67.31% de que, en un grupo de 50 muestras, entre 10 y 15 presenten alta concentración de oro.

CONCENTRACIÓN DE ORO - MODELO BINOMIAL

Grupo 2

2026-07-29