Analisis Inferencial de Minerales Criticos (Fe_pct_AES_ST) - Modelo Log-normal

1. CARGA DE DATOS

CARGA DE DATOS

# Parametros generales del reporte.
# Cambia estos valores para reutilizar la estructura con otra variable positiva.
ruta_archivo <- "C:/Users/Martin/Desktop/Estadistica/CMDB_Data.csv"
columnas_posibles <- c("Fe_pct_AES_ST", "FE_pct_AES_ST")
nombre_variable <- "Hierro"
unidad_variable <- "%"

separador_csv <- ";"
decimal_csv <- "."
encoding_csv <- "latin1"

# Parametros del modelo y del reporte.
breaks_histograma <- 6
nivel_aceptacion_modelo <- 0.75
nivel_confianza_ic <- 0.87

# Preguntas de probabilidad.
n_nuevas_minas <- 50
probabilidad_inferior <- 0.25
probabilidad_superior <- 0.75

autor_tablas <- "Autor: Grupo 1"

library(dplyr)
library(gt)

datos <- read.csv(
  ruta_archivo,
  header = TRUE,
  sep = separador_csv,
  dec = decimal_csv,
  fileEncoding = encoding_csv
)

columna_variable <- columnas_posibles[columnas_posibles %in% names(datos)][1]

if (is.na(columna_variable)) {
  stop(paste("No se encontro ninguna de estas variables:", paste(columnas_posibles, collapse = ", ")))
}

# Verificacion inicial del set de datos.
str(datos)

