CONCENTRACIÓN TOTAL DE METALES - MODELO LOG-NORMAL

ANÁLISIS INFERENCIAL

CARGA DE DATOS Y LIBRERÍAS

CARGA DE LIBRERÍAS

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

CARGA DE DATOS

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

SELECCIÓN DE VARIABLE ALEATORIA

# Selección de variable

concentracion_metales <- datos$CONCENTRACION_TOTAL_METALES_PPM

# Conversión a numérico

concentracion_metales <- as.numeric(concentracion_metales)

# Eliminación de datos faltantes y valores no positivos
# El modelo log-normal solo trabaja con valores mayores que cero

concentracion_metales <- concentracion_metales[
  !is.na(concentracion_metales) & concentracion_metales > 0
]

TABLA Y GRÁFICA DE DISTRIBUCIÓN DE FRECUENCIA

# FRECUENCIA

# 1. Calculamos el rango y definimos la amplitud necesaria para 10 intervalos

min_met <- floor(min(concentracion_metales, na.rm = TRUE))

max_met <- ceiling(max(concentracion_metales, na.rm = TRUE))

# Redondeamos la amplitud hacia arriba para asegurar que cubra el rango en 10 pasos

A_ajustada <- ceiling((max_met - min_met) / 10)

# 2. Definimos los cortes para 10 intervalos

mis_breaks <- seq(from = min_met, by = A_ajustada, length.out = 11)

# 3. Generamos el histograma con esos breaks

histo_metales <- hist(
  concentracion_metales,
  breaks = mis_breaks,
  plot = FALSE,
  right = FALSE
)

# 4. Extraemos límites y calculamos estadísticas

Li2 <- histo_metales$breaks[1:(length(histo_metales$breaks) - 1)]

Ls2 <- histo_metales$breaks[2:length(histo_metales$breaks)]

MC2 <- (Li2 + Ls2) / 2

ni2 <- histo_metales$counts

hi2 <- (ni2 / sum(ni2)) * 100

Ni2_asc <- cumsum(ni2)

Hi2_asc <- cumsum(hi2)

Ni2_desc <- rev(cumsum(rev(ni2)))

Hi2_desc <- rev(cumsum(rev(hi2)))

# 5. Creamos los intervalos como texto

Intervalo2 <- paste0("[", Li2, " - ", Ls2, ")")

Intervalo2[length(Intervalo2)] <- paste0(
  "[",
  Li2[length(Li2)],
  " - ",
  Ls2[length(Ls2)],
  "]"
)

# CONSTRUCCIÓN DE LA TABLA

TDF_metales_final <- data.frame(
  Intervalo = Intervalo2,
  MC = MC2,
  ni = ni2,
  hi = round(hi2, 2),
  Ni_asc = Ni2_asc,
  Hi_asc = round(Hi2_asc, 2),
  Ni_desc = Ni2_desc,
  Hi_desc = round(Hi2_desc, 2)
)

# Totales

totaless <- data.frame(
  Intervalo = "Totales",
  MC = "-",
  ni = sum(ni2),
  hi = round(sum(hi2), 2),
  Ni_asc = "-",
  Hi_asc = "-",
  Ni_desc = "-",
  Hi_desc = "-"
)

TDF_metales_final <- rbind(TDF_metales_final, totaless)

# Tabla con gt()

TDF_metales_final %>%
  gt() %>%
  tab_header(
    title = md("*Tabla Nro. 1*"),
    subtitle = md("*Distribución de frecuencia simplificada de la concentración total de metales en muestras geoquímicas de depósitos minerales en Estados Unidos*")
  ) %>%
  tab_source_note(
    source_note = md("Autor: Grupo 2")
  ) %>%
  tab_style(
    style = cell_borders(sides = c("left", "right"), color = "black", weight = px(2)),
    locations = cells_body()
  ) %>%
  tab_style(
    style = cell_borders(sides = c("left", "right"), color = "black", weight = px(2)),
    locations = cells_column_labels()
  ) %>%
  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 Nro. 1
