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 - VARIABLE GOLD_PPM BINOMIAL

Resultado <- factor(
  GOLD_ALTO,
  levels = c(0, 1),
  labels = c("Fracaso: no alta concentración de oro",
             "Éxito: alta concentración de oro")
)

ni <- as.numeric(table(Resultado))

N <- sum(ni)

hi <- (ni / N) * 100

p_s <- ni / N

x <- c(0, 1)

TDF_GOLD <- data.frame(
  Resultado = c("Fracaso: no alta concentración de oro",
                "Éxito: alta concentración de oro"),
  x = x,
  ni = ni,
  hi = round(hi, 2),
  p_s = round(p_s, 4)
)

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

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

colnames(totales) <- c("Resultado", "x", "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 la concentración alta de oro en muestras geoquímicas de depósitos minerales en Estados Unidos**")
  ) %>%
  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)
  )

Resultado	x	ni	hi(%)	p(s)
Tabla Nro. 1
Distribución de frecuencia de la concentración alta de oro en muestras geoquímicas de depósitos minerales en Estados Unidos
Fracaso: no alta concentración de oro	0	1874	74.96	0.75
Éxito: alta concentración de oro	1	626	25.04	0.25
Totales	NA	2500	100.00	1.00
Autor: Grupo 2

GRÁFICA DE DISTRIBUCIÓN DE FRECUENCIA

# Ajuste de márgenes

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

porcentajes_plot <- hi

nombres_plot <- c("0", "1")

barras <- barplot(
  height = porcentajes_plot,
  names.arg = nombres_plot,
  space = 0.4,
  col = "gray",
  border = "black",
  main = "Gráfica N°1: Distribución porcentual de GOLD_PPM
  en muestras geoquímicas de depósitos minerales en Estados Unidos",
  xlab = "Resultado binomial",
  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(nombres_plot))
)

mtext(
  "0 = No alta concentración de oro     1 = Alta concentración de oro",
  side = 1,
  line = 4,
  cex = 0.8
)

box()

CONJETURA DEL MODELO

# Se conjetura que la variable GOLD_PPM, transformada en una variable binaria,
# se ajusta a un modelo de probabilidad binomial. Esto se justifica porque cada
# muestra geoquímica puede clasificarse en dos resultados posibles:
# éxito, cuando presenta alta concentración de oro, y fracaso, cuando no alcanza
# dicho umbral.
#
# Además, el modelo binomial permite estimar la probabilidad de obtener cierto
# número de muestras con alta concentración de oro dentro de un conjunto fijo
# de muestras analizadas.

PARÁMETROS

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

# Total de muestras

N <- length(GOLD_ALTO)

# Número de éxitos

exitos <- sum(GOLD_ALTO)

# Número de fracasos

fracasos <- N - exitos

# Probabilidad de éxito

p <- exitos / N

# Probabilidad de fracaso

q <- 1 - p

# Tamaño del ensayo binomial
# Se trabaja con grupos de 50 muestras.

n_ensayo <- 50

cat("Total de muestras =", N, "\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

# SOBREPOSICIÓN DE LA REALIDAD CON EL MODELO BINOMIAL

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),
    .groups = "drop"
  )

# Agrupación de éxitos para comparar realidad y modelo

intervalos_binomiales <- cut(
  datos_grupos$Exitos_oro_alto,
  breaks = c(-Inf, 8, 11, 14, Inf),
  labels = c("0 - 8", "9 - 11", "12 - 14", "15 o más"),
  right = TRUE
)

ni_modelo <- as.numeric(table(
  factor(intervalos_binomiales,
         levels = c("0 - 8", "9 - 11", "12 - 14", "15 o más"))
))

N_grupos <- sum(ni_modelo)

hi_real <- (ni_modelo / N_grupos) * 100

# 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_real,
  Modelo = hi_modelo
)

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

grafica_comp <- barplot(
  datos_comparacion,
  beside = TRUE,
  names.arg = c("0 - 8", "9 - 11", "12 - 14", "15 o más"),
  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("", 4)
)

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

# Frecuencias absolutas observadas y esperadas

fo_pearson <- ni_modelo

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

# Total de grupos

N_chi <- sum(ni_modelo)

# Frecuencia relativa observada

fo <- ni_modelo / N_chi

# Número de intervalos

k <- length(fo)

# Probabilidades teóricas esperadas

fe <- P_teorica

# Chi-cuadrado calculado con frecuencias relativas

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

# Grados de libertad

gl <- k - 1

# 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: 7.8147

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	7.8147

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

cat(
  paste0(
    "La variable GOLD_PPM se ajusta a un modelo binomial, considerando como éxito a las muestras con alta concentración de oro y como fracaso a las muestras que no alcanzan dicho umbral. ",
    "El parámetro de probabilidad obtenido fue p = ", round(p, 4), ", con un coeficiente de Pearson de ", round(Coef_Pearson, 2), "%. ",
    "Con un 95% de confianza, la proporción poblacional de muestras con alta concentración de oro se encuentra entre ",
    round(limite_inferior_gold * 100, 2), "% y ", round(limite_superior_gold * 100, 2), "%. ",
    "Además, existe una probabilidad del ", round(prob_10_15, 2),
    "% de que, en un grupo de 50 muestras, entre 10 y 15 presenten alta concentración de oro."
  )
)

## La variable GOLD_PPM se ajusta a un modelo binomial, considerando como éxito a las muestras con alta concentración de oro y como fracaso a las muestras que no alcanzan dicho umbral. El parámetro de probabilidad obtenido fue 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

ANÁLISIS INFERENCIAL

CARGA DE DATOS Y LIBRERÍAS

SELECCIÓN DE LA VARIABLE

TABLA DE FRECUENCIA

GRÁFICA DE DISTRIBUCIÓN DE FRECUENCIA

CONJETURA DEL MODELO

TEST DE BONDAD

CÁLCULO DE PROBABILIDADES

INTERVALO DE CONFIANZA

CONCLUSIÓN