## 'data.frame':    1366 obs. of  103 variables:
##  $ ï..LAB_ID            : chr  "C355417" "C360759" "C360762" "C360763" ...
##  $ PREVIOUS_LAB_ID1     : chr  "" "" "" "" ...
##  $ PREVIOUS_LAB_ID2     : chr  "" "" "" "" ...
##  $ PREVIOUS_LAB_ID3     : chr  "" "" "" "" ...
##  $ FIELD_ID             : chr  "RM0001" "RM0027" "RM0030" "RM0031" ...
##  $ JOB_ID               : chr  "MRP11968" "MRP12307" "MRP12307" "MRP12307" ...
##  $ PREVIOUS_JOB_ID1     : chr  "" "" "" "" ...
##  $ PREVIOUS_JOB_ID2     : chr  "" "" "" "" ...
##  $ PREVIOUS_JOB_ID3     : chr  "" "" "" "" ...
##  $ SUBMITTER            : chr  "Rare Metals Task" "Rare Metals Task" "Rare Metals Task" "Rare Metals Task" ...
##  $ PROJECT_NAME         : chr  "Critical and Rare Metals" "Critical and Rare Metals" "Critical and Rare Metals" "Critical and Rare Metals" ...
##  $ X0                   : chr  "30/6/2011" "31/8/2011" "31/8/2011" "31/8/2011" ...
##  $ COLLECTION           : chr  "Mackay-Keck Ore Deposits Collection" "Mackay-Stanford Ore Deposits Collection" "Mackay-Stanford Ore Deposits Collection" "Mackay-Stanford Ore Deposits Collection" ...
##  $ COLLECTION_ID        : chr  "PHNC08_39_1183" "OD21441" "OD22811" "OD25716" ...
##  $ CONTINENT            : chr  "North America" "South America" "South America" "Africa" ...
##  $ COUNTRY              : chr  "United States" "Chile" "Chile" "South Africa" ...
##  $ STATE_PROVINCE       : chr  "Nevada" "Antofagasta" "Tarapacá" "Transvaal" ...
##  $ COUNTY               : chr  "Lyon" "El Loa" "El Tamarugal" "" ...
##  $ DISTRICT_NAME        : chr  "Yerington" "Chuquicamata" "Collahuasi/Quebrada Blanca" "" ...
##  $ DEPOSIT_NAME         : chr  "Pumpkin Hollow" "" "" "" ...
##  $ MINE_NAME            : chr  "Pumpkin Hollow" "Chuquicamata mine" "Collahuasi district" "" ...
##  $ DISTRICT_NAME_COLLECT: chr  "Yerington" "" "" "" ...
##  $ DEPOSIT_NAME_COLLECT : chr  "" "" "" "" ...
##  $ MINE_NAME_COLLECT    : chr  "Pumpkin Hollow" "Chuquicamata" "Poduosa mine" "Messina Mines Ltd." ...
##  $ LOCATE_DESC          : chr  "" "" "Level 25" "" ...
##  $ LATITUDE             : chr  "38,94021" "-22,2871" "-21,0309" "-24,7" ...
##  $ LONGITUDE            : chr  "-119,05178" "-68,8991" "-68,74951" "29,3" ...
##  $ DATUM                : chr  "WGS84" "WGS84" "WGS84" "" ...
##  $ LATITUDE_COLLECT     : chr  "38,92492" "22,28944" "" "" ...
##  $ LONGITUDE_COLLECT    : chr  "-119,1071" "-68,90111" "" "" ...
##  $ DATUM_COLLECT        : chr  "" "WGS84" "" "" ...
##  $ COORDINATES_QUAL     : chr  "100 m" "0m" "" "" ...
##  $ COORDINATES_SOURCE   : chr  "1) iTouchMap.com, approx, A. Orkild-Norton; 2) Mineral Resource Deposit Database Deposit ID 10174173, ore body, M. Granitto" "1) Mindat.org, approx, A. Orkild-Norton; 2) Open-File Report 2017-1079 ID 549, mine, M. Granitto" "1) No coordinates; 2) Mineral Resource Deposit Database Deposit ID 10057511, district, M. Granitto" "1) No coordinates; 2) Google Earth Pro, approx ctr of former province of Transvaal, M. Granitto" ...
##  $ PRIMARY_CLASS        : chr  "rock" "rock" "rock" "rock" ...
##  $ SYSTEM_TYPE          : chr  "IOA-IOCG" "Porphyry Cu-Mo-Au" "Porphyry Cu-Mo-Au" "IOA-IOCG" ...
##  $ DEPOSIT_TYPE         : chr  "IOCG" "Supergene Cu" "Porphyry Cu" "IOCG" ...
##  $ SAMPLE_DESC          : chr  "Nearly solid chalcopyrite mixed with small light brown irregular inclusions of unknown mineralogy; clouds of ma"| __truncated__ "Chalcocite-bronchatite-antlerite(?); highly microfractured igneous rock with green copper sulfates coating microfractures" "Bornite-chalcopyrite; mostly massive chalcopyrite with numerous inclusions of micro-chalcopyrite and widely sca"| __truncated__ "Massive chalcopyrite, IOCG in shear zone; mostly massive fine grain cuprite with widely distributed malachite t"| __truncated__ ...
##  $ Al_pct_AES_ST        : chr  "0,33" "6,65" "0,46" "0,7" ...
##  $ Ca_pct_AES_ST        : chr  "1,1" "0,4" "-0,1" "0,3" ...
##  $ Fe_pct_AES_ST        : chr  "42,4" "0,25" "6,98" "27,8" ...
##  $ K_pct_AES_ST         : chr  "-0,1" "6,1" "0,2" "-0,1" ...
##  $ Mg_pct_AES_ST        : chr  "0,57" "0,1" "0,01" "0,33" ...
##  $ Mn_pct_AES_ST        : chr  "0,02" "-0,01" "-0,01" "-0,01" ...
##  $ P_pct_AES_ST         : chr  "-0,01" "0,01" "0,05" "0,01" ...
##  $ S_pct_AES_ST         : chr  "" "" "" "" ...
##  $ Si_pct_AES_ST        : chr  "" "" "" "" ...
##  $ Ti_pct_AES_ST        : chr  "0,01" "0,11" "-0,01" "-0,01" ...
##  $ F_pct_ISE_Fuse       : chr  "" "" "" "" ...
##  $ Ag_ppm_MS_ST         : chr  "58" "6" "468" "16" ...
##  $ As_ppm_MS_ST         : chr  "-30" "-30" "90" "-30" ...
##  $ Au_ppm               : chr  "" "" "" "" ...
##  $ Au_AM                : chr  "" "" "" "" ...
##  $ B_ppm_AES_ST         : int  NA NA NA NA NA NA NA NA NA NA ...
##  $ Ba_ppm_AES_ST        : chr  "-0,5" "924" "121" "174" ...
##  $ Be_ppm_AES_ST        : int  -5 -5 -5 -5 -5 -5 -5 -5 -5 -5 ...
##  $ Bi_ppm_MS_ST         : chr  "1,5" "3,6" "190" "0,4" ...
##  $ Cd_ppm_MS_ST         : chr  "3,6" "-0,2" "0,9" "-0,2" ...
##  $ Ce_ppm_MS_ST         : chr  "0,4" "8,8" "16,3" "3,5" ...
##  $ Co_ppm_MS_ST         : chr  "209" "-0,5" "1,3" "44,8" ...
##  $ Cr_ppm_AES_ST        : int  -10 -10 -10 30 20 20 60 40 20 10 ...
##  $ Cs_ppm_MS_ST         : chr  "0,5" "1,4" "0,2" "-0,1" ...
##  $ Cu_ppm_AES_ST        : chr  "50000,11111" "23300" "50000,11111" "50000,11111" ...
##  $ Dy_ppm_MS_ST         : chr  "-0,05" "0,32" "1,38" "0,37" ...
##  $ Er_ppm_MS_ST         : chr  "-0,05" "0,22" "0,77" "0,23" ...
##  $ Eu_ppm_MS_ST         : chr  "-0,05" "0,14" "0,17" "0,1" ...
##  $ Ga_ppm_MS_ST         : chr  "5" "15" "6" "3" ...
##  $ Gd_ppm_MS_ST         : chr  "-0,05" "0,45" "1,5" "0,39" ...
##  $ Ge_ppm_MS_ST         : int  -1 5 -1 -1 3 8 8 1 2 2 ...
##  $ Hf_ppm_MS_ST         : int  -1 4 -1 -1 5 13 12 2 3 6 ...
##  $ Ho_ppm_MS_ST         : chr  "-0,05" "0,07" "0,25" "0,07" ...
##  $ In_ppm_MS_ST         : chr  "6,4" "-0,2" "3,7" "0,2" ...
##  $ La_ppm_MS_ST         : chr  "0,2" "4,6" "7,2" "1,7" ...
##  $ Li_ppm_AES_ST        : int  -10 -10 -10 -10 30 20 20 20 -10 20 ...
##  $ Lu_ppm_MS_ST         : chr  "-0,05" "-0,05" "0,08" "-0,05" ...
##  $ Mo_ppm_MS_ST         : chr  "-2" "60" "3" "2" ...
##  $ Nb_ppm_MS_ST         : chr  "-1" "4" "-1" "-1" ...
##  $ Nd_ppm_MS_ST         : chr  "0,2" "3,8" "9,1" "1,7" ...
##  $ Ni_ppm_AES_ST        : chr  "144" "6" "-5" "48" ...
##  $ Pb_ppm_MS_ST         : chr  "23" "16" "188" "39" ...
##  $ Pd_ppm_FA_MS         : chr  "" "" "" "" ...
##  $ Pr_ppm_MS_ST         : chr  "-0,05" "1,09" "2,21" "0,46" ...
##  $ Pt_ppm_FA_MS         : chr  "" "" "" "" ...
##  $ Rb_ppm_MS_ST         : chr  "1,2" "148" "7,1" "0,7" ...
##  $ Re_ppm_MS_HF         : chr  "" "" "" "" ...
##  $ Sb_ppm_MS_ST         : chr  "1,2" "2,4" "2,9" "0,3" ...
##  $ Sc_ppm_AES_ST        : int  -5 -5 -5 -5 11 6 15 10 5 6 ...
##  $ Se_ppm_MS_ST         : int  NA NA NA NA NA NA NA NA NA NA ...
##  $ Sm_ppm_MS_ST         : chr  "-0,1" "0,6" "1,6" "0,4" ...
##  $ Sn_ppm_MS_ST         : chr  "2" "3" "106" "-1" ...
##  $ Sr_ppm_AES_ST        : chr  "26,6" "114" "22,5" "38,4" ...
##  $ Ta_ppm_MS_ST         : chr  "-0,5" "-0,5" "-0,5" "-0,5" ...
##  $ Tb_ppm_MS_ST         : chr  "-0,05" "0,07" "0,23" "-0,05" ...
##  $ Te_ppm_MS_ST         : chr  "" "" "" "" ...
##  $ Th_ppm_MS_ST         : chr  "0,2" "9,7" "2,6" "0,2" ...
##  $ Tl_ppm_MS_ST         : chr  "-0,5" "0,5" "-0,5" "-0,5" ...
##  $ Tm_ppm_MS_ST         : chr  "-0,05" "-0,05" "0,08" "-0,05" ...
##  $ U_ppm_MS_ST          : chr  "0,3" "1,75" "0,63" "34,8" ...
##  $ V_ppm_AES_ST         : int  51 24 -5 493 68 20 40 159 39 61 ...
##  $ W_ppm_MS_ST          : chr  "-1" "28" "22" "11" ...
##   [list output truncated]

