1. CARGA DE DATOS Y LIBRERIAS

CARGA DE DATOS Y LIBRERIAS

knitr::opts_chunk$set(
    echo = TRUE,                   # Muestra el código R en el reporte final.
    message = FALSE,
    warning = FALSE,               # Message y warning evitan que se impriman alertas o mensajes de carga estorbosos en el HTML.
    fig.align = "center"           # Centra automáticamente todas las gráficas generadas.
)

datos <- read.csv("C:/Users/USER/Documents/PROYECTO ESTADISTICA/CMDB_Data.csv", 
                  header = TRUE, # Indica que la primera fila contienen los nombres de las variables.
                  sep = ";",     # Define que los puntos y comas es el separador de las columnas del archivo.
                  dec = ".",     # Establece el punto como el operador decimal para los números.
                  fileEncoding = "latin1")

# Verificación 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" ...
##  $ DATE_SUBMITTED       : 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" "Exact" "" "" ...
##  $ 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]
# Cargar las librerías necesarias
library(dplyr)
## 
## Adjuntando el paquete: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(gt)
library(e1071) # Necesaria para Asimetría y Curtosis

Se cargaron correctamente los datos de todas las variables

2. ANÁLISIS DE FRECUENCIAS: CONCENTRACIÓN DE BISMUTO (Bi_ppm_MS_ST)

CONCENTRACIÓN DE BISMUTO (Bi_ppm_MS_ST)

#----------------------- PROCESAMIENTO Y LIMPIEZA TOTAL -----------------------
# Conversión estricta a numérico
datos$Bi_ppm_MS_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Bi_ppm_MS_ST))))

# EL FILTRO DEFINITIVO: Solo tomamos datos entre 0.1 y 63.50 ppm (Rango exacto de Sturges)
bi_numerico <- datos$Bi_ppm_MS_ST[!is.na(datos$Bi_ppm_MS_ST) & datos$Bi_ppm_MS_ST >= 0.1 & datos$Bi_ppm_MS_ST <= 63.5]

# Conteo de exclusiones: Agrupamos los NAs, los menores a 0.1 y LOS ATÍPICOS MAYORES A 63.5
n_sin_datos_bi <- sum(is.na(datos$Bi_ppm_MS_ST) | datos$Bi_ppm_MS_ST < 0.1 | datos$Bi_ppm_MS_ST > 63.5)

#----------------------- MATRIZ DE FRECUENCIAS BASE -----------------------
TDF_VALIDOS_BI <- as.data.frame(table(bi_numerico), stringsAsFactors = FALSE)
colnames(TDF_VALIDOS_BI) <- c("CATEGORIA", "ni")

TDF_VALIDOS_BI$CATEGORIA <- as.numeric(TDF_VALIDOS_BI$CATEGORIA)
TDF_VALIDOS_BI <- TDF_VALIDOS_BI[order(TDF_VALIDOS_BI$CATEGORIA), ]

# Totales absolutos garantizados para el balance
total_variable_bi <- sum(TDF_VALIDOS_BI$ni) 
total_general_bi <- total_variable_bi + n_sin_datos_bi # Se mantiene en 1366

#----------------------- AGRUPACIÓN TOP 10 -----------------------
if(nrow(TDF_VALIDOS_BI) > 10) {
  tabla_top_bi <- head(TDF_VALIDOS_BI, 10)
  sum_otros_bi <- sum(TDF_VALIDOS_BI$ni[11:nrow(TDF_VALIDOS_BI)])
  fila_otros_bi <- data.frame(CATEGORIA = "Otras Concentraciones", ni = sum_otros_bi)
  tabla_final_base_bi <- rbind(tabla_top_bi, fila_otros_bi)
} else {
  tabla_final_base_bi <- TDF_VALIDOS_BI
}

tabla_final_base_bi$CATEGORIA <- as.character(tabla_final_base_bi$CATEGORIA)

#----------------------- CÁLCULO DE PORCENTAJES (hi) -----------------------
tabla_final_base_bi$hi <- round((tabla_final_base_bi$ni / total_general_bi) * 100, 4)

#----------------------- CONSTRUCCIÓN DE FILAS DE BALANCE -----------------------

fila_total_var_bi <- data.frame(
  CATEGORIA = "TOTAL VARIABLE (Bi)", 
  ni = total_variable_bi,
  hi = round((total_variable_bi / total_general_bi) * 100, 4)
)

# Fila Sin Datos (ahora incluye los 200 atípicos excluidos)
fila_sin_datos_bi <- data.frame(
  CATEGORIA = "Sin Datos", 
  ni = n_sin_datos_bi,
  hi = round((n_sin_datos_bi / total_general_bi) * 100, 4)
)

# Fila Total General Absoluto
fila_total_general_bi <- data.frame(
  CATEGORIA = "TOTAL GENERAL", 
  ni = total_general_bi,
  hi = 100.0000
)

#----------------------- ENSAMBLE DE MATRIZ FINAL -----------------------
tabla_final_bi <- rbind(tabla_final_base_bi, fila_total_var_bi, fila_sin_datos_bi, fila_total_general_bi)
colnames(tabla_final_bi) <- c("Valor Bi (ppm)", "ni", "hi")