Distribución de frecuencia simplificada de la concentración total de metales en muestras geoquímicas de depósitos minerales en Estados Unidos
Intervalo	MC	ni	hi	Ni_asc	Hi_asc	Ni_desc	Hi_desc
[12 - 861)	436.5	1932	77.28	1932	77.28	2500	100
[861 - 1710)	1285.5	397	15.88	2329	93.16	568	22.72
[1710 - 2559)	2134.5	97	3.88	2426	97.04	171	6.84
[2559 - 3408)	2983.5	38	1.52	2464	98.56	74	2.96
[3408 - 4257)	3832.5	13	0.52	2477	99.08	36	1.44
[4257 - 5106)	4681.5	14	0.56	2491	99.64	23	0.92
[5106 - 5955)	5530.5	5	0.20	2496	99.84	9	0.36
[5955 - 6804)	6379.5	1	0.04	2497	99.88	4	0.16
[6804 - 7653)	7228.5	0	0.00	2497	99.88	3	0.12
[7653 - 8502]	8077.5	3	0.12	2500	100	3	0.12
Totales	-	2500	100.00	-	-	-	-
Autor: Grupo 2

GRÁFICA DE DISTRIBUCIÓN DE FRECUENCIA

# Histograma porcentual de la concentración total de metales

plot(
  histo_metales,
  freq = FALSE,
  main = "Gráfica Nro. 1
Distribución porcentual de la concentración total de metales
en muestras geoquímicas de depósitos minerales en Estados Unidos",
  xlab = "Concentración total de metales (ppm)",
  ylab = "Porcentaje (%)",
  xaxt = "n",
  cex.main = 1,
  ylim = c(0, max(hi2))
)

# Cuadrícula

abline(
  v = mis_breaks,
  col = "gray70",
  lty = 2,
  lwd = 0.8
)

abline(
  h = axTicks(2),
  col = "gray70",
  lty = 2,
  lwd = 0.8
)

# Barras porcentuales

rect(
  histo_metales$breaks[-length(histo_metales$breaks)],
  0,
  histo_metales$breaks[-1],
  hi2,
  col = "gray",
  border = "black"
)

# Eje X personalizado

axis(
  1,
  at = mis_breaks,
  labels = round(mis_breaks, 0),
  las = 1,
  cex.axis = 0.9
)

box()

CONJETURA DEL MODELO

Se conjetura que la variable CONCENTRACION_TOTAL_METALES_PPM sigue un modelo de probabilidad log-normal, debido a que representa una variable cuantitativa continua, positiva y asociada a concentraciones geoquímicas.

Esta variable puede presentar una mayor concentración de observaciones en valores bajos o moderados, mientras que pocos registros alcanzan valores muy altos, formando una cola larga hacia la derecha. Por esta razón, su comportamiento es compatible con una distribución asimétrica positiva, característica de los modelos log-normales.

PARÁMETROS

# PARÁMETROS LOG-NORMALES

# Media de los logaritmos

mu <- mean(log(concentracion_metales))

# Desviación estándar de los logaritmos

sigma_log <- sd(log(concentracion_metales))

cat("Media de los logaritmos (mu) =", round(mu, 4), "\n")

## Media de los logaritmos (mu) = 6.1145

cat("Desviación estándar de los logaritmos (sigma) =", round(sigma_log, 4), "\n")

## Desviación estándar de los logaritmos (sigma) = 0.8781

SOBREPOSICIÓN DE LA REALIDAD CON EL MODELO LOG-NORMAL

# MODELO LOG-NORMAL

# Histograma porcentual

hist(
  concentracion_metales,
  breaks = mis_breaks,
  freq = FALSE,
  col = NA,
  border = NA,
  main = "Gráfica Nro 3
Comparación de la realidad y el modelo log-normal
de la concentración total de metales en muestras geoquímicas",
  xlab = "Concentración total de metales (ppm)",
  ylab = "Densidad de probabilidad",
  xaxt = "n",
  yaxt = "n",
  ylim = c(0, max(hi2) * 1.25)
)