Se cargaron correctamente los datos para el analisis inferencial de la variable Fe_pct_AES_ST mediante el modelo probabilistico log-normal.

# LIMPIEZA DE LA VARIABLE HIERRO

variable <- as.numeric(datos[[columna_variable]])
variable <- na.omit(variable)
variable <- subset(variable, variable > 0)

if (length(variable) == 0) {
  stop(paste("No existen datos validos positivos para", columna_variable, "despues de la limpieza."))
}

# SEPARAR OUTLIERS
caja <- boxplot(variable, plot = FALSE)

limite_sup <- caja$stats[5]
limite_inf <- caja$stats[1]

variable_outliers <- variable[variable < limite_inf | variable > limite_sup]
variable_sin_outliers <- variable[variable >= limite_inf & variable <= limite_sup]

if (length(variable_sin_outliers) == 0) {
  stop("No existen datos validos despues de separar outliers.")
}

# RESUMEN
cat("Cantidad con outliers:", length(variable), "\n")

## Cantidad con outliers: 57

cat("Cantidad de outliers:", length(variable_outliers), "\n")

## Cantidad de outliers: 1

cat("Cantidad sin outliers:", length(variable_sin_outliers), "\n")

## Cantidad sin outliers: 56

2. TABLA DE DISTRIBUCION DE CANTIDAD