#----------------------- SALIDA ESTÉTICA CON GT -----------------------
tabla_bismuto_fija_gt <- tabla_final_bi %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N° 1**"),
    subtitle = md("Distribución de frecuencias para concentraciones de Bismuto (Bi) <br> *(Sin atípicos > 63.50 ppm)*")
  ) %>%
  tab_source_note(
    source_note = md("Autores: Grupo 1 <br> Semestre 2026 - 2026")
  ) %>%
  cols_label(
    `Valor Bi (ppm)` = "Valor Bi (ppm)",
    ni = "n (abs)",
    hi = "hi (%)"
  ) %>%
  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_bismuto_fija_gt
Tabla N° 1
Distribución de frecuencias para concentraciones de Bismuto (Bi)
(Sin atípicos > 63.50 ppm)
Valor Bi (ppm) n (abs) hi (%)
0.1 63 4.6120
0.2 94 6.8814
0.3 61 4.4656
0.4 46 3.3675
0.5 45 3.2943
0.6 40 2.9283
0.7 25 1.8302
0.8 27 1.9766
0.9 18 1.3177
1 20 1.4641
Otras Concentraciones 494 36.1640
TOTAL VARIABLE (Bi) 933 68.3016
Sin Datos 433 31.6984
TOTAL GENERAL 1366 100.0000
Autores: Grupo 1
Semestre 2026 - 2026

3. ANÁLISIS DESCRIPTIVO Y AGRUPACIÓN EN CLASES (STRUGES) DE BISMUTO

ANÁLISIS DESCRIPTIVO Y AGRUPACIÓN EN CLASES (STRUGES) DE BISMUTO

#------------------------- PREPARACIÓN DE DATOS -------------------------
# Conversión a numérico (reemplazando comas por puntos y manejando advertencias)
datos$Bi_ppm_MS_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Bi_ppm_MS_ST))))

# Creamos la variable de trabajo asegurando que los datos estén limpios desde el inicio
Bi_VAR <- datos$Bi_ppm_MS_ST[!is.na(datos$Bi_ppm_MS_ST) & datos$Bi_ppm_MS_ST >= 0 & datos$Bi_ppm_MS_ST <= 65]
Bi_Limpio <- Bi_VAR

#------------------------- ANÁLISIS DE CONCENTRACIÓN (ESTADÍSTICOS) -------------------------
cat("\n=======================================================\n")
## 
## =======================================================
cat("ANÁLISIS DE CONCENTRACIÓN (Bi_ppm_MS_ST):\n")
## ANÁLISIS DE CONCENTRACIÓN (Bi_ppm_MS_ST):
cat("La concentración promedio es: ", round(mean(Bi_VAR, na.rm = TRUE), 2), " ppm \n")
## La concentración promedio es:  6.46  ppm
cat("La concentración máxima detectada es: ", max(Bi_VAR, na.rm = TRUE), " ppm \n")
## La concentración máxima detectada es:  63.5  ppm
cat("Total de muestras analizadas: ", sum(!is.na(Bi_VAR)), " registros \n")
## Total de muestras analizadas:  933  registros
cat("=======================================================\n")
## =======================================================
#------------------------- TABLA DE FRECUENCIAS - STURGES -------------------------
# 1. Parámetros básicos: Rango, Número de clases (Sturges) y Amplitud
R <- max(Bi_Limpio) - min(Bi_Limpio)
k <- floor(1 + 3.322 * log10(length(Bi_Limpio)))
A <- R / k

# 2. Definición de límites y Marcas de Clase (MC)
liminf <- seq(from = min(Bi_Limpio), by = A, length.out = k)
limsup <- liminf + A
MC <- (liminf + limsup) / 2

# 3. Conteo de frecuencias por clase (n)
n <- numeric(k)
for (i in 1:k) {
  if (i == k) {
    n[i] <- sum(Bi_VAR >= liminf[i] & Bi_VAR <= limsup[i], na.rm = TRUE)
  } else {
    n[i] <- sum(Bi_VAR >= liminf[i] & Bi_VAR < limsup[i], na.rm = TRUE)
  }
}

# 4. Cálculos de frecuencias relativas y acumuladas
hi <- (n / sum(n)) * 100
Ni_asc <- cumsum(n)             # Frecuencia absoluta acumulada (ascendente)
Hi_asc <- cumsum(hi)            # Frecuencia relativa acumulada (ascendente)
Ni_desc <- rev(cumsum(rev(n)))  # Frecuencia absoluta acumulada (descendente)
Hi_desc <- rev(cumsum(rev(hi))) # Frecuencia relativa acumulada (descendente)

#------------------------- CONSTRUCCIÓN DE LA TABLA -------------------------
TablaBi_Sturges <- data.frame(
  Clase = as.character(1:k), # Se convierte a carácter para poder añadir "**TOTALES**" luego
  liminf = round(liminf, 3),
  limsup = round(limsup, 3),
  MC = round(MC, 3),
  n = n,
  hi = round(hi, 2),
  Ni_asc = Ni_asc,
  Hi_asc = round(Hi_asc, 2),
  Ni_desc = Ni_desc,
  Hi_desc = round(Hi_desc, 2)
)

# Fila de TOTALES para cierre de tabla y balance formal
fila_totales_Bi <- data.frame(
  Clase = "**TOTALES**",
  liminf = NA,
  limsup = NA,
  MC = NA,
  n = sum(n),
  hi = 100,
  Ni_asc = NA,
  Hi_asc = 100,
  Ni_desc = NA,
  Hi_desc = 100
)

# Unión de cuerpo y total
TablaBi_Final <- rbind(TablaBi_Sturges, fila_totales_Bi)

