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 DISTRIBUCIÓN DE FRECUENCIA

# Se trabaja con grupos de 10 muestras.
# En cada grupo se cuenta cuántas muestras presentan alta concentración de oro.

n_ensayo <- 10

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(
    Oro_alto_grupo = sum(GOLD_ALTO),
    Total_muestras = n(),
    .groups = "drop"
  )

# Categorías exactas, no intervalos

categorias_binomiales <- 0:n_ensayo

ni_grupos <- as.numeric(table(
  factor(datos_grupos$Oro_alto_grupo, levels = categorias_binomiales)
))

# Frecuencia de muestras representadas
# Cada grupo representa 10 muestras

ni <- ni_grupos * n_ensayo

N <- sum(ni)

hi <- (ni / N) * 100

p_s <- ni / N

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

colnames(TDF_GOLD) <- c("Categoría", "ni", "hi(%)", "p(s)")

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

colnames(totales) <- c("Categoría", "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 del número de muestras con alta concentración de oro en grupos de 10 muestras geoquímicas**")
  ) %>%
  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)
  )

Categoría	ni	hi(%)	p(s)
Tabla Nro. 1
Distribución de frecuencia del número de muestras con alta concentración de oro en grupos de 10 muestras geoquímicas
0	140	5.60	0.06
1	520	20.80	0.21
2	680	27.20	0.27
3	540	21.60	0.22
4	410	16.40	0.16
5	160	6.40	0.06
6	30	1.20	0.01
7	20	0.80	0.01
8	0	0.00	0.00
9	0	0.00	0.00
10	0	0.00	0.00
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

barplot(
  height = porcentajes_plot,
  names.arg = categorias_binomiales,
  space = 0.4,
  col = "gray",
  border = "black",
  main = "Gráfica N°1: Distribución porcentual del número de muestras
con alta concentración de oro por grupos de 10 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 se ajusta a un modelo de probabilidad binomial, al analizarse como el número de muestras con alta concentración de oro dentro de grupos de 10 muestras. La base total de 2500 registros se organiza en grupos fijos, y en cada uno se contabiliza cuántas muestras cumplen con el criterio de alta concentración de oro.

Las categorías del modelo van de 0 a 10, representando la cantidad de muestras con alta concentración de oro en cada grupo. Este comportamiento permite aplicar el modelo binomial, ya que se evalúa la probabilidad de obtener una cantidad determinada de muestras con alta concentración dentro de un número fijo de observaciones.

PARÁMETROS

N_total <- length(GOLD_ALTO)

oro_alto <- sum(GOLD_ALTO)

oro_no_alto <- N_total - oro_alto

p <- oro_alto / N_total

q <- 1 - p

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

## Total de muestras = 2500

cat("Muestras con alta concentración de oro =", oro_alto, "\n")

## Muestras con alta concentración de oro = 626

cat("Muestras sin alta concentración de oro =", oro_no_alto, "\n")

## Muestras sin alta concentración de oro = 1874

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

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

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

## Probabilidad complementaria (q) = 0.7496

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

## Tamaño del ensayo binomial = 10

COMPARACIÓN DE LA REALIDAD VS MODELO BINOMIAL

# Probabilidades teóricas del modelo binomial

P_teorica <- dbinom(
  categorias_binomiales,
  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))

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.9
)

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(
  "topright",
  legend = c("Realidad", "Modelo binomial"),
  fill = c("skyblue", "blue"),
  bty = "n",
  cex = 0.9
)

box()

TEST DE APROBACIÓN

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 (%): 99.1

TEST DE CHI-CUADRADO

# TEST DE CHI-CUADRADO

fo <- ni_grupos / N_grupos

fe <- P_teorica

k <- length(fo)

gl <- k - 2

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

Chi_Critico <- qchisq(0.95, df = gl)

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

## 
## Chi Calculado: 0.0192

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

## Chi Crítico: 16.919

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	99.1	0.0192	16.919

ESTIMACIONES

# Probabilidad de que una muestra presente alta concentración de oro

prob_oro_alto <- p * 100

prob_oro_alto

## [1] 25.04

# 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 una muestra\n",
    "presente alta concentración de oro?\n",
    "Probabilidad = ", round(prob_oro_alto, 2), " (%)",
    sep = ""
  ),
  cex = 1.3,
  col = "black",
  font = 2
)

# Cantidad esperada en 300 futuras muestras
# con alta concentración de oro

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, considerando la presencia de alta concentración de oro en las muestras geoquímicas. El coeficiente de Pearson obtenido fue de 99.1%. 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, en 300 futuras muestras se espera que aproximadamente 75 presenten alta concentración de oro.

NÚMERO DE MUESTRAS CON ALTA CONCENTRACIÓN DE ORO - MODELO BINOMIAL

Grupo 2

2026-08-05