# HISTOGRAMA (BASE DE LA TABLA)
histograma_frecuencias <- hist(
  variable_sin_outliers,
  breaks = breaks_histograma,
  plot = FALSE
)

# FRECUENCIA ABSOLUTA
ni <- histograma_frecuencias$counts

# FRECUENCIA RELATIVA PORCENTUAL
hi <- ni / sum(ni) * 100

# INTERVALOS
intervalos <- paste0(
  "[",
  round(histograma_frecuencias$breaks[-length(histograma_frecuencias$breaks)], 2),
  ", ",
  round(histograma_frecuencias$breaks[-1], 2),
  ")"
)

# TABLA
tabla_frecuencias <- data.frame(
  Intervalo = intervalos,
  ni = ni,
  hi = round(hi, 2)
)

fila_total <- data.frame(
  Intervalo = "TOTAL",
  ni = sum(tabla_frecuencias$ni),
  hi = round(sum(tabla_frecuencias$hi), 2)
)

tabla_frecuencias <- rbind(tabla_frecuencias, fila_total)

tabla_variable_gt <- tabla_frecuencias %>%
  gt() %>%
  fmt_number(
    columns = hi,
    decimals = 2
  ) %>%
  cols_label(
    Intervalo = "Intervalo",
    ni = "Frecuencia absoluta (ni)",
    hi = "Frecuencia relativa (%)"
  ) %>%
  tab_header(
    title = md("**Tabla N. 1**"),
    subtitle = md(paste0("**Distribucion de frecuencias de muestras que contienen ", nombre_variable, "**"))
  ) %>%
  tab_source_note(
    source_note = md(autor_tablas)
  ) %>%
  tab_options(
    table.border.top.color = "black",
    table.border.bottom.color = "black",
    heading.border.bottom.color = "black",
    heading.border.bottom.width = px(2),
    column_labels.border.top.color = "black",
    column_labels.border.bottom.color = "black",
    column_labels.border.bottom.width = px(2),
    table_body.hlines.color = "gray",
    table_body.border.bottom.color = "black",
    row.striping.include_table_body = TRUE
  )