#------------------------- MOSTRAR TABLA FINAL CON 'gt' -------------------------
tabla_sturges_bi_gt <- TablaBi_Final %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N° 2**"),
    subtitle = md("Distribución de frecuencias para concentraciones de Bismuto (Bi) <br> mediante Regla de Sturges")
  ) %>%
  tab_source_note(
    source_note = md("Autores: Grupo 1 <br> Semestre 2026 - 2026")
  ) %>%
  fmt_markdown(columns = Clase) %>% # Asegura que "**TOTALES**" se renderice en negrita
  cols_label(
    Clase = "Clase",
    liminf = "Linf (ppm)",
    limsup = "Lsup (ppm)",
    MC = "MC (ppm)",
    n = "n (abs)",
    hi = "hi (%)",
    Ni_asc = "Ni (↑)",
    Hi_asc = "Hi (↑)",
    Ni_desc = "Ni (↓)",
    Hi_desc = "Hi (↓)"
  ) %>%
  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
  ) %>%
  sub_missing(
    columns = everything(),
    missing_text = "NA"
  )

# Renderizar la tabla en el reporte
tabla_sturges_bi_gt
Tabla N° 2
Distribución de frecuencias para concentraciones de Bismuto (Bi)
mediante Regla de Sturges
Clase Linf (ppm) Lsup (ppm) MC (ppm) n (abs) hi (%) Ni (↑) Hi (↑) Ni (↓) Hi (↓)
1 0.10 6.44 3.27 706 75.67 706 75.67 933 100.00
2 6.44 12.78 9.61 83 8.90 789 84.57 227 24.33
3 12.78 19.12 15.95 43 4.61 832 89.17 144 15.43
4 19.12 25.46 22.29 21 2.25 853 91.43 101 10.83
5 25.46 31.80 28.63 22 2.36 875 93.78 80 8.57
6 31.80 38.14 34.97 16 1.71 891 95.50 58 6.22
7 38.14 44.48 41.31 15 1.61 906 97.11 42 4.50
8 44.48 50.82 47.65 10 1.07 916 98.18 27 2.89
9 50.82 57.16 53.99 7 0.75 923 98.93 17 1.82
10 57.16 63.50 60.33 10 1.07 933 100.00 10 1.07
TOTALES NA NA NA 933 100.00 NA 100.00 NA 100.00
Autores: Grupo 1
Semestre 2026 - 2026

3.1 TABLA SIMPLIFICADA

#------------------------- PREPARACIÓN DE DATOS -------------------------
# Conversión a numérico (reemplazando comas por puntos y manejando advertencias)
datos$Bi_ppm_MS_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Bi_ppm_MS_ST))))

# Creamos la variable de trabajo asegurando que los datos estén limpios desde el inicio
Bi_VAR <- datos$Bi_ppm_MS_ST[!is.na(datos$Bi_ppm_MS_ST) & datos$Bi_ppm_MS_ST >= 0 & datos$Bi_ppm_MS_ST <= 65]
Bi_Limpio <- Bi_VAR

#------------------------- ANÁLISIS DE CONCENTRACIÓN (ESTADÍSTICOS) -------------------------
cat("\n=======================================================\n")
## 
## =======================================================
cat("ANÁLISIS DE CONCENTRACIÓN (Bi_ppm_MS_ST):\n")
## ANÁLISIS DE CONCENTRACIÓN (Bi_ppm_MS_ST):
cat("La concentración promedio es: ", round(mean(Bi_VAR, na.rm = TRUE), 0), " ppm \n") # Redondeado a 0
## La concentración promedio es:  6  ppm
cat("La concentración máxima detectada es: ", round(max(Bi_VAR, na.rm = TRUE), 0), " ppm \n") # Redondeado a 0
## La concentración máxima detectada es:  64  ppm
cat("Total de muestras analizadas: ", sum(!is.na(Bi_VAR)), " registros \n")
## Total de muestras analizadas:  933  registros
cat("=======================================================\n")
## =======================================================
#------------------------- TABLA DE FRECUENCIAS - STURGES -------------------------
# 1. Parámetros básicos: Rango, Número de clases (Sturges) y Amplitud
R <- max(Bi_Limpio) - min(Bi_Limpio)
k <- floor(1 + 3.322 * log10(length(Bi_Limpio)))
A <- R / k

# 2. Definición de límites y Marcas de Clase (MC)
liminf <- seq(from = min(Bi_Limpio), by = A, length.out = k)
limsup <- liminf + A
MC <- (liminf + limsup) / 2

# 3. Conteo de frecuencias por clase (n)
n <- numeric(k)
for (i in 1:k) {
  if (i == k) {
    n[i] <- sum(Bi_VAR >= liminf[i] & Bi_VAR <= limsup[i], na.rm = TRUE)
  } else {
    n[i] <- sum(Bi_VAR >= liminf[i] & Bi_VAR < limsup[i], na.rm = TRUE)
  }
}

# 4. Cálculos de frecuencias relativas y acumuladas
hi <- (n / sum(n)) * 100
Ni_asc <- cumsum(n)             # Frecuencia absoluta acumulada (ascendente)
Hi_asc <- cumsum(hi)            # Frecuencia relativa acumulada (ascendente)
Ni_desc <- rev(cumsum(rev(n)))  # Frecuencia absoluta acumulada (descendente)
Hi_desc <- rev(cumsum(rev(hi))) # Frecuencia relativa acumulada (descendente)

