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 DEL HIERRO (Fe)
# Cargar las librerías necesarias
library(dplyr)
library(gt)
#----------------------- PROCESAMIENTO Fe_pct_AES_ST -----------------------
# 1. Limpieza y preparación de la variable (conversión de coma a punto)
datos$Fe_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Fe_pct_AES_ST))))
# Separar registros con concentraciones válidas (>= 0) de los nulos o negativos
fe_numerico <- datos$Fe_pct_AES_ST[datos$Fe_pct_AES_ST >= 0 & !is.na(datos$Fe_pct_AES_ST)]
n_sin_datos_fe <- sum(is.na(datos$Fe_pct_AES_ST) | datos$Fe_pct_AES_ST < 0)
# 2. Tabla de Frecuencias de los valores geoquímicos reales
TDF_VALIDOS_FE <- as.data.frame(table(fe_numerico), stringsAsFactors = FALSE)
colnames(TDF_VALIDOS_FE) <- c("CATEGORIA", "ni")
# Convertir categoría a numérico para ordenar de menor a mayor concentración (%)
TDF_VALIDOS_FE$CATEGORIA <- as.numeric(TDF_VALIDOS_FE$CATEGORIA)
TDF_VALIDOS_FE <- TDF_VALIDOS_FE[order(TDF_VALIDOS_FE$CATEGORIA), ]
# Definición de horizontes cuantitativos para el balance unificado
total_variable_fe <- sum(TDF_VALIDOS_FE$ni) # Total de muestras con lecturas de Fe
total_general_fe <- total_variable_fe + n_sin_datos_fe # Total absoluto de la matriz (1366)
# 3. Agrupación: Top 10 valores de concentración más bajos + Otras Concentraciones
if(nrow(TDF_VALIDOS_FE) > 10) {
tabla_top_fe <- head(TDF_VALIDOS_FE, 10)
sum_otros_fe <- sum(TDF_VALIDOS_FE$ni[11:nrow(TDF_VALIDOS_FE)])
fila_otros_fe <- data.frame(CATEGORIA = "Otras Concentraciones", ni = sum_otros_fe)
tabla_final_base_fe <- rbind(tabla_top_fe, fila_otros_fe)
} else {
tabla_final_base_fe <- TDF_VALIDOS_FE
}
# Convertir CATEGORIA a carácter para permitir el ensamblaje de texto formal
tabla_final_base_fe$CATEGORIA <- as.character(tabla_final_base_fe$CATEGORIA)
# 4. Calcular frecuencias relativas (hi) respecto al total general del proyecto
tabla_final_base_fe$hi <- round((tabla_final_base_fe$ni / total_general_fe) * 100, 4)
# 5. FILA DEL TOTAL EXCLUSIVO DE LA VARIABLE (Muestras con datos de Hierro)
fila_total_var_fe <- data.frame(
CATEGORIA = "TOTAL VARIABLE (Fe)",
ni = total_variable_fe,
hi = round((total_variable_fe / total_general_fe) * 100, 4)
)
# 6. FILA DE CONTRASTE: REGISTROS SIN INFORMACIÓN ANALÍTICA (NAs / Negativos)
fila_sin_datos_fe <- data.frame(
CATEGORIA = "Sin Datos",
ni = n_sin_datos_fe,
hi = round((n_sin_datos_fe / total_general_fe) * 100, 4)
)
# 7. FILA DEL TOTAL GENERAL DEL PROYECTO
fila_total_general_fe <- data.frame(
CATEGORIA = "TOTAL GENERAL",
ni = total_general_fe,
hi = 100 # Cierre perfecto del balance estadístico
)
# 8. Consolidar la matriz final en el orden metodológico formal
tabla_final_fe <- rbind(tabla_final_base_fe, fila_total_var_fe, fila_sin_datos_fe, fila_total_general_fe)
colnames(tabla_final_fe) <- c("Valor Fe (%)", "ni", "hi")
#----------------------- GENERAR SALIDA ESTÉTICA CON 'gt' -----------------------
tabla_hierro_completa_gt <- tabla_final_fe %>%
gt() %>%
tab_header(
title = md("**Tabla N° 1**"),
subtitle = md("Distribución de frecuencias para concentraciones de Hierro (Fe)")
) %>%
tab_source_note(
source_note = md("Autores: Grupo 1 <br> Semestre 2026 - 2026")
) %>%
cols_label(
`Valor Fe (%)` = "Valor Fe (%)",
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
) %>%
sub_missing(
columns = everything(),
missing_text = "-"
)
# Renderizar la tabla en el documento
tabla_hierro_completa_gt
| Tabla N° 1 | ||
| Distribución de frecuencias para concentraciones de Hierro (Fe) | ||
| Valor Fe (%) | n (abs) | hi (%) |
|---|---|---|
| 0.01 | 1 | 0.0732 |
| 0.02 | 3 | 0.2196 |
| 0.03 | 5 | 0.3660 |
| 0.04 | 5 | 0.3660 |
| 0.05 | 5 | 0.3660 |
| 0.06 | 5 | 0.3660 |
| 0.07 | 4 | 0.2928 |
| 0.08 | 4 | 0.2928 |
| 0.09 | 7 | 0.5124 |
| 0.1 | 3 | 0.2196 |
| Otras Concentraciones | 1293 | 94.6559 |
| TOTAL VARIABLE (Fe) | 1335 | 97.7306 |
| Sin Datos | 31 | 2.2694 |
| TOTAL GENERAL | 1366 | 100.0000 |
| Autores: Grupo 1 Semestre 2026 - 2026 |
||
POLÍGONO DE FRECUENCIAS ABSOLUTAS DEL HIERRO
#----------------------- PROCESAMIENTO AUTOMÁTICO Fe_pct_AES_ST -----------------------
# 1. Conversión de la variable a numérico y limpieza de datos (Hierro)
datos$Fe_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Fe_pct_AES_ST))))
# Mantenemos el criterio estadístico: valores reales mayores o iguales a cero
Fe_VAR <- datos$Fe_pct_AES_ST[!is.na(datos$Fe_pct_AES_ST) & datos$Fe_pct_AES_ST >= 0]
#----------------------- EXTRACCIÓN METODOLÓGICA DE STURGES -----------------------
# 2. Calculamos los parámetros de Sturges para el Hierro automáticamente
n_total_fe <- length(Fe_VAR)
k_sturges_fe <- floor(1 + 3.322 * log10(n_total_fe))
# 3. Definimos los cortes de intervalos (breaks) usando el rango real del Hierro
rango_fe <- max(Fe_VAR) - min(Fe_VAR)
amplitud_fe <- rango_fe / k_sturges_fe
breaks_sturges_fe <- seq(from = min(Fe_VAR), by = amplitud_fe, length.out = k_sturges_fe + 1)
# 4. CAPTURA DE DATOS OCULTOS: Agrupación y conteo en memoria para Hierro
hist_objeto_fe <- hist(Fe_VAR, breaks = breaks_sturges_fe, plot = FALSE, right = FALSE)
#----------------------- ANCLAJE A CERO -----------------------
# 5. Creamos las clases vacías a los extremos para que el polígono cierre en el eje X
mc_inicio_fe <- hist_objeto_fe$mids[1] - amplitud_fe
mc_final_fe <- hist_objeto_fe$mids[length(hist_objeto_fe$mids)] + amplitud_fe
# Unimos los vectores definitivos para el gráfico (Marcas de Clase y Frecuencias n)
marcas_clase_fe <- c(mc_inicio_fe, hist_objeto_fe$mids, mc_final_fe)
frecuencias_fe <- c(0, hist_objeto_fe$counts, 0)
# Detectamos la frecuencia máxima real del hierro para el eje Y
max_y_fe <- max(frecuencias_fe)
#----------------------- GRAFICAR POLÍGONO DE FRECUENCIAS (Hierro) -----------------------
par(mar = c(5, 5, 4, 2))
# 6. Inicializar el lienzo con los límites calculados para el Hierro
plot(marcas_clase_fe, frecuencias_fe,
type = "n",
main = "Gráfica 1: Polígono de Frecuencias Absolutas de Hierro (Fe)",
xlab = "Concentración de Hierro - Fe (%)",
ylab = "Frecuencia Absoluta (n muestras)",
xlim = c(min(breaks_sturges_fe), max(breaks_sturges_fe)), # Ajuste exacto a los límites de hierro
ylim = c(0, max_y_fe * 1.1), # Margen del 10% superior libre
xaxt = "n", yaxt = "n",
panel.first = grid(nx = NULL, ny = NULL, col = "gray90"))
# 7. Dibujar el polígono (Color rojo óxido/fuego para el Hierro)
lines(marcas_clase_fe, frecuencias_fe, type = "b", pch = 19, col = "firebrick", lwd = 3)
# 8. Relleno translúcido a juego debajo de la curva
polygon(marcas_clase_fe, frecuencias_fe, col = rgb(0.70, 0.13, 0.13, 0.12), border = NA)
#----------------------- PERSONALIZACIÓN DE EJES CONTINUOS -----------------------
# Eje X: Imprime los límites reales de Sturges para el hierro (3 decimales)
axis(1, at = breaks_sturges_fe, labels = round(breaks_sturges_fe, 3), cex.axis = 0.75, las = 1)
# Eje Y: Imprime marcas proporcionales y ancla el valor de n más alto detectado
marcas_eje_y_fe <- pretty(c(0, max_y_fe))
marcas_eje_y_fe <- marcas_eje_y_fe[marcas_eje_y_fe < (max_y_fe * 0.9)]
axis(2, at = c(marcas_eje_y_fe, max_y_fe), labels = c(marcas_eje_y_fe, max_y_fe), las = 1, cex.axis = 0.8)
HISTOGRAMA DISTRIBUCIÓN DEL HIERRO
#----------------------- PROCESAMIENTO Fe_pct_AES_ST -----------------------
# 1. Conversión de Fe_pct_AES_ST a numérico (blindado contra comas y textos)
datos$Fe_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Fe_pct_AES_ST))))
# Creamos variable de trabajo para las gráficas y FILTRAMOS los negativos
Fe_VAR <- datos$Fe_pct_AES_ST
Fe_VAR <- Fe_VAR[Fe_VAR >= 0 & !is.na(Fe_VAR)] # Mantenemos solo valores >= 0
#----------------------- TABLA DE FRECUENCIAS SIMPLIFICADA -----------------------
# Al ser continua, agrupamos por rangos automáticos (bins) para que la gráfica sea legible
k_simplificado <- 5
# Usamos pretty para obtener cortes redondeados y estéticos
breaks_s <- pretty(Fe_VAR, n = k_simplificado)
HistogramaFe <- hist(Fe_VAR, breaks = breaks_s, plot = FALSE)
# 2. Generación del Histograma
# Mantenemos la lógica original aplicada ahora al Hierro filtrado
hist(Fe_VAR,
breaks = breaks_s,
main = "Gráfica 2: Distribución de Fe_pct_AES_ST (Simplificada)",
xlab = "Concentración de Fe (%)",
ylab = "Cantidad de muestras",
col = "indianred", # Color rojizo/óxido ajustado para el Hierro
right = FALSE,
ylim = c(0, 800))
ANÁLISIS DESCRIPTIVO Y AGRUPACIÓN EN CLASES (STRUGES) DEL HIERRO
# Cargar las librerías necesarias
library(dplyr)
library(gt)
#------------------------- PREPARACIÓN DE DATOS (Hierro) -------------------------
# Reemplazamos comas por puntos
datos$Fe_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Fe_pct_AES_ST))))
# Creamos la variable de trabajo HIERRO y FILTRAMOS LOS NEGATIVOS y NAs
HIERRO <- datos$Fe_pct_AES_ST
HIERRO <- HIERRO[HIERRO >= 0 & !is.na(HIERRO)]
#------------------------- ANÁLISIS ESTADÍSTICO -------------------------
cat("\n=======================================================\n")
##
## =======================================================
cat("ANÁLISIS DE CONCENTRACIÓN (Fe_pct_AES_ST):\n")
## ANÁLISIS DE CONCENTRACIÓN (Fe_pct_AES_ST):
cat("La concentración promedio es: ", round(mean(HIERRO, na.rm = TRUE), 2), " % \n")
## La concentración promedio es: 13.76 %
cat("La concentración máxima detectada es: ", max(HIERRO, na.rm = TRUE), " % \n")
## La concentración máxima detectada es: 68.6 %
cat("Total de muestras analizadas: ", sum(!is.na(HIERRO)), " registros \n")
## Total de muestras analizadas: 1335 registros
cat("=======================================================\n\n")
## =======================================================
#------------------------- TABLA DE FRECUENCIAS - STURGES -------------------------
R <- max(HIERRO, na.rm = TRUE) - min(HIERRO, na.rm = TRUE)
k <- floor(1 + 3.3 * log10(length(HIERRO)))
A <- R / k
liminf <- seq(from = min(HIERRO, na.rm = TRUE), by = A, length.out = k)
limsup <- liminf + A
MC <- (liminf + limsup) / 2
n <- numeric(k)
for (i in 1:k) {
if (i == k) {
n[i] <- sum(HIERRO >= liminf[i] & HIERRO <= limsup[i], na.rm = TRUE)
} else {
n[i] <- sum(HIERRO >= liminf[i] & HIERRO < limsup[i], na.rm = TRUE)
}
}
hi <- n / sum(n) * 100
Ni_asc <- cumsum(n)
Hi_asc <- cumsum(hi)
Ni_desc <- rev(cumsum(rev(n)))
Hi_desc <- rev(cumsum(rev(hi)))
#------------------------- CONSTRUCCIÓN DE LA TABLA -------------------------
TablaFe_Sturges <- data.frame(
Clase = as.character(1:k), # Convertido a carácter para permitir unir la fila "**TOTALES**"
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)
)
# Creamos la fila de TOTALES con formato de texto para el reporte
fila_totales <- data.frame(
Clase = "**TOTALES**",
liminf = NA,
limsup = NA,
MC = NA,
n = sum(n),
hi = sum(hi),
Ni_asc = NA,
Hi_asc = 100,
Ni_desc = NA,
Hi_desc = 100
)
# Unimos la tabla con los totales
TablaFe_Final <- rbind(TablaFe_Sturges, fila_totales)
#------------------------- MOSTRAR TABLA FINAL CON 'gt' -------------------------
tabla_sturges_fe_gt <- TablaFe_Final %>%
gt() %>%
tab_header(
title = md("**Tabla N° 2**"),
subtitle = md("Distribución de frecuencias para concentraciones de Hierro (Fe) <br> mediante Regla de Sturges")
) %>%
tab_source_note(
source_note = md("Autores: Grupo 1 <br> Semestre 2026 - 2026")
) %>%
fmt_markdown(columns = Clase) %>% # Permite renderizar las negritas en "**TOTALES**"
cols_label(
Clase = "Clase",
liminf = "Linf (%)",
limsup = "Lsup (%)",
MC = "MC (%)",
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 documento
tabla_sturges_fe_gt
| Tabla N° 2 | |||||||||
| Distribución de frecuencias para concentraciones de Hierro (Fe) mediante Regla de Sturges |
|||||||||
| Clase | Linf (%) | Lsup (%) | MC (%) | n (abs) | hi (%) | Ni (↑) | Hi (↑) | Ni (↓) | Hi (↓) |
|---|---|---|---|---|---|---|---|---|---|
| 1 | 0.010 | 6.245 | 3.128 | 584 | 43.75 | 584 | 43.75 | 1335 | 100.00 |
| 2 | 6.245 | 12.481 | 9.363 | 228 | 17.08 | 812 | 60.82 | 751 | 56.25 |
| 3 | 12.481 | 18.716 | 15.599 | 145 | 10.86 | 957 | 71.69 | 523 | 39.18 |
| 4 | 18.716 | 24.952 | 21.834 | 97 | 7.27 | 1054 | 78.95 | 378 | 28.31 |
| 5 | 24.952 | 31.187 | 28.070 | 98 | 7.34 | 1152 | 86.29 | 281 | 21.05 |
| 6 | 31.187 | 37.423 | 34.305 | 52 | 3.90 | 1204 | 90.19 | 183 | 13.71 |
| 7 | 37.423 | 43.658 | 40.540 | 53 | 3.97 | 1257 | 94.16 | 131 | 9.81 |
| 8 | 43.658 | 49.894 | 46.776 | 35 | 2.62 | 1292 | 96.78 | 78 | 5.84 |
| 9 | 49.894 | 56.129 | 53.011 | 24 | 1.80 | 1316 | 98.58 | 43 | 3.22 |
| 10 | 56.129 | 62.365 | 59.247 | 11 | 0.82 | 1327 | 99.40 | 19 | 1.42 |
| 11 | 62.365 | 68.600 | 65.482 | 8 | 0.60 | 1335 | 100.00 | 8 | 0.60 |
| TOTALES | NA | NA | NA | 1335 | 100.00 | NA | 100.00 | NA | 100.00 |
| Autores: Grupo 1 Semestre 2026 - 2026 |
|||||||||
HISTOGRAMA MEJORADO
#----------------------- PREPARACIÓN DE DATOS (Hierro) -----------------------
datos$Fe_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Fe_pct_AES_ST))))
HIERRO <- datos$Fe_pct_AES_ST[!is.na(datos$Fe_pct_AES_ST) & datos$Fe_pct_AES_ST >= 0]
#----------------------- INTERVALOS AMPLIADOS PARA AGRUPACIÓN -----------------------
max_real <- max(HIERRO)
# Los datos llegan muy lejos, agrupamos de 5 en 5.
paso <- ifelse(max_real > 50, 5, ifelse(max_real > 15, 2, 1))
# Calculamos el límite superior garantizando que cubra todos los datos
limite_superior <- ceiling(max_real / paso) * paso
breaks_entero <- seq(0, limite_superior, by = paso)
# Cálculo de la tabla de frecuencias
h_data <- hist(HIERRO, breaks = breaks_entero, plot = FALSE)
MC <- h_data$mids
Ni_asc <- cumsum(h_data$counts)
Ni_desc <- rev(cumsum(rev(h_data$counts)))
#----------------------- 1. HISTOGRAMA AGRUPADO Y LIMPIO -----------------------
# Aumentamos ligeramente el ancho
par(mar=c(5, 5, 5, 2))
h_plot <- hist(HIERRO, breaks = breaks_entero,
main = "Gráfica 3: Distribución del Contenido de Hierro (%)",
xlab = "Contenido de Hierro (%)",
ylab = "Frecuencia (Cantidad)",
col = "indianred", border = "darkred",
xaxt = "n",
las = 1,
ylim = c(0, max(h_data$counts) * 1.15))
# Eje X con los nuevos cortes (de 5 en 5)
axis(1, at = breaks_entero, labels = breaks_entero, font = 2)
# Etiquetas con tamaño ajustado para evitar superposición
text(h_plot$mids, h_plot$counts,
labels = h_plot$counts,
adj = c(0.5, -0.5),
cex = 0.8,
font = 2,
col = "black")
OJIVAS ni y hi
#----------------------- 2. OJIVA INTEGRADA Y PROFESIONAL (Hierro) -----------------------
# Restauramos los márgenes a la normalidad ya que pondremos la leyenda adentro
par(mar=c(5, 5, 4, 2))
plot(MC, Ni_asc,
main = "Gráfica 4: Ojiva Acumulada de Frecuencias de Hierro (ni)",
xlab = "Contenido de Hierro (%)",
ylab = "Frecuencia Acumulada (N muestras)",
type = "b", pch = 19, col = "darkred", 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
# Segunda línea (Descendente)
lines(MC, Ni_desc, type = "b", pch = 17, col = "steelblue", lwd = 3, lty = 2)
# Eje X con los intervalos (usando la variable breaks_entero calculada en el paso anterior)
axis(1, at = breaks_entero, labels = breaks_entero)
# Leyenda reubicada en el espacio vacío del lado derecho para una estética limpia
legend("right",
legend = c("Acumulada Menor que (Ascendente)", "Acumulada Mayor que (Descendente)"),
col = c("darkred", "steelblue"),
lty = c(1, 2),
pch = c(19, 17),
lwd = 2,
title = "Tipo de Ojiva",
bty = "n", # Sin caja de borde para que se fusione con el fondo
cex = 0.85) # Tamaño de letra ajustado
#----------------------- PREPARACIÓN DE DATOS (Hierro) -----------------------
# Conversión a numérico (reemplazo de comas por puntos)
datos$Fe_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Fe_pct_AES_ST))))
# Variable de trabajo limpia (valores mayores o iguales a cero)
Fe_VAR <- datos$Fe_pct_AES_ST[!is.na(datos$Fe_pct_AES_ST) & datos$Fe_pct_AES_ST >= 0]
# Estructuración de intervalos (Sturges de forma automatizada)
n_total_fe <- length(Fe_VAR)
k_sturges_fe <- floor(1 + 3.322 * log10(n_total_fe))
rango_fe <- max(Fe_VAR) - min(Fe_VAR)
amplitud_fe <- rango_fe / k_sturges_fe
breaks_fe <- seq(from = min(Fe_VAR), by = amplitud_fe, length.out = k_sturges_fe + 1)
# Extracción en memoria de las frecuencias absolutas
h_data_fe <- hist(Fe_VAR, breaks = breaks_fe, plot = FALSE, right = FALSE)
# EL CAMBIO: Extracción de marcas de clase y cálculo de frecuencias relativas (hi)
MC_fe <- h_data_fe$mids
hi_fe <- (h_data_fe$counts / sum(h_data_fe$counts)) * 100
# Acumuladas en formato porcentual (Hi)
Hi_asc_fe <- cumsum(hi_fe)
Hi_desc_fe <- rev(cumsum(rev(hi_fe)))
#----------------------- OJIVA PROFESIONAL EN PORCENTAJES (Hierro) -----------------------
# Restauramos los márgenes a la normalidad
par(mar=c(5, 5, 4, 2))
plot(MC_fe, Hi_asc_fe,
main = "Gráfica 5: Ojiva Acumulada de Frecuencias de Hierro (hi)",
xlab = "Contenido de Hierro (%)",
ylab = "Frecuencia Relativa Acumulada (%)",
type = "b", pch = 19, col = "darkred", lwd = 3,
xaxt = "n", las = 1,
ylim = c(0, 105), # Escala fija de 0 a 105% ideal para frecuencias relativas
panel.first = grid(nx = NULL, ny = NULL, col = "gray90")) # Rejilla de fondo
# Segunda línea (Descendente / Mayor que)
lines(MC_fe, Hi_desc_fe, type = "b", pch = 17, col = "steelblue", lwd = 3, lty = 2)
# Eje X con los intervalos exactos redondeados a 2 decimales
axis(1, at = breaks_fe, labels = round(breaks_fe, 2), cex.axis = 0.8)
# Leyenda adaptada a la escala de porcentajes
legend("right",
legend = c("Acumulada Menor que (Ascendente %)", "Acumulada Mayor que (Descendente %)"),
col = c("darkred", "steelblue"),
lty = c(1, 2),
pch = c(19, 17),
lwd = 2,
title = "Tipo de Ojiva",
bty = "n", # Sin caja de borde
cex = 0.85) # Tamaño de letra ajustado
ANÁLISI VISUAL POR RANGOS
#----------------------- PREPARACIÓN DE DATOS (Hierro) -----------------------
datos$Fe_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Fe_pct_AES_ST))))
Fe_VAR <- datos$Fe_pct_AES_ST[!is.na(datos$Fe_pct_AES_ST) & datos$Fe_pct_AES_ST >= 0]
#----------------------- CÁLCULO DE INTERVALOS (STURGES) -----------------------
k <- floor(1 + 3.322 * log10(length(Fe_VAR)))
R_rango <- max(Fe_VAR) - min(Fe_VAR)
A_amplitud <- R_rango / k
breaks_fe <- seq(from = min(Fe_VAR), by = A_amplitud, length.out = k + 1)
h_info <- hist(Fe_VAR, breaks = breaks_fe, plot = FALSE, right = FALSE)
intervalos <- paste0("[", round(h_info$breaks[-length(h_info$breaks)], 2),
" - ", round(h_info$breaks[-1], 2), ")")
colores_hist <- colorRampPalette(c("#ef9a9a", "#b71c1c"))(length(h_info$counts))
#----------------------- HISTOGRAMA Y LEYENDA CORREGIDA -----------------------
# Aumentamos el margen inferior (7) para que los números verticales quepan bien
par(mar=c(7, 5, 5, 12), xpd=TRUE)
hist(Fe_VAR, breaks = breaks_fe,
main = "Gráfica 6: Distribución de Fe_pct_AES_ST (Regla de Sturges)",
xlab = "", # Quitamos el título general del eje X para que no choque con los números
ylab = "Frecuencia (Cantidad)",
col = colores_hist,
border = "white",
labels = TRUE,
right = FALSE,
las = 1,
xaxt = "n",
ylim = c(0, max(h_info$counts) * 1.15))
# Título del eje X desplazado hacia abajo
mtext("Contenido de Hierro (%)", side = 1, line = 5, font = 1)
# Eje X dinámico: Forzamos la rotación (las = 2) y ajustamos tamaño (cex.axis = 0.8)
axis(1, at = breaks_fe,
labels = round(breaks_fe, 2),
font = 2,
las = 1,
cex.axis = 0.8)
# Leyenda lateral con los intervalos matemáticos
legend("topright", inset=c(-0.25, 0),
legend = intervalos,
fill = colores_hist,
title = "Intervalos (%)",
cex = 0.85, bty = "n")
BOXPLOTS DE VALORES ATÍPICOS Y DISTRIBUCIÓN LIMPIA
#----------------------- PREPARACIÓN DE DATOS (Hierro) -----------------------
# Conversión a numérico y limpieza de valores nulos o en cero
datos$Fe_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Fe_pct_AES_ST))))
Fe_VAR <- datos$Fe_pct_AES_ST[!is.na(datos$Fe_pct_AES_ST) & datos$Fe_pct_AES_ST > 0]
#----------------------- 2. BOXPLOT: ANÁLISIS DE VALORES ATÍPICOS -----------------------
par(mar=c(5, 6, 5, 2), xpd = FALSE)
# Cálculos estadísticos previos
stats_fe <- boxplot.stats(Fe_VAR)
media_fe <- round(mean(Fe_VAR), 2)
mediana_fe <- round(median(Fe_VAR), 2)
n_outliers <- length(stats_fe$out)
# Generación del Boxplot
boxplot(Fe_VAR, horizontal = TRUE, col = "indianred", border = "darkred",
main = "Gráfica 7: Análisis de Valores Atípicos (Hierro)",
xlab = "Concentración de Hierro (%)",
pch = 21,
bg = "red",
outcol = "darkred", # Parámetro correcto para el borde de los atípicos
frame = FALSE)
# Punto de Media y etiquetas de texto mejor ubicadas
points(media_fe, 1,
col = "blue",
pch = 18,
cex = 2)
text(media_fe, 1.25,
labels = paste("Media:", media_fe),
col = "blue",
font = 2,
cex = 0.9)
text(mediana_fe, 0.75,
labels = paste("Mediana:", mediana_fe),
col = "darkred",
font = 2,
cex = 0.9)
# Leyenda
legend("topright",
legend = paste("Atípicos detectados:", n_outliers),
pch = 21,
pt.bg = "red",
bty = "n",
text.col = "darkred",
cex = 0.9)
#----------------------- 3. BOXPLOT: DISTRIBUCIÓN LIMPIA (HIERRO) -----------------------
par(mar=c(5, 6, 5, 2))
# Generación del Boxplot sin valores atípicos (outline = FALSE)
boxplot(Fe_VAR,
horizontal = TRUE,
outline = FALSE,
col = "indianred",
border = "darkred",
main = "Gráfica 8: Distribución del Hierro (Sin Atípicos)",
xlab = "Concentración de Hierro (%)",
frame = FALSE)
# Agregar cuadrícula de fondo para facilitar la lectura
grid(nx = NULL,
ny = NA,
col = "gray85",
lty = "dashed")
# Valores sobre la vista limpia (Media en azul y Mediana del color del borde)
points(media_fe, 1,
col = "blue",
pch = 18,
cex = 2)
text(media_fe, 1.25,
labels = paste("Media:", media_fe),
col = "blue",
font = 2,
cex = 0.9)
text(mediana_fe, 0.75,
labels = paste("Mediana:", mediana_fe),
col = "darkred",
font = 2,
cex = 0.9)
RESUMEN DESCRIPTIVO
# Cargar las librerías necesarias
library(dplyr)
library(gt)
library(e1071) # Necesaria para los cálculos de Asimetría y Curtosis
#----------------------- ANÁLISIS ESTADÍSTICO Fe_pct_AES_ST -----------------------
# 0. Limpieza automática de nombres (elimina espacios invisibles)
colnames(datos) <- trimws(colnames(datos))
# 1. Preparación de la variable y cálculos estadísticos
if("Fe_pct_AES_ST" %in% colnames(datos)) {
# Conversión a numérico (reemplazo de coma por punto)
datos$Fe_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Fe_pct_AES_ST))))
# 2. Limpieza de valores nulos o negativos para el análisis real de Ley
Fe_LIMPIA <- datos$Fe_pct_AES_ST[!is.na(datos$Fe_pct_AES_ST) & datos$Fe_pct_AES_ST >= 0]
# 3. Matriz de parámetros estadísticos descriptivos
resumen_stats_Fe <- data.frame(
Estadistico = c("Tamaño muestral (n)",
"Mínimo (%)",
"Máximo (%)",
"Media (%)",
"Mediana (%)",
"Desviación Estándar",
"Coef. Variación (%)",
"Asimetría",
"Curtosis"),
Valor = c(
length(Fe_LIMPIA),
min(Fe_LIMPIA),
max(Fe_LIMPIA),
mean(Fe_LIMPIA),
median(Fe_LIMPIA),
sd(Fe_LIMPIA),
(sd(Fe_LIMPIA) / mean(Fe_LIMPIA)) * 100,
skewness(Fe_LIMPIA, type = 2),
kurtosis(Fe_LIMPIA)
)
)
# 4. Redondeo técnico uniforme a dos decimales
resumen_stats_Fe$Valor <- round(resumen_stats_Fe$Valor, 2)
} else {
stop("¡ERROR! La columna 'Fe_pct_AES_ST' no existe en el dataset. Verifique el nombre en su archivo de origen.")
}
#----------------------- SALIDA ESTÉTICA CON 'gt' -----------------------
tabla_stats_fe_gt <- resumen_stats_Fe %>%
gt() %>%
tab_header(
title = md("**Tabla N° 3**"),
subtitle = md("Estadística Descriptiva para Concentraciones de Hierro (Fe)")
) %>%
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 en el reporte
tabla_stats_fe_gt
| Tabla N° 3 | |
| Estadística Descriptiva para Concentraciones de Hierro (Fe) | |
| Parámetro Estadístico | Resultado |
|---|---|
| Tamaño muestral (n) | 1335.00 |
| Mínimo (%) | 0.01 |
| Máximo (%) | 68.60 |
| Media (%) | 13.76 |
| Mediana (%) | 8.36 |
| Desviación Estándar | 14.69 |
| Coef. Variación (%) | 106.74 |
| Asimetría | 1.30 |
| Curtosis | 1.00 |
| Autores: Grupo 1 Semestre 2026 - 2026 |
|
CONCLUSIÓN DE LA VARIABLE FE_pct_AES_ST
El estudio estadístico aplicado a 1335.00 muestras de hierro establece un rango de leyes entre 0.01% y 68.60%. El yacimiento registra una media de 13.76% y una mediana de 8.36%, denotando una importante heterogeneidad interna sustentada por una desviación estándar de 14.69 y un coeficiente de variación de 106.74%. Finalmente, los estadísticos de forma ratifican una distribución asimétrica positiva de 1.30 junto a una curtosis de 1.00, demostrando que el volumen de roca está compuesto mayoritariamente por leyes moderadas a bajas, alternadas puntualmente con zonas de enriquecimiento supérgeno o primario de alta ley.