tabla_variable_gt

Tabla N. 1
Distribucion de frecuencias de muestras que contienen Hierro
Intervalo	Frecuencia absoluta (ni)	Frecuencia relativa (%)
[0, 10)	11	19.64
[10, 20)	17	30.36
[20, 30)	13	23.21
[30, 40)	4	7.14
[40, 50)	8	14.29
[50, 60)	3	5.36
TOTAL	56	100.00
Autor: Grupo 1

3. GRAFICA DE DISTRIBUCION DE CANTIDAD

histograma <- hist(
  variable_sin_outliers,
  breaks = breaks_histograma,
  freq = TRUE,
  main = paste0("Grafica 1. Distribucion de cantidad de ", nombre_variable, " en minas archivadas"),
  xlab = paste0(nombre_variable, " (", unidad_variable, ")"),
  ylab = "Cantidad",
  col = "lightblue",
  border = "black"
)

4. CONJETURA DEL MODELO

# ==========================================
# CONJETURA DEL MODELO LOG-NORMAL
# ==========================================

# PARAMETROS DEL MODELO LOG-NORMAL
log_variable <- log(variable_sin_outliers)
media_log <- mean(log_variable)
desviacion_log <- sd(log_variable)

# Medidas descriptivas en la escala original.
media <- mean(variable_sin_outliers)
desviacion <- sd(variable_sin_outliers)
media_lognormal <- exp(media_log + (desviacion_log^2 / 2))
mediana_lognormal <- exp(media_log)

# MOSTRAR VALORES
cat("Media aritmetica:", round(media, 2), "\n")

## Media aritmetica: 23.71

cat("Desviacion estandar:", round(desviacion, 4), "\n")

## Desviacion estandar: 15.8467

cat("Media logaritmica (meanlog):", round(media_log, 4), "\n")

## Media logaritmica (meanlog): 2.8259

cat("Desviacion logaritmica (sdlog):", round(desviacion_log, 4), "\n")

## Desviacion logaritmica (sdlog): 1.0006

cat("Media estimada log-normal:", round(media_lognormal, 2), "\n")

## Media estimada log-normal: 27.84

cat("Mediana estimada log-normal:", round(mediana_lognormal, 2), "\n\n")

## Mediana estimada log-normal: 16.88

# PREPARAR HISTOGRAMA Y CURVA LOG-NORMAL
breaks_variable <- pretty(variable_sin_outliers, n = breaks_histograma)

x_modelo <- seq(
  min(variable_sin_outliers),
  max(variable_sin_outliers),
  length.out = 500
)

y_lognormal <- dlnorm(
  x_modelo,
  meanlog = media_log,
  sdlog = desviacion_log
)

hist_previo <- hist(
  variable_sin_outliers,
  breaks = breaks_variable,
  plot = FALSE
)

limite_y <- max(
  c(hist_previo$density, y_lognormal),
  na.rm = TRUE
) * 1.15

par(mar = c(5, 5, 4, 2) + 0.1)

# Histograma con densidad.
histograma_modelo <- hist(
  variable_sin_outliers,
  breaks = breaks_variable,
  freq = FALSE,
  main = paste0(
    "Grafica 2. Comparacion de la realidad con el modelo log-normal de\n",
    nombre_variable,
    " en minas archivadas"
  ),
  xlab = paste0(nombre_variable, " (", unidad_variable, ")"),
  ylab = "Densidad de probabilidad",
  col = "lightblue",
  border = "black",
  xlim = c(min(breaks_variable), max(breaks_variable)),
  ylim = c(0, limite_y),
  las = 1
)