#------------------------- CONSTRUCCIÓN DE LA TABLA -------------------------
TablaBi_Sturges <- data.frame(
  Clase = as.character(1:k), # Se convierte a carácter para poder añadir "**TOTALES**" luego
  liminf = round(liminf, 0), # Sin decimales
  limsup = round(limsup, 0), # Sin decimales
  MC = round(MC, 0),         # Sin decimales
  n = n,
  hi = round(hi, 0),         # Sin decimales
  Ni_asc = Ni_asc,
  Hi_asc = round(Hi_asc, 0), # Sin decimales
  Ni_desc = Ni_desc,
  Hi_desc = round(Hi_desc, 0) # Sin decimales
)

# Fila de TOTALES para cierre de tabla y balance formal
fila_totales_Bi <- data.frame(
  Clase = "**TOTALES**",
  liminf = NA,
  limsup = NA,
  MC = NA,
  n = sum(n),
  hi = 100,
  Ni_asc = NA,
  Hi_asc = 100,
  Ni_desc = NA,
  Hi_desc = 100
)

# Unión de cuerpo y total
TablaBi_Final <- rbind(TablaBi_Sturges, fila_totales_Bi)

#------------------------- MOSTRAR TABLA FINAL CON 'gt' -------------------------
tabla_sturges_bi_gt <- TablaBi_Final %>%
  gt() %>%
  tab_header(
    title = md("**Tabla N° 3**"),
    subtitle = md("Distribución de frecuencias para concentraciones de Bismuto (Bi) <br> mediante Regla de Sturges")
  ) %>%
  tab_source_note(
    source_note = md("Autores: Grupo 1 <br> Semestre 2026 - 2026")
  ) %>%
  fmt_markdown(columns = Clase) %>% # Asegura que "**TOTALES**" se renderice en negrita
  fmt_number(
    columns = c(liminf, limsup, MC, n, hi, Ni_asc, Hi_asc, Ni_desc, Hi_desc),
    decimals = 0 # Fuerza a la tabla de gt a no mostrar ningún decimal
  ) %>%
  cols_label(
    Clase = "Clase",
    liminf = "Linf (ppm)",
    limsup = "Lsup (ppm)",
    MC = "MC (ppm)",
    n = "n (abs)",
    hi = "hi (%)",
    Ni_asc = "Ni (↑)",
    Hi_asc = "Hi (↑)",
    Ni_desc = "Ni (↓)",
    Hi_desc = "Hi (↓)"
  ) %>%
  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
  ) %>%
  sub_missing(
    columns = everything(),
    missing_text = "NA"
  )

# Renderizar la tabla en el reporte
tabla_sturges_bi_gt
Tabla N° 3
Distribución de frecuencias para concentraciones de Bismuto (Bi)
mediante Regla de Sturges
Clase Linf (ppm) Lsup (ppm) MC (ppm) n (abs) hi (%) Ni (↑) Hi (↑) Ni (↓) Hi (↓)
1 0 6 3 706 76 706 76 933 100
2 6 13 10 83 9 789 85 227 24
3 13 19 16 43 5 832 89 144 15
4 19 25 22 21 2 853 91 101 11
5 25 32 29 22 2 875 94 80 9
6 32 38 35 16 2 891 95 58 6
7 38 44 41 15 2 906 97 42 5
8 44 51 48 10 1 916 98 27 3
9 51 57 54 7 1 923 99 17 2
10 57 64 60 10 1 933 100 10 1
TOTALES NA NA NA 933 100 NA 100 NA 100
Autores: Grupo 1
Semestre 2026 - 2026

4. POLÍGONO DE FRECUENCIA

POLÍGONO DE FRECUENCIAS ABSOLUTAS DEL BISMUTO (Bi)

#----------------------- PROCESAMIENTO AUTOMÁTICO Bi_ppm_MS_ST -----------------------
# 1. Conversión de la variable a numérico y limpieza de datos (Bismuto)
datos$Bi_ppm_MS_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Bi_ppm_MS_ST))))

# Excluimos NAs y limitamos al rango exacto de la tabla 
BI_VALIDO <- datos$Bi_ppm_MS_ST[!is.na(datos$Bi_ppm_MS_ST) & datos$Bi_ppm_MS_ST >= 0.1 & datos$Bi_ppm_MS_ST <= 63.5]

#----------------------- EXTRACCIÓN AUTOMÁTICA DE PARÁMETROS -----------------------
# 2. Replicamos las ecuaciones exactas de tu Tabla N° 2
R_bi <- max(BI_VALIDO) - min(BI_VALIDO)
k_bi <- floor(1 + 3.322 * log10(length(BI_VALIDO)))
A_bi <- R_bi / k_bi

# 3. Re-calculamos los límites e intervalos exactos
liminf_bi <- seq(from = min(BI_VALIDO), by = A_bi, length.out = k_bi)
limsup_bi <- liminf_bi + A_bi

# AUTOMATIZACIÓN 1: Cálculo de las Marcas de Clase (MC) reales SIN DECIMALES
mc_reales_bi <- round((liminf_bi + limsup_bi) / 2, 0)

