Análisis Estadístico por Variables Cuantitativas Bi_ppm_MS_ST
Grupo 1
2026-23-05
CARGA DE DATOS
CARGA DE DATOS
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]Se cargaron correctamente los datos de todas las variables
ANÁLISIS DE FRECUENCIAS: CONCENTRACIÓN DE BISMUTO (Bi_ppm_MS_ST)
CONCENTRACIÓN DE BISMUTO (Bi_ppm_MS_ST)
# Cargar las librerías necesarias
library(dplyr)
library(gt)
#----------------------- 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 |
||
ANÁLISIS DESCRIPTIVO Y AGRUPACIÓN EN CLASES (STRUGES) DE BISMUTO
ANÁLISIS DESCRIPTIVO Y AGRUPACIÓN EN CLASES (STRUGES) DE BISMUTO
# Cargar las librerías al inicio
library(dplyr)
library(gt)
#------------------------- 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 ppmcat("La concentración máxima detectada es: ", max(Bi_VAR, na.rm = TRUE), " ppm \n")## La concentración máxima detectada es: 63.5 ppmcat("Total de muestras analizadas: ", sum(!is.na(Bi_VAR)), " registros \n")## Total de muestras analizadas: 933 registroscat("=======================================================\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 |
|||||||||
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 de la tabla
mc_reales_bi <- (liminf_bi + limsup_bi) / 2
# 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
mc_inicio_bi <- mc_reales_bi[1] - A_bi
mc_final_bi <- mc_reales_bi[length(mc_reales_bi)] + A_bi
# 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() (será 75.67%)
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 = "Marcas de Clase - Concentración de Bi (ppm)",
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"))
# 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 y las rota a vertical
axis(1, at = mc_reales_bi, labels = round(mc_reales_bi, 2), cex.axis = 0.75, las = 1)
# Eje Y: Valores horizontales mostrando porcentajes de guía y el pico máximo real
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, 2)), "%"),
las = 1, cex.axis = 0.8)
ANÁLISIS GRÁFICO: HISTOGRAMA DISTRIBUCIÓN DE BISMUTO
HISTOGRAMA DISTRIBUCIÓN DE BISMUTO
#----------------------- 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)
#----------------------- 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")
ANÁLISIS VISUAL ACUMULADO: OJIVA ASCENDENTE Y DESCENDENTE
OJIVAS ni Y hi
#----------------------- 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
axis(1, at = cortes_eje_x_bi, labels = round(cortes_eje_x_bi, 2), 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)
#----------------------- 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
axis(1, at = cortes_eje_x_bi, labels = round(cortes_eje_x_bi, 2), 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)
BOXPLOT:
BOXPLTS DE VALORES ATÍPICOS Y DISTRIBUCIÓN LIMPIA
#----------------------- 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)
#----------------------- 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)
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 (breaks exactos)
axis(1, at = breaks_bi, labels = round(breaks_bi, 1), 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)], 1),
" - ", round(hist_pro_bi$breaks[-1], 1), ")")
legend("topright", inset=c(-0.35, 0),
legend = intervalos_bi,
fill = colores_bi,
title = "Intervalos (ppm)",
cex = 0.8, bty = "n")
INDICADORES ESTADÍSTICOS
INDICADORES ESTADÍSTICOS
# Cargar las librerías al inicio
library(dplyr)
library(gt)
library(e1071) # Necesaria para Asimetría y Curtosis
#----------------------- 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° 3**"),
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° 3 | |
| 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 |
|
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.