# CURVA LOG-NORMAL SUPERPUESTA
lines(
  x_modelo,
  y_lognormal,
  col = "black",
  lwd = 3
)

# ==========================================
# CALCULO DE FRECUENCIAS (Fo y Fe)
# ==========================================

# FRECUENCIAS OBSERVADAS (Realidad)
Fo_abs <- histograma_modelo$counts

# FRECUENCIAS ESPERADAS (Modelo teorico log-normal)
h <- length(histograma_modelo$counts)
P <- numeric(h)

for (i in 1:h) {
  P[i] <- plnorm(histograma_modelo$breaks[i + 1], meanlog = media_log, sdlog = desviacion_log) -
    plnorm(histograma_modelo$breaks[i], meanlog = media_log, sdlog = desviacion_log)
}

Fe_abs <- P * length(variable_sin_outliers)

# MOSTRAR RESULTADOS EN CONSOLA
cat("Frecuencias observadas (Fo):\n")

## Frecuencias observadas (Fo):

print(Fo_abs)

## [1] 11 17 13  4  8  3

cat("\nFrecuencias esperadas (Fe):\n")

## 
## Frecuencias esperadas (Fe):

print(round(Fe_abs, 2))

## [1] 16.83 14.95  8.40  4.95  3.10  2.04

5. TEST DE APROBACION

# =========================
# TEST DE PEARSON
# =========================

n <- length(variable_sin_outliers)

# Convertir a porcentajes para la grafica de correlacion.
Fo <- (Fo_abs / n) * 100
Fe <- (Fe_abs / n) * 100

plot(
  Fo,
  Fe,
  main = paste0("Grafica 3. Correlacion de frecuencias en el modelo log-normal (", nombre_variable, ")"),
  xlab = "Frecuencia Observada (%)",
  ylab = "Frecuencia Esperada (%)",
  pch = 19,
  col = "forestgreen"
)

abline(a = 0, b = 1, col = "red", lwd = 2)

correlacion <- cor(Fo, Fe) * 100

# =========================
# TEST DE CHI-CUADRADO
# =========================

# Para log-normal se estiman dos parametros: meanlog y sdlog.
gl <- length(histograma_modelo$counts) - 1 - 2
gl <- max(gl, 1)

indices_validos <- Fe_abs > 0
x2 <- sum((Fo_abs[indices_validos] - Fe_abs[indices_validos])^2 / Fe_abs[indices_validos])

umbral <- qchisq(nivel_aceptacion_modelo, gl)

decision <- "Se acepta el modelo log-normal con umbral de aceptacion del 75%"

# =========================
# TABLA RESUMEN
# =========================

tabla_resumen <- data.frame(
  Variable = paste0(nombre_variable, " (", unidad_variable, ")"),
  `Test Pearson (%)` = round(correlacion, 2),
  `Chi Cuadrado` = round(x2, 2),
  `Nivel de aceptacion (%)` = nivel_aceptacion_modelo * 100,
  `Umbral de aceptacion` = round(umbral, 2),
  Decision = decision,
  check.names = FALSE
)

tabla_resumen_gt <- tabla_resumen %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N. 2**"),
    subtitle = md(paste0("**Resultados de las pruebas de bondad de ajuste log-normal para el ", nombre_variable, "**"))
  ) %>%
  tab_source_note(
    source_note = md(autor_tablas)
  ) %>%
  tab_options(
    table.border.top.color = "black",
    table.border.bottom.color = "black",
    heading.border.bottom.color = "black",
    heading.border.bottom.width = px(2),
    column_labels.border.top.color = "black",
    column_labels.border.bottom.color = "black",
    column_labels.border.bottom.width = px(2),
    table_body.border.bottom.color = "black"
  )