# AUTOMATIZACIÓN 2: Conteo iterativo automático por clases (para el ni)
n_vector <- numeric(k_bi)
for (i in 1:k_bi) {
  if (i == k_bi) {
    n_vector[i] <- sum(BI_VALIDO >= liminf_bi[i] & BI_VALIDO <= limsup_bi[i])
  } else {
    n_vector[i] <- sum(BI_VALIDO >= liminf_bi[i] & BI_VALIDO < limsup_bi[i])
  }
}

# AUTOMATIZACIÓN 3: Cálculo funcional de la frecuencia relativa (hi %)
hi_porcentaje_bi <- (n_vector / sum(n_vector)) * 100

#----------------------- ANCLAJE A CERO CON MARCAS DE CLASE -----------------------
# 4. Creamos los extremos ficticios para el anclaje a cero usando la amplitud redondeada
A_bi_redondeado <- round(A_bi, 0)
mc_inicio_bi <- mc_reales_bi[1] - A_bi_redondeado
mc_final_bi  <- mc_reales_bi[length(mc_reales_bi)] + A_bi_redondeado

# Unimos los vectores definitivos para el polígono
marcas_clase_bi   <- c(mc_inicio_bi, mc_reales_bi, mc_final_bi)
frecuencias_hi_bi <- c(0, hi_porcentaje_bi, 0)

# El pico máximo se detecta de forma automática con max()
max_y_hi_bi <- max(frecuencias_hi_bi)

#----------------------- GRAFICAR POLÍGONO DE FRECUENCIAS (hi) -----------------------
# Margen inferior amplio (mar[1] = 6) para que las etiquetas verticales no se corten
par(mar = c(6, 5, 4, 2)) 

# 5. Inicializar el lienzo con el rango de marcas de clase real
plot(marcas_clase_bi, frecuencias_hi_bi,
     type = "n",
     main = "Gráfica 1: Polígono de Frecuencias Relativas de Bismuto (Bi)",
     xlab = "", # Dejamos vacío aquí para que no se superponga con los números rotados
     ylab = "Frecuencia Relativa - hi (%)",
     xlim = c(mc_inicio_bi, mc_final_bi), 
     ylim = c(0, max_y_hi_bi * 1.05),                        
     xaxt = "n", yaxt = "n",
     panel.first = grid(nx = NULL, ny = NULL, col = "gray90")) 

# Agregamos el título del eje X un poco más abajo manualmente para evitar cruces
title(xlab = "Marcas de Clase - Concentración de Bi (ppm)", line = 4.5)

# 6. Dibujar las líneas del polígono
lines(marcas_clase_bi, frecuencias_hi_bi, type = "l", col = "darkcyan", lwd = 3)

# Dibujar puntos estructurales SOLO en las marcas de clase reales (sin textos encima)
points(mc_reales_bi, hi_porcentaje_bi, pch = 19, col = "darkcyan", cex = 1.2)

# Relleno bajo la curva
polygon(marcas_clase_bi, frecuencias_hi_bi, col = rgb(0, 0.55, 0.55, 0.12), border = NA)

#----------------------- PERSONALIZACIÓN DE EJES CORREGIDOS -----------------------
# Eje X REPARADO: Imprime las Marcas de Clase correctas (sin decimales) y las rota a vertical real (las = 2)
axis(1, at = mc_reales_bi, labels = mc_reales_bi, cex.axis = 1, las = 1)

# Eje Y: Valores horizontales mostrando porcentajes de guía y el pico máximo real (SIN decimales)
marcas_eje_y_bi <- seq(0, 70, by = 20)
axis(2, at = c(marcas_eje_y_bi, max_y_hi_bi), 
     labels = paste0(c(marcas_eje_y_bi, round(max_y_hi_bi, 0)), "%"), 
     las = 1, cex.axis = 0.8)

5. ANÁLISIS GRÁFICO: HISTOGRAMA DISTRIBUCIÓN DE BISMUTO

5.1 Histograma

#----------------------- PROCESAMIENTO Bi_ppm_MS_ST -----------------------

# 1. Conversión de Bi_ppm_MS_ST a numérico (blindado contra comas y textos)
datos$Bi_ppm_MS_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Bi_ppm_MS_ST))))

# Creamos variable de trabajo para las gráficas y FILTRAMOS negativos, NAs y atípicos (> 65)
Bi_VAR <- datos$Bi_ppm_MS_ST[!is.na(datos$Bi_ppm_MS_ST) & datos$Bi_ppm_MS_ST >= 0 & datos$Bi_ppm_MS_ST <= 65]

#----------------------- TABLA DE FRECUENCIAS SIMPLIFICADA -----------------------
# Al ser continua, agrupamos por rangos automáticos (bins) para legibilidad

bi_simplificado <- 5
# Usamos pretty para obtener cortes redondeados y estéticos en ppm
breaks_s <- pretty(Bi_VAR, n = bi_simplificado)

# 2. Generación del Histograma
# Aplicamos la lógica a la variable de Bismuto
hist(Bi_VAR,
     breaks = breaks_s,
     main = "Gráfica 2: Distribución de Bi_ppm_MS_ST (Simplificada)",
     xlab = "Concentración de Bi (ppm)",
     ylab = "Cantidad de muestras",
     col = "darkseagreen",
     right = FALSE)

5.2 Histograma mejorado

#----------------------- PREPARACIÓN DE DATOS (Bismuto) -----------------------
# Conversión y limpieza de la variable Bi_ppm_MS_ST
datos$Bi_ppm_MS_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Bi_ppm_MS_ST))))
Bi_VAR <- datos$Bi_ppm_MS_ST[!is.na(datos$Bi_ppm_MS_ST) & datos$Bi_ppm_MS_ST >= 0 & datos$Bi_ppm_MS_ST <= 65]