# Cuadrícula

abline(v = mis_breaks, col = "gray80", lty = 2)

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

# Barras reales

rect(
  histo_metales$breaks[-length(histo_metales$breaks)],
  0,
  histo_metales$breaks[-1],
  hi2,
  col = "gray",
  border = "black"
)

# Curva log-normal convertida a porcentaje

x <- seq(
  min(concentracion_metales),
  max(concentracion_metales),
  length = 1000
)

y <- dlnorm(
  x,
  meanlog = mu,
  sdlog = sigma_log
) * A_ajustada * 100

lines(
  x,
  y,
  col = "blue",
  lwd = 2
)

# Ejes

axis(
  1,
  at = mis_breaks,
  labels = mis_breaks,
  las = 1,
  cex.axis = 0.8
)

axis(
  2,
  at = pretty(c(0, max(hi2))),
  las = 1
)

# Leyenda

legend(
  "topright",
  legend = c("Datos reales (FO)", "Modelo log-normal (FE)"),
  col = c("gray", "blue"),
  lty = c(NA, 1),
  pch = c(22, NA),
  pt.bg = c("gray", NA),
  pt.cex = 2,
  lwd = c(1, 3),
  bty = "n"
)

box()

TEST DE APROBACIÓN

TEST DE PEARSON

fo <- ni2

N <- length(concentracion_metales)

fe <- N * (
  plnorm(Ls2, meanlog = mu, sdlog = sigma_log) -
    plnorm(Li2, meanlog = mu, sdlog = sigma_log)
)

Coef_Pearson <- cor(fo, fe) * 100

Coef_Pearson

## [1] 99.99088

TEST DE CHI-CUADRADO

# Total de datos

N <- sum(ni2)

# Frecuencia relativa observada

fo <- ni2 / N

# Número de intervalos

k <- length(fo)

# Probabilidades teóricas por intervalo log-normal

P <- c(0)

for (i in 1:k) {
  P[i] <- plnorm(Ls2[i], meanlog = mu, sdlog = sigma_log) -
    plnorm(Li2[i], meanlog = mu, sdlog = sigma_log)
}

fe <- P

# Chi-cuadrado

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

# Grados de libertad

gl <- k - 1

# Valor crítico

Chi_Critico <- qchisq(0.95, df = gl)

# Resultados

Chi_Calculado

## [1] 0.01007294

Chi_Critico

## [1] 16.91898

# Decisión

if (Chi_Calculado < Chi_Critico) {
  print("Evaluado: El modelo log-normal es adecuado.")
} else {
  print("Se rechaza: El modelo log-normal no es adecuado.")
}

## [1] "Evaluado: El modelo log-normal es adecuado."

CÁLCULO DE PROBABILIDADES

# PREGUNTA DE PORCENTAJE
# ¿Cuál es la probabilidad de que la concentración total de metales
# no supere los 500 ppm en una muestra geoquímica?

# PROBABILIDAD: P(Concentración total de metales ≤ 500)

prob_500 <- plnorm(500, meanlog = mu, sdlog = sigma_log)

prob_500_porcentaje <- prob_500 * 100

prob_500_porcentaje

## [1] 54.53831

# PREGUNTA DE CANTIDAD
# ¿Cuántas muestras de 300 futuras se espera que no superen los 500 ppm?

muestras_300 <- prob_500 * 300

muestras_300

## [1] 163.6149

# PREGUNTA DE INTERVALO
# ¿Cuál es la probabilidad de que la concentración total de metales
# se encuentre entre 500 y 1000 ppm?

# PROBABILIDAD: P(500 ≤ X ≤ 1000)

prob_500_1000 <- (
  plnorm(1000, meanlog = mu, sdlog = sigma_log) -
    plnorm(500, meanlog = mu, sdlog = sigma_log)
) * 100

prob_500_1000

## [1] 27.14438

# DEMOSTRACIÓN GRÁFICA

x <- seq(
  min(concentracion_metales, na.rm = TRUE),
  max(concentracion_metales, na.rm = TRUE),
  by = 0.01
)