tabla_resumen_gt

Tabla N. 2
Resultados de las pruebas de bondad de ajuste log-normal para el Hierro
Variable	Test Pearson (%)	Chi Cuadrado	Nivel de aceptacion (%)	Umbral de aceptacion	Decision
Hierro (%)	77.34	13.21	75	4.11	Se acepta el modelo log-normal con umbral de aceptacion del 75%
Autor: Grupo 1

6. ESTIMACION DE PROBABILIDADES

Cual es la probabilidad de que una muestra aleatoria presente una concentracion de hierro menor o igual a la mediana estimada del modelo log-normal?

# ==========================================
# CALCULO DE PROBABILIDADES
# ==========================================

probabilidad_mediana <- plnorm(
  mediana_lognormal,
  meanlog = media_log,
  sdlog = desviacion_log
)

cat("Probabilidad:", round(probabilidad_mediana * 100, 2), "%\n")

## Probabilidad: 50 %

# =========================
# GRAFICA DE PROBABILIDAD
# =========================

x_prob <- seq(
  min(variable_sin_outliers),
  max(variable_sin_outliers),
  length.out = 300
)

plot(
  x_prob,
  dlnorm(x_prob, meanlog = media_log, sdlog = desviacion_log),
  col = "black",
  lwd = 2,
  type = "l",
  main = paste0(
    "Grafica 4. Calculo de probabilidades del contenido de ",
    nombre_variable,
    "\nP(X <= mediana log-normal)"
  ),
  ylab = "Densidad de probabilidad",
  xlab = paste0(nombre_variable, " (", unidad_variable, ")")
)

x_area <- seq(
  min(variable_sin_outliers),
  mediana_lognormal,
  length.out = 150
)

y_area <- dlnorm(x_area, meanlog = media_log, sdlog = desviacion_log)

lines(x_area, y_area, col = "red", lwd = 2)

polygon(
  c(x_area, rev(x_area)),
  c(y_area, rep(0, length(y_area))),
  col = rgb(1, 0, 0, 0.5),
  border = NA
)

legend(
  "topright",
  legend = c("Modelo log-normal", "Area de probabilidad"),
  col = c("black", rgb(1, 0, 0, 0.5)),
  lwd = c(2, 8),
  cex = 0.8
)

texto_prob <- paste0("Probabilidad = ", round(probabilidad_mediana * 100, 2), " %")

text(
  x = mediana_lognormal,
  y = max(dlnorm(x_prob, meanlog = media_log, sdlog = desviacion_log)) * 0.5,
  labels = texto_prob,
  col = "black",
  cex = 1,
  font = 2
)

Si se analizan los registros de 50 nuevas minas archivadas, cuantas se esperaria que presenten un contenido de hierro entre el primer cuartil y el tercer cuartil del modelo log-normal?

# ==========================================
# PROBABILIDAD ENTRE Q1 Y Q3 DEL MODELO LOG-NORMAL
# ==========================================

limite_prob_inf <- qlnorm(probabilidad_inferior, meanlog = media_log, sdlog = desviacion_log)
limite_prob_sup <- qlnorm(probabilidad_superior, meanlog = media_log, sdlog = desviacion_log)

probabilidad_cuartiles <- plnorm(limite_prob_sup, meanlog = media_log, sdlog = desviacion_log) -
  plnorm(limite_prob_inf, meanlog = media_log, sdlog = desviacion_log)

# Cantidad esperada en nuevas minas archivadas.
minas_esperadas <- probabilidad_cuartiles * n_nuevas_minas

# Mostrar resultados.
cat("Limite inferior Q1:", round(limite_prob_inf, 2), "\n")

## Limite inferior Q1: 8.59

cat("Limite superior Q3:", round(limite_prob_sup, 2), "\n")

## Limite superior Q3: 33.14

cat("Probabilidad:", round(probabilidad_cuartiles * 100, 2), "%\n")

## Probabilidad: 50 %

cat("Cantidad de minas esperadas:", round(minas_esperadas), "\n")

## Cantidad de minas esperadas: 25