# Definimos exactamente 10 intervalos basados en números enteros
n_interv <- 10
min_bi <- floor(min(Bi_VAR))
max_bi <- ceiling(max(Bi_VAR))

# Generamos 11 puntos de corte para obtener 10 bins exactos
breaks_bi <- seq(min_bi, max_bi, length.out = n_interv + 1)

# Cálculo de datos para los gráficos
h_data_bi <- hist(Bi_VAR, breaks = breaks_bi, plot = FALSE)
intervalos_nombres <- paste0("[", round(h_data_bi$breaks[-length(h_data_bi$breaks)], 0), 
                             "-", round(h_data_bi$breaks[-1], 0), "]")

MC_bi <- h_data_bi$mids
Ni_asc_bi <- cumsum(h_data_bi$counts)
Ni_desc_bi <- rev(cumsum(rev(h_data_bi$counts)))

#----------------------- GRÁFICO DE BARRAS PROFESIONAL (Bi) -----------------------
# Margen inferior amplio para las etiquetas de los intervalos
par(mar=c(7, 5, 5, 2))

# Paleta de colores: 10 colores diferenciados
colores_bi <- terrain.colors(n_interv)

h_plot_bi <- barplot(h_data_bi$counts,
                     names.arg = intervalos_nombres,
                     main = "Gráfica 3: Distribución de Bismuto por Rangos (10 Intervalos)",
                     xlab = "Rangos de Concentración (ppm)",
                     ylab = "Frecuencia (N° de muestras)",
                     col = colores_bi,
                     border = "white",
                     las = 1,
                     cex.names = 0.8,
                     ylim = c(0, max(h_data_bi$counts) * 1.2))

# Valores exactos sobre las barras
text(x = h_plot_bi, y = h_data_bi$counts, labels = h_data_bi$counts,
     pos = 3, cex = 0.9, font = 2, col = "darkblue")

6. ANÁLISIS VISUAL ACUMULADO: OJIVA ASCENDENTE Y DESCENDENTE

6.1 OJIVAS ni

#----------------------- OJIVA INTEGRADA Y PROFESIONAL (Bismuto) -----------------------

# 1. Construimos los cortes exactos del eje X
cortes_eje_x_bi <- c(liminf, limsup[length(limsup)])

# Restauramos los márgenes a la normalidad
par(mar=c(5, 5, 4, 2))

plot(MC, Ni_asc,
     main = "Gráfica 4: Ojiva Acumulada de Frecuencias de Bismuto (ni)",
     xlab = "Concentración de Bismuto (ppm)",
     ylab = "Frecuencia Acumulada (N muestras)",
     type = "b", pch = 19, col = "forestgreen", lwd = 3,
     xaxt = "n", las = 1,
     ylim = c(0, max(Ni_asc) * 1.05),
     panel.first = grid(nx = NULL, ny = NULL, col = "gray90")) # Rejilla de fondo

# Línea descendente
lines(MC, Ni_desc, type = "b", pch = 17, col = "firebrick", lwd = 3, lty = 2)

# Eje X con los cortes de los intervalos exactos SIN DECIMALES
axis(1, at = cortes_eje_x_bi, labels = round(cortes_eje_x_bi, 0), cex.axis = 0.8)

# Leyenda 
legend("right",
       legend = c("Acumulada Menor que (Ascendente)", "Acumulada Mayor que (Descendente)"),
       col = c("forestgreen", "firebrick"),
       lty = c(1, 2),
       pch = c(19, 17),
       lwd = 2,
       title = "Tipo de Ojiva",
       bty = "n",  # Sin caja de borde
       cex = 0.85)

6.2 OJIVA hi

#----------------------- OJIVA PROFESIONAL EN PORCENTAJES (Bi) - FRECUENCIAS RELATIVAS ---------

# Restauramos los márgenes a la normalidad 
par(mar=c(5, 5, 4, 2))

plot(MC, Hi_asc,
     main = "Gráfica 5: Ojiva Acumulada de Frecuencias de Bismuto (hi)",
     xlab = "Concentración de Bismuto (ppm)",
     ylab = "Frecuencia Relativa Acumulada (%)",
     type = "b", pch = 19, col = "forestgreen", lwd = 3,
     xaxt = "n", las = 1,
     ylim = c(0, 105), # Escala porcentual fija hasta 105% para dar aire arriba
     panel.first = grid(nx = NULL, ny = NULL, col = "gray90")) # Rejilla de fondo

# Línea descendente 
lines(MC, Hi_desc, type = "b", pch = 17, col = "firebrick", lwd = 3, lty = 2)

# Eje X con los cortes de los intervalos exactos SIN DECIMALES
axis(1, at = cortes_eje_x_bi, labels = round(cortes_eje_x_bi, 0), cex.axis = 0.8)

# Leyenda adaptada a porcentajes
legend("right",
       legend = c("Acumulada Menor que (Ascendente %)", "Acumulada Mayor que (Descendente %)"),
       col = c("forestgreen", "firebrick"),
       lty = c(1, 2),
       pch = c(19, 17),
       lwd = 2,
       title = "Tipo de Ojiva",
       bty = "n",  
       cex = 0.85)

7. BOXPLOT

7.1 Boxplot con valores atípicos