y <- dlnorm(x, meanlog = mu, sdlog = sigma_log)

y <- y * 100 * A_ajustada

plot(
  x,
  y,
  col = "skyblue3",
  lwd = 2,
  type = "l",
  xlim = c(min(concentracion_metales), max(concentracion_metales)),
  ylim = c(0, max(y)),
  main = "Gráfica Nro 4: Demostración de cálculo de probabilidades
en la concentración total de metales en muestras geoquímicas",
  ylab = "Densidad de probabilidad",
  xlab = "Concentración total de metales (ppm)",
  xaxt = "n"
)

# Eje X

axis(
  1,
  at = mis_breaks,
  labels = mis_breaks,
  las = 1,
  cex.axis = 0.8
)

# ÁREA DE PROBABILIDAD P(X ≤ 500)

x_section <- seq(
  min(concentracion_metales, na.rm = TRUE),
  500,
  by = 0.01
)

y_section <- dlnorm(x_section, meanlog = mu, sdlog = sigma_log)

y_section <- y_section * 100 * A_ajustada

lines(
  x_section,
  y_section,
  col = "darkgreen",
  lwd = 2
)

polygon(
  c(x_section, rev(x_section)),
  c(y_section, rep(0, length(y_section))),
  col = rgb(0, 0.6, 0, 0.35),
  border = NA
)

# ÁREA DE PROBABILIDAD P(500 ≤ X ≤ 1000)

x_section2 <- seq(500, 1000, by = 0.01)

y_section2 <- dlnorm(x_section2, meanlog = mu, sdlog = sigma_log)

y_section2 <- y_section2 * 100 * A_ajustada

lines(
  x_section2,
  y_section2,
  col = "orange",
  lwd = 2
)

polygon(
  c(x_section2, rev(x_section2)),
  c(y_section2, rep(0, length(y_section2))),
  col = rgb(1, 0.5, 0, 0.4),
  border = NA
)

legend(
  "topright",
  legend = c(
    "Modelo log-normal",
    "Área Probabilidad ≤ 500",
    "Área Probabilidad entre 500 y 1000"
  ),
  col = c(
    "skyblue3",
    "darkgreen",
    "orange"
  ),
  lwd = 2,
  bty = "o",
  bg = "white"
)

grid()

INTERVALO DE CONFIANZA

# Media, desviación y tamaño

media <- mean(concentracion_metales, na.rm = TRUE)

desviacion <- sd(concentracion_metales, na.rm = TRUE)

n <- length(concentracion_metales)

# Valor crítico t

t_critico <- qt(0.975, df = n - 1)

# Error estándar

error <- t_critico * (desviacion / sqrt(n))

# Límites del intervalo

limite_inferior <- round(media - error, 2)

limite_superior <- round(media + error, 2)

# Tabla final

tabla_intervalo <- data.frame(
  Intervalo = paste0(
    "P [",
    limite_inferior,
    " < μ < ",
    limite_superior,
    "] = 95%"
  )
)

tabla_intervalo %>%
  gt() %>%
  tab_header(
    title = md("*Tabla Nro. 3*"),
    subtitle = md("Intervalo de confianza de la concentración total de metales en 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),
    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 Nro. 3
Intervalo de confianza de la concentración total de metales en muestras geoquímicas
Intervalo
P [643.43 < μ < 702.58] = 95%
Autor: Grupo 2

CONCLUSIÓN

La variable CONCENTRACION_TOTAL_METALES_PPM se puede explicar mediante un modelo log-normal con parámetros μ = 6.11 y σ = 0.88. Podemos afirmar con un 95% de confianza que la media poblacional de esta variable se encuentra aproximadamente entre 643.43 y 702.58 ppm, con una media observada de 673 ppm y una desviación estándar de 754.13 ppm. Además, se evidencia una distribución asimétrica positiva, ya que la mayor parte de las muestras presenta concentraciones bajas o moderadas, mientras que pocos registros alcanzan concentraciones muy elevadas.