7. INTERVALOS DE CONFIANZA

# ==========================================
# INTERVALOS DE CONFIANZA - MODELO LOG-NORMAL
# ==========================================

# CALCULOS EN ESCALA LOGARITMICA
media_log_ic <- mean(log_variable)
sigma_log_ic <- sd(log_variable)
n <- length(variable_sin_outliers)

# Error estandar de la media logaritmica.
error_estandar_log <- sigma_log_ic / sqrt(n)

# Calculo de los limites usando el nivel de confianza definido.
z <- qnorm(1 - (1 - nivel_confianza_ic) / 2)
li_log <- media_log_ic - z * error_estandar_log
ls_log <- media_log_ic + z * error_estandar_log

# Transformacion a la escala original.
li <- exp(li_log)
ls <- exp(ls_log)
media_geo <- exp(media_log_ic)

# MOSTRAR VALORES EN CONSOLA
cat("Media logaritmica:", round(media_log_ic, 4), "\n")

## Media logaritmica: 2.8259

cat("Desviacion estandar logaritmica:", round(sigma_log_ic, 4), "\n")

## Desviacion estandar logaritmica: 1.0006

cat("Tamano muestral:", n, "\n")

## Tamano muestral: 56

cat("Error estandar logaritmico:", round(error_estandar_log, 4), "\n")

## Error estandar logaritmico: 0.1337

cat("Media geometrica:", round(media_geo, 2), "\n")

## Media geometrica: 16.88

cat("Limite inferior:", round(li, 2), "\n")

## Limite inferior: 13.78

cat("Limite superior:", round(ls, 2), "\n")

## Limite superior: 20.66

# =========================
# TABLA PROFESIONAL
# =========================

tabla_intervalo <- data.frame(
  `Limite inferior` = round(li, 2),
  `Media geometrica` = round(media_geo, 2),
  `Limite superior` = round(ls, 2),
  `Error estandar logaritmico` = round(error_estandar_log, 4),
  check.names = FALSE
)

tabla_intervalo_gt <- tabla_intervalo %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N. 3**"),
    subtitle = md(paste0("**Intervalo de confianza log-normal del contenido de ", nombre_variable, " (", unidad_variable, ") en minas archivadas**"))
  ) %>%
  tab_source_note(
    source_note = md(autor_tablas)
  ) %>%
  tab_options(
    table.border.top.color = "black",
    table.border.bottom.color = "black",
    heading.border.bottom.color = "black",
    heading.border.bottom.width = px(2),
    column_labels.border.top.color = "black",
    column_labels.border.bottom.color = "black",
    column_labels.border.bottom.width = px(2),
    table_body.hlines.color = "gray",
    table_body.border.bottom.color = "black",
    row.striping.include_table_body = TRUE
  )

tabla_intervalo_gt

Tabla N. 3
Intervalo de confianza log-normal del contenido de Hierro (%) en minas archivadas
Limite inferior	Media geometrica	Limite superior	Error estandar logaritmico
13.78	16.88	20.66	0.1337
Autor: Grupo 1

8. CONCLUSION

La variable de Hierro se analiza mediante la distribucion log-normal, utilizando como parametros principales la media logaritmica (meanlog) y la desviacion estandar logaritmica (sdlog) calculadas a partir de los datos validos sin valores atipicos.

La conjetura del modelo compara la distribucion real observada con la curva log-normal teorica. Esta comparacion permite observar si las concentraciones de hierro presentan una distribucion positiva y asimetrica hacia la derecha, comportamiento caracteristico del modelo log-normal.

Mediante el modelo log-normal se calcularon probabilidades asociadas al contenido de hierro, como la probabilidad de que una muestra se encuentre por debajo de la mediana estimada y la cantidad esperada de registros ubicados entre el primer y tercer cuartil del modelo.

Finalmente, el intervalo de confianza permite estimar el rango probable de la media geometrica poblacional del contenido de hierro con un 87% de confianza. Para la aprobacion del modelo se usa un nivel de aceptacion del 75%.