#----------------------- BOXPLOT: ANÁLISIS DE VALORES ATÍPICOS -----------------------
par(mar=c(5, 6, 5, 2), xpd = FALSE)

# Cálculos estadísticos previos
stats_bi <- boxplot.stats(Bi_VAR)
media_bi  <- round(mean(Bi_VAR), 2)
mediana_bi <- round(median(Bi_VAR), 2)
n_outliers <- length(stats_bi$out)

# Generación del Boxplot
boxplot(Bi_VAR, horizontal = TRUE, col = "#DCE775", border = "#33691E",
        main = "Gráfica 6: Análisis de Valores Atípicos (Bismuto)", 
        xlab = "Concentración de Bi (ppm)",
        pch = 21, 
        bg = "red", 
        col.outline = "darkred", 
        frame = FALSE)

# Punto de Media y etiquetas de texto mejor ubicadas
points(media_bi, 1, 
       col = "blue", 
       pch = 18, 
       cex = 2)

text(media_bi, 1.25, 
     labels = paste("Media:", media_bi), 
     col = "blue", 
     font = 2, 
     cex = 0.9)

text(mediana_bi, 0.75, 
     labels = paste("Mediana:", mediana_bi), 
     col = "#1B5E20", 
     font = 2, 
     cex = 0.9)

# Leyenda (corregida para evitar errores de sintaxis)
legend("topright", 
       legend = paste("Atípicos detectados:", n_outliers),
       pch = 21, 
       pt.bg = "red", 
       bty = "n", 
       text.col = "darkred", 
       cex = 0.9)

7.2 Boxplot distribución limpia

#----------------------- BOXPLOT: DISTRIBUCIÓN LIMPIA (CUERPO MINERAL) -----------------------
par(mar=c(5, 6, 5, 2))

# Generación del Boxplot sin valores atípicos (outline = FALSE)
boxplot(Bi_VAR, 
        horizontal = TRUE, 
        outline = FALSE, 
        col = "#81D4FA", 
        border = "#01579B",
        main = "Gráfica 7: Distribución del Cuerpo Mineral (Sin Atípicos)", 
        xlab = "Concentración de Bi (ppm)", 
        frame = FALSE)

# Agregar cuadrícula de fondo
grid(nx = NULL, 
     ny = NA, 
     col = "gray85", 
     lty = "dashed")

# Valores sobre la vista limpia
points(media_bi, 1, 
       col = "#E65100", 
       pch = 18, 
       cex = 2)
text(media_bi, 1.25, 
     labels = paste("Media:", media_bi), 
     col = "#BF360C", 
     font = 2, 
     cex = 0.9)
text(mediana_bi, 0.75, 
     labels = paste("Mediana:", mediana_bi), 
     col = "#01579B", 
     font = 2, 
     cex = 0.9)

8. HISTOGRAMA CON BOXPLOT SUPERPUESTO (BISMUTO)

HISTOGRAMA CON BOXPLOT FLOTANTE (BISMUTO)

#----------------------- PREPARACIÓN DE DATOS -----------------------
# Conversión y limpieza de la variable Bi_ppm_MS_ST
datos$Bi_ppm_MS_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Bi_ppm_MS_ST))))
Bi_VAR <- datos$Bi_ppm_MS_ST[!is.na(datos$Bi_ppm_MS_ST) & datos$Bi_ppm_MS_ST >= 0 & datos$Bi_ppm_MS_ST <= 65]

# Definimos exactamente 10 intervalos basados en números enteros
n_interv <- 10
min_bi <- floor(min(Bi_VAR))
max_bi <- ceiling(max(Bi_VAR))
breaks_bi <- seq(min_bi, max_bi, length.out = n_interv + 1)

#----------------------- CÁLCULO DEL HISTOGRAMA (INVISIBLE) -----------------------
# Calculamos el histograma internamente para extraer datos
hist_pro_bi <- hist(Bi_VAR, breaks = breaks_bi, plot = FALSE, right = FALSE)
max_y_bi <- max(hist_pro_bi$counts)

#----------------------- CÁLCULO DEL RANGO X TOTAL (CORRECCIÓN) -----------------------
# Calculamos el rango necesario para abarcar tanto las barras como los atípicos
xlim_range <- range(c(Bi_VAR, breaks_bi))

# Aseguramos márgenes, con espacio ampliado a la derecha para la leyenda lateral
par(mar = c(5, 5, 4, 12), xpd = TRUE)

#----------------------- GRÁFICA INTEGRADA (HISTOGRAMA) -----------------------
# 1. Dibujamos el histograma base usando tu paleta terrain.colors
colores_bi <- terrain.colors(n_interv)

hist(Bi_VAR, 
     breaks = breaks_bi, 
     col = colores_bi, 
     border = "white",
     main = "Gráfica 8: Distribución de Bismuto con Boxplot Interno",
     xlab = "Concentración de Bi (ppm)", 
     ylab = "Frecuencia (Cantidad)", 
     xlim = xlim_range,            # Asegura que todo el eje X sea visible
     ylim = c(0, max_y_bi * 1.15), # Añadimos espacio extra en la parte superior
     las = 1,
     labels = TRUE,                # Muestra los números encima de las barras
     right = FALSE,
     xaxt = "n")                   # Suprime el eje X por defecto

# 2. Personalización del eje X dinámico
axis(1, at = breaks_bi, labels = round(breaks_bi, 0), font = 2, cex.axis = 0.7)

# 3. Superponemos el Boxplot directamente
boxplot(Bi_VAR, 
        horizontal = TRUE, 
        add = TRUE,             # Superpone la gráfica
        axes = FALSE,           # Oculta ejes
        at = max_y_bi / 2,      # Altura de flotación (mitad del eje Y)
        boxwex = max_y_bi / 3,  # Grosor de la caja
        col = adjustcolor("#DCE775", alpha.f = 0.7), # Color verde con 70% de opacidad
        border = "#33691E",     # Borde verde oscuro
        lwd = 1.5,              
        pch = 21, bg = "red",   # Estilo de atípicos en rojo
        outcol = "darkred")     # Borde de los puntos atípicos

# 4. Añadimos la leyenda lateral
intervalos_bi <- paste0("[", round(hist_pro_bi$breaks[-length(hist_pro_bi$breaks)], 0), 
                        " - ", round(hist_pro_bi$breaks[-1], 0), ")")

legend("topright", inset=c(-0.35, 0),
       legend = intervalos_bi,
       fill = colores_bi,
       title = "Intervalos (ppm)",
       cex = 0.8, bty = "n")

9. INDICADORES ESTADÍSTICOS

INDICADORES ESTADÍSTICOS

#----------------------- ANÁLISIS ESTADÍSTICO Bi_ppm_MS_ST -----------------------

# 0. Limpieza automática de nombres (elimina espacios en blanco accidentales)
colnames(datos) <- trimws(colnames(datos))

# 1. Preparación de la variable con validación de existencia
if("Bi_ppm_MS_ST" %in% colnames(datos)) {
  
  # Conversión a numérico (manejo de comas decimales y supresión de advertencias)
  datos$Bi_ppm_MS_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Bi_ppm_MS_ST))))
  
  # 2. Limpieza de valores nulos, trazas invisibles y atípicos extremos
  # EL CORTE EXACTO: >= 0.1 y <= 65 para mantener la armonía de 933 datos con la Tabla de Sturges
  Bi_LIMPIA <- datos$Bi_ppm_MS_ST[!is.na(datos$Bi_ppm_MS_ST) & datos$Bi_ppm_MS_ST >= 0.1 & datos$Bi_ppm_MS_ST <= 65]
  
  # 3. Cálculos estadísticos descriptivos
  resumen_stats_Bi <- data.frame(
    Estadistico = c("Tamaño muestral (n)", 
                    "Mínimo (Min)", 
                    "Máximo (Max)", 
                    "Media (x̅)", 
                    "Mediana (Me)", 
                    "Desviación Estándar (s)", 
                    "Coef. Variación (CV)", 
                    "Asimetría (As)", 
                    "Curtosis (k)"),
    Valor = c(
      length(Bi_LIMPIA),
      min(Bi_LIMPIA),
      max(Bi_LIMPIA),
      mean(Bi_LIMPIA),
      median(Bi_LIMPIA),
      sd(Bi_LIMPIA),
      (sd(Bi_LIMPIA) / mean(Bi_LIMPIA)) * 100,
      skewness(Bi_LIMPIA, type = 2),
      kurtosis(Bi_LIMPIA)
    )
  )
  
  # 4. Redondeo técnico a dos decimales para el reporte
  resumen_stats_Bi$Valor <- round(resumen_stats_Bi$Valor, 2)
  
  #----------------------- SALIDA ESTÉTICA CON 'gt' -----------------------
  tabla_stats_bi_gt <- resumen_stats_Bi %>%
    gt() %>%
    tab_header(
      title = md("**Tabla N° 4**"),
      subtitle = md("Estadística Descriptiva para Concentraciones de Bismuto (Bi)")
    ) %>%
    tab_source_note(
      source_note = md("Autores: Grupo 1 <br> Semestre 2026 - 2026")
    ) %>%
    cols_label(
      Estadistico = "Parámetro Estadístico",
      Valor = "Resultado"
    ) %>%
    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
    )
  
  # Renderizar la tabla final
  tabla_stats_bi_gt
  
} else {
  stop("¡ERROR! La columna 'Bi_ppm_MS_ST' no existe en el dataset. Verifique el nombre en su archivo de origen.")
}
Tabla N° 4
Estadística Descriptiva para Concentraciones de Bismuto (Bi)
Parámetro Estadístico Resultado
Tamaño muestral (n) 933.00
Mínimo (Min) 0.10
Máximo (Max) 63.50
Media (x̅) 6.46
Mediana (Me) 1.30
Desviación Estándar (s) 11.95
Coef. Variación (CV) 184.99
Asimetría (As) 2.69
Curtosis (k) 7.08
Autores: Grupo 1
Semestre 2026 - 2026

10. CONCLUSIÓN

CONCLUSIÓN DE LA VARIABLE Bi_ppm_MS_ST

El análisis de 933 muestras revela un rango de concentración entre 0.10 ppm y 63.50 ppm. El depósito presenta una media de 6.46 ppm y una mediana de 1.30 ppm, reflejando una fuerte heterogeneidad y dispersión de las leyes debido a una desviación estándar de 11.95 y un coeficiente de variación de 184.99%. Finalmente, los índices de forma confirman una marcada asimetría positiva de 2.69 y una curtosis de 7.08; esto demuestra matemáticamente que el yacimiento está dominado por concentraciones basales bajas, pero el promedio se ve fuertemente traccionado por anomalías puntuales de alta ley.