Análisis Estadístico por Variables Cuantitativas S_pct_AES_ST
Grupo 1
2026-05-31
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/Martin/Desktop/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" ...
## $ X0 : chr "30/6/2011" "31/8/2011" "31/8/2011" "31/8/2011" ...
## $ COLLECTION : chr "Mackay-Keck Ore Deposits Collection" "Mackay-Stanford Ore Deposits Collection" "Mackay-Stanford Ore Deposits Collection" "Mackay-Stanford Ore Deposits Collection" ...
## $ COLLECTION_ID : chr "PHNC08_39_1183" "OD21441" "OD22811" "OD25716" ...
## $ CONTINENT : chr "North America" "South America" "South America" "Africa" ...
## $ COUNTRY : chr "United States" "Chile" "Chile" "South Africa" ...
## $ STATE_PROVINCE : chr "Nevada" "Antofagasta" "Tarapacá" "Transvaal" ...
## $ COUNTY : chr "Lyon" "El Loa" "El Tamarugal" "" ...
## $ DISTRICT_NAME : chr "Yerington" "Chuquicamata" "Collahuasi/Quebrada Blanca" "" ...
## $ DEPOSIT_NAME : chr "Pumpkin Hollow" "" "" "" ...
## $ MINE_NAME : chr "Pumpkin Hollow" "Chuquicamata mine" "Collahuasi district" "" ...
## $ DISTRICT_NAME_COLLECT: chr "Yerington" "" "" "" ...
## $ DEPOSIT_NAME_COLLECT : chr "" "" "" "" ...
## $ MINE_NAME_COLLECT : chr "Pumpkin Hollow" "Chuquicamata" "Poduosa mine" "Messina Mines Ltd." ...
## $ LOCATE_DESC : chr "" "" "Level 25" "" ...
## $ LATITUDE : chr "38,94021" "-22,2871" "-21,0309" "-24,7" ...
## $ LONGITUDE : chr "-119,05178" "-68,8991" "-68,74951" "29,3" ...
## $ DATUM : chr "WGS84" "WGS84" "WGS84" "" ...
## $ LATITUDE_COLLECT : chr "38,92492" "22,28944" "" "" ...
## $ LONGITUDE_COLLECT : chr "-119,1071" "-68,90111" "" "" ...
## $ DATUM_COLLECT : chr "" "WGS84" "" "" ...
## $ COORDINATES_QUAL : chr "100 m" "0m" "" "" ...
## $ COORDINATES_SOURCE : chr "1) iTouchMap.com, approx, A. Orkild-Norton; 2) Mineral Resource Deposit Database Deposit ID 10174173, ore body, M. Granitto" "1) Mindat.org, approx, A. Orkild-Norton; 2) Open-File Report 2017-1079 ID 549, mine, M. Granitto" "1) No coordinates; 2) Mineral Resource Deposit Database Deposit ID 10057511, district, M. Granitto" "1) No coordinates; 2) Google Earth Pro, approx ctr of former province of Transvaal, M. Granitto" ...
## $ PRIMARY_CLASS : chr "rock" "rock" "rock" "rock" ...
## $ SYSTEM_TYPE : chr "IOA-IOCG" "Porphyry Cu-Mo-Au" "Porphyry Cu-Mo-Au" "IOA-IOCG" ...
## $ DEPOSIT_TYPE : chr "IOCG" "Supergene Cu" "Porphyry Cu" "IOCG" ...
## $ SAMPLE_DESC : chr "Nearly solid chalcopyrite mixed with small light brown irregular inclusions of unknown mineralogy; clouds of ma"| __truncated__ "Chalcocite-bronchatite-antlerite(?); highly microfractured igneous rock with green copper sulfates coating microfractures" "Bornite-chalcopyrite; mostly massive chalcopyrite with numerous inclusions of micro-chalcopyrite and widely sca"| __truncated__ "Massive chalcopyrite, IOCG in shear zone; mostly massive fine grain cuprite with widely distributed malachite t"| __truncated__ ...
## $ Al_pct_AES_ST : chr "0,33" "6,65" "0,46" "0,7" ...
## $ Ca_pct_AES_ST : chr "1,1" "0,4" "-0,1" "0,3" ...
## $ Fe_pct_AES_ST : chr "42,4" "0,25" "6,98" "27,8" ...
## $ K_pct_AES_ST : chr "-0,1" "6,1" "0,2" "-0,1" ...
## $ Mg_pct_AES_ST : chr "0,57" "0,1" "0,01" "0,33" ...
## $ Mn_pct_AES_ST : chr "0,02" "-0,01" "-0,01" "-0,01" ...
## $ P_pct_AES_ST : chr "-0,01" "0,01" "0,05" "0,01" ...
## $ S_pct_AES_ST : chr "" "" "" "" ...
## $ Si_pct_AES_ST : chr "" "" "" "" ...
## $ Ti_pct_AES_ST : chr "0,01" "0,11" "-0,01" "-0,01" ...
## $ F_pct_ISE_Fuse : chr "" "" "" "" ...
## $ Ag_ppm_MS_ST : chr "58" "6" "468" "16" ...
## $ As_ppm_MS_ST : chr "-30" "-30" "90" "-30" ...
## $ Au_ppm : chr "" "" "" "" ...
## $ Au_AM : chr "" "" "" "" ...
## $ B_ppm_AES_ST : int NA NA NA NA NA NA NA NA NA NA ...
## $ Ba_ppm_AES_ST : chr "-0,5" "924" "121" "174" ...
## $ Be_ppm_AES_ST : int -5 -5 -5 -5 -5 -5 -5 -5 -5 -5 ...
## $ Bi_ppm_MS_ST : chr "1,5" "3,6" "190" "0,4" ...
## $ Cd_ppm_MS_ST : chr "3,6" "-0,2" "0,9" "-0,2" ...
## $ Ce_ppm_MS_ST : chr "0,4" "8,8" "16,3" "3,5" ...
## $ Co_ppm_MS_ST : chr "209" "-0,5" "1,3" "44,8" ...
## $ Cr_ppm_AES_ST : int -10 -10 -10 30 20 20 60 40 20 10 ...
## $ Cs_ppm_MS_ST : chr "0,5" "1,4" "0,2" "-0,1" ...
## $ Cu_ppm_AES_ST : chr "50000,11111" "23300" "50000,11111" "50000,11111" ...
## $ Dy_ppm_MS_ST : chr "-0,05" "0,32" "1,38" "0,37" ...
## $ Er_ppm_MS_ST : chr "-0,05" "0,22" "0,77" "0,23" ...
## $ Eu_ppm_MS_ST : chr "-0,05" "0,14" "0,17" "0,1" ...
## $ Ga_ppm_MS_ST : chr "5" "15" "6" "3" ...
## $ Gd_ppm_MS_ST : chr "-0,05" "0,45" "1,5" "0,39" ...
## $ Ge_ppm_MS_ST : int -1 5 -1 -1 3 8 8 1 2 2 ...
## $ Hf_ppm_MS_ST : int -1 4 -1 -1 5 13 12 2 3 6 ...
## $ Ho_ppm_MS_ST : chr "-0,05" "0,07" "0,25" "0,07" ...
## $ In_ppm_MS_ST : chr "6,4" "-0,2" "3,7" "0,2" ...
## $ La_ppm_MS_ST : chr "0,2" "4,6" "7,2" "1,7" ...
## $ Li_ppm_AES_ST : int -10 -10 -10 -10 30 20 20 20 -10 20 ...
## $ Lu_ppm_MS_ST : chr "-0,05" "-0,05" "0,08" "-0,05" ...
## $ Mo_ppm_MS_ST : chr "-2" "60" "3" "2" ...
## $ Nb_ppm_MS_ST : chr "-1" "4" "-1" "-1" ...
## $ Nd_ppm_MS_ST : chr "0,2" "3,8" "9,1" "1,7" ...
## $ Ni_ppm_AES_ST : chr "144" "6" "-5" "48" ...
## $ Pb_ppm_MS_ST : chr "23" "16" "188" "39" ...
## $ Pd_ppm_FA_MS : chr "" "" "" "" ...
## $ Pr_ppm_MS_ST : chr "-0,05" "1,09" "2,21" "0,46" ...
## $ Pt_ppm_FA_MS : chr "" "" "" "" ...
## $ Rb_ppm_MS_ST : chr "1,2" "148" "7,1" "0,7" ...
## $ Re_ppm_MS_HF : chr "" "" "" "" ...
## $ Sb_ppm_MS_ST : chr "1,2" "2,4" "2,9" "0,3" ...
## $ Sc_ppm_AES_ST : int -5 -5 -5 -5 11 6 15 10 5 6 ...
## $ Se_ppm_MS_ST : int NA NA NA NA NA NA NA NA NA NA ...
## $ Sm_ppm_MS_ST : chr "-0,1" "0,6" "1,6" "0,4" ...
## $ Sn_ppm_MS_ST : chr "2" "3" "106" "-1" ...
## $ Sr_ppm_AES_ST : chr "26,6" "114" "22,5" "38,4" ...
## $ Ta_ppm_MS_ST : chr "-0,5" "-0,5" "-0,5" "-0,5" ...
## $ Tb_ppm_MS_ST : chr "-0,05" "0,07" "0,23" "-0,05" ...
## $ Te_ppm_MS_ST : chr "" "" "" "" ...
## $ Th_ppm_MS_ST : chr "0,2" "9,7" "2,6" "0,2" ...
## $ Tl_ppm_MS_ST : chr "-0,5" "0,5" "-0,5" "-0,5" ...
## $ Tm_ppm_MS_ST : chr "-0,05" "-0,05" "0,08" "-0,05" ...
## $ U_ppm_MS_ST : chr "0,3" "1,75" "0,63" "34,8" ...
## $ V_ppm_AES_ST : int 51 24 -5 493 68 20 40 159 39 61 ...
## $ W_ppm_MS_ST : chr "-1" "28" "22" "11" ...
## [list output truncated]Se cargaron los datos de todas las variables.
ANÁLISIS DE FRECUENCIAS: CONCENTRACIÓN DE AZUFRE (S)
library(dplyr)
library(gt)
#----------------------- PROCESAMIENTO S_pct_AES_ST -----------------------
# 1. Limpieza y preparación de la variable
datos$S_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$S_pct_AES_ST))))
# Separar registros con concentraciones válidas de los nulos/negativos
s_numerico <- datos$S_pct_AES_ST[datos$S_pct_AES_ST >= 0 & !is.na(datos$S_pct_AES_ST)]
n_sin_datos <- sum(is.na(datos$S_pct_AES_ST) | datos$S_pct_AES_ST < 0)
# 2. Tabla de Frecuencias de los valores geoquímicos reales
TDF_VALIDOS <- as.data.frame(table(s_numerico), stringsAsFactors = FALSE)
colnames(TDF_VALIDOS) <- c("CATEGORIA", "ni")
# Convertir categoría a numérico para ordenar de menor a mayor concentración (%)
TDF_VALIDOS$CATEGORIA <- as.numeric(TDF_VALIDOS$CATEGORIA)
TDF_VALIDOS <- TDF_VALIDOS[order(TDF_VALIDOS$CATEGORIA), ]
# Definición de horizontes cuantitativos
total_variable <- sum(TDF_VALIDOS$ni) # Total de muestras con datos de S
total_general <- total_variable + n_sin_datos # Total absoluto de la matriz
# 3. Agrupación: Top 10 valores de concentración más bajos + Otros
if(nrow(TDF_VALIDOS) > 10) {
tabla_top <- head(TDF_VALIDOS, 10)
sum_otros <- sum(TDF_VALIDOS$ni[11:nrow(TDF_VALIDOS)])
fila_otros <- data.frame(CATEGORIA = "Otras Concentraciones", ni = sum_otros)
tabla_final_base <- rbind(tabla_top, fila_otros)
} else {
tabla_final_base <- TDF_VALIDOS
}
# Convertir CATEGORIA a carácter para permitir la unión de las filas de totales
tabla_final_base$CATEGORIA <- as.character(tabla_final_base$CATEGORIA)
# 4. Calcular frecuencias (hi) escaladas a 100 respecto al total general
tabla_final_base$hi <- round((tabla_final_base$ni / total_general) * 100, 4)
# 5. FILA DEL TOTAL EXCLUSIVO DE LA VARIABLE (Muestras con lecturas de S)
fila_total_var <- data.frame(
CATEGORIA = "TOTAL VARIABLE (S)",
ni = total_variable,
hi = round((total_variable / total_general) * 100, 4)
)
# 6. FILA DE CONTRASTE: REGISTROS SIN INFORMACIÓN ANALÍTICA
fila_sin_datos <- data.frame(
CATEGORIA = "Sin Datos",
ni = n_sin_datos,
hi = round((n_sin_datos / total_general) * 100, 4)
)
# 7. FILA DEL TOTAL GENERAL DEL PROYECTO
fila_total_general <- data.frame(
CATEGORIA = "TOTAL GENERAL",
ni = total_general,
hi = 100 # Forzado para cierre perfecto de balance estadístico
)
# Consolidar toda la matriz de datos en orden lógico estructurado
tabla_final <- rbind(tabla_final_base, fila_total_var, fila_sin_datos, fila_total_general)
colnames(tabla_final) <- c("Valor S (%)", "ni", "hi")
#----------------------- GENERAR SALIDA ESTÉTICA CON 'gt' -----------------------
tabla_s_completa_gt <- tabla_final %>%
gt() %>%
tab_header(
title = md("**Tabla N° 1**"),
subtitle = md("Distribución de frecuencias para concentraciones de Azufre (S)")
) %>%
tab_source_note(
source_note = md("Autores: Grupo 1 <br> Semestre 2026 - 2026")
) %>%
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 en el documento
tabla_s_completa_gt| Tabla N° 1 | ||
| Distribución de frecuencias para concentraciones de Azufre (S) | ||
| Valor S (%) | ni | hi |
|---|---|---|
| 0.1 | 16 | 1.1713 |
| 0.2 | 17 | 1.2445 |
| 0.3 | 13 | 0.9517 |
| 0.4 | 8 | 0.5857 |
| 0.5 | 13 | 0.9517 |
| 0.6 | 6 | 0.4392 |
| 0.7 | 8 | 0.5857 |
| 0.8 | 8 | 0.5857 |
| 0.9 | 9 | 0.6589 |
| 1 | 11 | 0.8053 |
| Otras Concentraciones | 415 | 30.3807 |
| TOTAL VARIABLE (S) | 524 | 38.3602 |
| Sin Datos | 842 | 61.6398 |
| TOTAL GENERAL | 1366 | 100.0000 |
| Autores: Grupo 1 Semestre 2026 - 2026 |
||
ANÁLISIS DESCRIPTIVO Y AGRUPACIÓN EN CLASES (STRUGES) DEL AZUFREPOLÍGONO DE FRECUENCIA
ANÁLISIS DESCRIPTIVO Y AGRUPACIÓN EN CLASES (STRUGES) DEL AZUFRE
# Cargar las librerías al inicio
library(dplyr)
library(gt)
#------------------------- PREPARACIÓN DE DATOS -------------------------
datos$S_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$S_pct_AES_ST))))
# Creamos la variable de trabajo S asegurando que los datos estén limpios y sin negativos
S <- datos$S_pct_AES_ST[!is.na(datos$S_pct_AES_ST) & datos$S_pct_AES_ST >= 0]
#------------------------- ANÁLISIS DE CONCENTRACIÓN (ESTADÍSTICOS) -------------------------
cat("\n=======================================================\n")##
## =======================================================cat("ANÁLISIS DE CONCENTRACIÓN (S_pct_AES_ST):\n")## ANÁLISIS DE CONCENTRACIÓN (S_pct_AES_ST):cat("La concentración promedio es: ", round(mean(S, na.rm = TRUE), 3), " % \n")## La concentración promedio es: 9.137 %cat("La concentración máxima detectada es: ", max(S, na.rm = TRUE), " % \n")## La concentración máxima detectada es: 44 %cat("Total de muestras analizadas: ", sum(!is.na(S)), " registros \n")## Total de muestras analizadas: 524 registroscat("=======================================================\n")## =======================================================#------------------------- TABLA DE FRECUENCIAS - STURGES -------------------------
# 1. Parámetros básicos: Rango, Número de clases (Sturges) y Amplitud
R <- max(S, na.rm = TRUE) - min(S, na.rm = TRUE)
k <- floor(1 + 3.322 * log10(length(S)))
A <- R / k
# 2. Definición de límites y Marcas de Clase (MC)
liminf <- seq(from = min(S, na.rm = TRUE), by = A, length.out = k)
limsup <- liminf + A
MC <- (liminf + limsup) / 2
# 3. Conteo de frecuencias absolutas por clase (n)
n <- numeric(k)
for (i in 1:k) {
if (i == k) {
n[i] <- sum(S >= liminf[i] & S <= limsup[i], na.rm = TRUE)
} else {
n[i] <- sum(S >= liminf[i] & S < 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 -------------------------
TablaS_Sturges <- data.frame(
Clase = as.character(1:k),
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
fila_totales_S <- data.frame(
Clase = "**TOTALES**",
liminf = NA,
limsup = NA,
MC = NA,
n = sum(n),
hi = 100,
Ni_asc = NA,
Hi_asc = NA,
Ni_desc = NA,
Hi_desc = NA
)
# Unión de cuerpo y totales
TablaS_Final <- rbind(TablaS_Sturges, fila_totales_S)
#------------------------- MOSTRAR TABLA FINAL CON 'gt' -------------------------
tabla_sturges_s_gt <- TablaS_Final %>%
gt() %>%
tab_header(
title = md("**Tabla N° 2**"),
subtitle = md("Distribución de frecuencias para concentraciones de Azufre (S_pct_AES_ST) <br> mediante Regla de Sturges")
) %>%
tab_source_note(
source_note = md("Autores: Grupo 1 <br> Semestre 2026 - 2026")
) %>%
fmt_markdown(columns = Clase) %>%
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 reporte
tabla_sturges_s_gt| Tabla N° 2 | |||||||||
| Distribución de frecuencias para concentraciones de Azufre (S_pct_AES_ST) mediante Regla de Sturges |
|||||||||
| Clase | Linf (%) | Lsup (%) | MC (%) | n (abs) | hi (%) | Ni (↑) | Hi (↑) | Ni (↓) | Hi (↓) |
|---|---|---|---|---|---|---|---|---|---|
| 1 | 0.10 | 4.49 | 2.295 | 240 | 45.80 | 240 | 45.80 | 524 | 100.00 |
| 2 | 4.49 | 8.88 | 6.685 | 85 | 16.22 | 325 | 62.02 | 284 | 54.20 |
| 3 | 8.88 | 13.27 | 11.075 | 57 | 10.88 | 382 | 72.90 | 199 | 37.98 |
| 4 | 13.27 | 17.66 | 15.465 | 46 | 8.78 | 428 | 81.68 | 142 | 27.10 |
| 5 | 17.66 | 22.05 | 19.855 | 31 | 5.92 | 459 | 87.60 | 96 | 18.32 |
| 6 | 22.05 | 26.44 | 24.245 | 23 | 4.39 | 482 | 91.98 | 65 | 12.40 |
| 7 | 26.44 | 30.83 | 28.635 | 18 | 3.44 | 500 | 95.42 | 42 | 8.02 |
| 8 | 30.83 | 35.22 | 33.025 | 11 | 2.10 | 511 | 97.52 | 24 | 4.58 |
| 9 | 35.22 | 39.61 | 37.415 | 8 | 1.53 | 519 | 99.05 | 13 | 2.48 |
| 10 | 39.61 | 44.00 | 41.805 | 5 | 0.95 | 524 | 100.00 | 5 | 0.95 |
| TOTALES | NA | NA | NA | 524 | 100.00 | NA | NA | NA | NA |
| Autores: Grupo 1 Semestre 2026 - 2026 |
|||||||||
POLÍGONO DE FRECUENCIA
POLÍGONO DE FRECUENCIAS ABSOLUTAS DEL AZUFRE (S)
#----------------------- PROCESAMIENTO AUTOMÁTICO S_PCT_AES_ST -----------------------
# 1. Conversión de la variable a numérico y limpieza de datos
datos$S_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$S_pct_AES_ST))))
S_VAR <- datos$S_pct_AES_ST[!is.na(datos$S_pct_AES_ST) & datos$S_pct_AES_ST >= 0]
#----------------------- EXTRACCIÓN METODOLÓGICA DE STURGES -----------------------
# 2. Parámetros base desde la tabla
n_total <- length(S_VAR)
k_sturges <- floor(1 + 3.322 * log10(n_total))
rango_s <- max(S_VAR) - min(S_VAR)
amplitud_s <- rango_s / k_sturges
breaks_sturges <- seq(from = min(S_VAR), by = amplitud_s, length.out = k_sturges + 1)
# 3. Captura de datos en memoria (plot = FALSE)
hist_objeto <- hist(S_VAR, breaks = breaks_sturges, plot = FALSE, right = FALSE)
# Extraemos las Marcas de Clase (MC) reales del gráfico
mc_reales <- hist_objeto$mids
# Convertimos los conteos absolutos a frecuencias relativas porcentuales (hi %)
hi_porcentaje <- (hist_objeto$counts / n_total) * 100
#----------------------- ANCLAJE A CERO CON MARCAS DE CLASE -----------------------
# 4. Creamos los extremos ficticios para que el polígono toque el eje X en cero
mc_inicio <- mc_reales[1] - amplitud_s
mc_final <- mc_reales[length(mc_reales)] + amplitud_s
# Unimos los puntos: Marcas de Clase (X) y Frecuencias Relativas hi (Y)
marcas_clase_s <- c(mc_inicio, mc_reales, mc_final)
frecuencias_hi_s <- c(0, hi_porcentaje, 0)
# Detectamos el porcentaje máximo real para calibrar el eje Y
max_y_hi <- max(frecuencias_hi_s)
#----------------------- GRAFICAR POLÍGONO DE FRECUENCIAS (hi) -----------------------
par(mar = c(6, 5, 4, 2)) # Margen inferior ligeramente amplio para las MC verticales
# 5. Inicializar el lienzo ajustado a las Marcas de Clase y porcentajes
plot(marcas_clase_s, frecuencias_hi_s,
type = "n",
main = "Gráfica 1: Polígono de Frecuencias Relativas de Azufre (S)",
xlab = "Concentración de S (%)",
ylab = "Frecuencia Relativa - hi (%)",
xlim = c(mc_inicio, mc_final),
ylim = c(0, max_y_hi * 1.1), # Un 10% de espacio arriba del pico más alto
xaxt = "n", yaxt = "n",
panel.first = grid(nx = NULL, ny = NULL, col = "gray90")) # Rejilla de fondo
# 6. DIBUJAR EL POLÍGONO
lines(marcas_clase_s, frecuencias_hi_s, type = "l", col = "darkblue", lwd = 3)
# Luego dibujamos los puntos (pch=19) ÚNICAMENTE en las marcas de clase reales de tu tabla
points(mc_reales, hi_porcentaje, pch = 19, col = "darkblue", cex = 1.2)
# 7. Relleno translúcido bajo la curva
polygon(marcas_clase_s, frecuencias_hi_s, col = rgb(0, 0, 0.5, 0.12), border = NA)
#----------------------- PERSONALIZACIÓN DE EJES CONTINUOS -----------------------
# Eje X: Imprime las Marcas de Clase
axis(1, at = mc_reales, labels = round(mc_reales, 2), cex.axis = 0.75, las = 1)
# Eje Y: Valores horizontales dinámicos calculados a partir de los datos
marcas_eje_y <- pretty(c(0, max_y_hi))
axis(2, at = marcas_eje_y,
labels = paste0(marcas_eje_y, "%"),
las = 1, cex.axis = 0.8)
ANÁLISIS GRÁFICO: HISTOGRAMA DISTRIBUCIÓN DE AZUFRE
HISTOGRAMA DISTRIBUCIÓN DE AZUFRE
#----------------------- PROCESAMIENTO S_pct_AES_ST -----------------------
# 1. Conversión de S_pct_AES_ST a numérico (blindado contra comas y textos)
datos$S_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$S_pct_AES_ST))))
# Creamos variable de trabajo para las gráficas y FILTRAMOS los negativos
S_VAR <- datos$S_pct_AES_ST
S_VAR <- S_VAR[S_VAR >= 0 & !is.na(S_VAR)]
#----------------------- TABLA DE FRECUENCIAS SIMPLIFICADA -----------------------
# Al ser continua, agrupamos por rangos automáticos (bins) para que la tabla sea legible
k_simplificado <- 5
breaks_s <- pretty(S_VAR, n = k_simplificado)
HistogramaS <- hist(S_VAR, breaks = breaks_s, plot = FALSE)
# 2. Generación del Histograma
hist(S_VAR,
breaks = breaks_s,
main = "Grafica 2: Distribucion de S_pct_AES_ST (Simplificada)",
xlab = "Concentracion de S (%)",
ylab = "Cantidad de muestras",
col = "lightgreen",
right = FALSE)
# ==============================================================================
# 1. PREPARACIÓN DE DATOS (MÉTODO STURGES)
# ==============================================================================
# Aseguramos limpieza y extracción de la variable
datos$S_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$S_pct_AES_ST))))
S_VAR <- datos$S_pct_AES_ST[!is.na(datos$S_pct_AES_ST) & datos$S_pct_AES_ST >= 0]
# ==============================================================================
# 2. CONFIGURACIÓN METODOLÓGICA (STURGES)
# ==============================================================================
k_sturges <- floor(1 + 3.322 * log10(length(S_VAR)))
rango_s <- max(S_VAR) - min(S_VAR)
amplitud_s <- rango_s / k_sturges
breaks_sturges <- seq(from = min(S_VAR), by = amplitud_s, length.out = k_sturges + 1)
# CREACIÓN CRÍTICA DEL OBJETO (Aquí se define para evitar el error)
hist_pro <- hist(S_VAR, breaks = breaks_sturges, plot = FALSE, right = FALSE)
# ==============================================================================
# 3. TEXTOS Y COLORES
# ==============================================================================
colores_degrade <- colorRampPalette(c("cyan", "blue", "purple"))(k_sturges)
etiquetas_intervalos <- paste0("[", round(breaks_sturges[1:k_sturges], 2), " - ",
round(breaks_sturges[2:(k_sturges+1)], 2), "]")
# ==============================================================================
# 4. CONSTRUCCIÓN DE LA GRÁFICA
# ==============================================================================
par(mar = c(6, 5, 4, 11))
# Guardamos el barplot en un objeto 'bp' para obtener las coordenadas exactas de las barras
bp <- barplot(hist_pro$counts,
names.arg = rep("", k_sturges),
col = colores_degrade,
border = "white",
main = "Grafica 3: Distribucion de S_pct_AES_ST (Regla de Sturges)",
ylab = "Frecuencia (Cantidad)",
xlab = "Contenido de Azufre (%)",
ylim = c(0, max(hist_pro$counts) * 1.1),
yaxt = "n")
# Añadir frecuencias arriba de cada barra
text(x = bp,
y = hist_pro$counts,
labels = hist_pro$counts,
pos = 3, cex = 0.85, font = 2)
# ==============================================================================
# 5. PERSONALIZACIÓN DE EJES Y LEYENDA
# ==============================================================================
# Eje Y
marcas_y <- pretty(c(0, max(hist_pro$counts)))
axis(2, at = marcas_y, labels = marcas_y, las = 1, cex.axis = 0.85)
# 6. EJE X
# Calculamos los puntos de quiebre de las barras
ancho_barra <- bp[2] - bp[1]
posiciones_bordes_x <- c(bp - (ancho_barra / 2), max(bp) + (ancho_barra / 2))
# Dibujamos el eje X usando todos los breaks de Sturges
axis(1, at = posiciones_bordes_x,
labels = round(breaks_sturges, 1), cex.axis = 0.7)
# 7. Leyenda a la derecha
legend(x = max(bp) + (ancho_barra * 1.5), y = max(hist_pro$counts),
legend = etiquetas_intervalos,
fill = colores_degrade,
title = "Intervalos (%)",
xpd = TRUE, bty = "n", cex = 0.8)
ANÁLISIS VISUAL ACUMULADO: OJIVA ASCENDENTE Y DESCENDENTE
OJIVAS ni Y hi
#----------------------- PREPARACIÓN DE CORTES ENTEROS -----------------------
paso_s <- if (ceiling(max(S_VAR)) > 25) 5 else 1
breaks_entero <- seq(0, ceiling(max(S_VAR)) + paso_s, by = paso_s)
#----------------------- OJIVA INTEGRADA Y PROFESIONAL -----------------------
par(mar=c(5, 5, 4, 2))
plot(MC, Ni_asc,
main = "Gráfica 4: Ojiva Combinada de Frecuencias del Azufre (ni)",
xlab = "Contenido de Azufre (%)",
ylab = "Frecuencia Acumulada (N muestras)",
type = "b", pch = 19, col = "blue", 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 = "red", lwd = 3, lty = 2)
# Eje X con los intervalos exactos
axis(1, at = breaks_entero, labels = breaks_entero)
# Leyenda reubicada en el espacio vacío del lado derecho
legend("right",
legend = c("Acumulada Menor que (Ascendente)", "Acumulada Mayor que (Descendente)"),
col = c("blue", "red"),
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 AZUFRE - EN PORCENTAJES (Hi) -----------------------
MC_graficar <- MC[!is.na(MC)]
Hi_asc_graficar <- Hi_asc[1:length(MC_graficar)]
Hi_desc_graficar <- Hi_desc[1:length(MC_graficar)]
# Definir los cortes del eje X
breaks_s <- c(liminf[!is.na(liminf)], limsup[length(limsup) - 1])
# 2. Configurar los márgenes para la leyenda
par(mar=c(5, 5, 4, 2))
# 3. Graficar la curva ascendente
plot(MC_graficar, Hi_asc_graficar,
main = "Gráfica 5 : Ojiva Acumulada de Frecuencias de Azufre (hi)",
xlab = "Concentración de Azufre - S (%)",
ylab = "Frecuencia Relativa Acumulada (%)",
type = "b", pch = 19, col = "blue", lwd = 3,
xaxt = "n", las = 1,
ylim = c(0, 105),
panel.first = grid(nx = NULL, ny = NULL, col = "gray90"))
# 4. Línea descendente perfectamente emparejada
lines(MC_graficar, Hi_desc_graficar, type = "b", pch = 17, col = "red", lwd = 3, lty = 2)
# 5. Dibujar el Eje X con los intervalos exactos
axis(1, at = breaks_s, labels = round(breaks_s, 2), cex.axis = 0.8)
# 6. Leyenda técnica reubicada
legend("right",
legend = c("Acumulada Menor que (Ascendente %)", "Acumulada Mayor que (Descendente %)"),
col = c("blue", "red"),
lty = c(1, 2),
pch = c(19, 17),
lwd = 2,
title = "Tipo de Ojiva",
bty = "n",
cex = 0.85)
BOXPLOT
BOXPLOTS DE VALORES ATÍPICOS Y DISTRIBUCIÓN LIMPIA
#----------------------- PREPARACIÓN DE DATOS (Azufre) -----------------------
# Conversión a numérico y limpieza de valores nulos o en cero
datos$S_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$S_pct_AES_ST))))
S_VAR <- datos$S_pct_AES_ST[!is.na(datos$S_pct_AES_ST) & datos$S_pct_AES_ST > 0]
#----------------------- BOXPLOT: ANÁLISIS DE VALORES ATÍPICOS -----------------------
par(mar=c(5, 6, 5, 2), xpd = FALSE)
# Cálculos estadísticos previos
stats_s <- boxplot.stats(S_VAR)
media_s <- round(mean(S_VAR), 3)
mediana_s <- round(median(S_VAR), 3)
n_outliers <- length(stats_s$out)
# Generación del Boxplot
boxplot(S_VAR, horizontal = TRUE, col = "#E0E0E0", border = "#424242",
main = " Gráfica 6: Análisis de Valores Atípicos (Azufre)",
xlab = "Concentración de S (%)",
pch = 21,
bg = "red",
col.outline = "darkred",
frame = FALSE)
# Punto de Media y etiquetas de texto mejor ubicadas
points(media_s, 1,
col = "blue",
pch = 18,
cex = 2)
text(media_s, 1.25,
labels = paste("Media:", media_s),
col = "blue",
font = 2,
cex = 0.9)
text(mediana_s, 0.75,
labels = paste("Mediana:", mediana_s),
col = "#424242",
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)
#-----------------------BOXPLOT: DISTRIBUCIÓN LIMPIA (AZUFRE) -----------------------
par(mar=c(5, 6, 5, 2))
# Generación del Boxplot sin valores atípicos (outline = FALSE)
boxplot(S_VAR,
horizontal = TRUE,
outline = FALSE,
col = "#E0E0E0",
border = "#424242",
main = "Gráfica 7: Distribución del Cuerpo Mineral (Sin Atípicos) - Azufre",
xlab = "Concentración de S (%)",
frame = FALSE)
# Agregar cuadrícula de fondo
grid(nx = NULL,
ny = NA,
col = "gray85",
lty = "dashed")
# Valores sobre la vista limpia (Media en naranja/óxido y Mediana alineada al borde)
points(media_s, 1,
col = "#E65100",
pch = 18,
cex = 2)
text(media_s, 1.25,
labels = paste("Media:", media_s),
col = "#BF360C",
font = 2,
cex = 0.9)
text(mediana_s, 0.75,
labels = paste("Mediana:", mediana_s),
col = "#424242",
font = 2,
cex = 0.9)
HISTOGRAMA CON BOXPLOT SUPERPUESTO (AZUFRE)
HISTOGRAMA CON BOXPLOT FLOTANTE (AZUFRE)
#----------------------- PREPARACIÓN DE DATOS -----------------------
datos$S_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$S_pct_AES_ST))))
S_VAR <- datos$S_pct_AES_ST[!is.na(datos$S_pct_AES_ST) & datos$S_pct_AES_ST >= 0]
# Metodología de Sturges
k_sturges <- floor(1 + 3.322 * log10(length(S_VAR)))
rango_s <- max(S_VAR) - min(S_VAR)
amplitud_s <- rango_s / k_sturges
breaks_sturges <- seq(from = min(S_VAR), by = amplitud_s, length.out = k_sturges + 1)
#----------------------- CÁLCULO DEL HISTOGRAMA (INVISIBLE) -----------------------
# Calculamos el histograma internamente para extraer datos
hist_pro <- hist(S_VAR, breaks = breaks_sturges, plot = FALSE, right = FALSE)
max_y <- max(hist_pro$counts)
#----------------------- CÁLCULO DEL RANGO X TOTAL -----------------------
# Calculamos el rango necesario para abarcar tanto las barras como los atípicos
xlim_range <- range(c(S_VAR, breaks_sturges))
# 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 paleta degradada
colores_degrade <- colorRampPalette(c("cyan", "blue", "purple"))(length(hist_pro$counts))
hist(S_VAR,
breaks = breaks_sturges,
col = colores_degrade,
border = "white",
main = "Gráfica 8: Distribución de Azufre con Boxplot Interno",
xlab = "Concentración de Azufre (%)",
ylab = "Frecuencia (Cantidad)",
xlim = xlim_range, # Asegura que todo el eje X sea visible
ylim = c(0, max_y * 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_sturges, labels = round(breaks_sturges, 2), font = 2, cex.axis = 0.5)
# 3. Superponemos el Boxplot directamente
boxplot(S_VAR,
horizontal = TRUE,
add = TRUE, # Superpone la gráfica
axes = FALSE, # Oculta ejes
at = max_y / 2, # Altura de flotación (mitad del eje Y)
boxwex = max_y / 3, # Grosor de la caja
col = rgb(0.53, 0.81, 0.98, alpha = 0.7), # Color 'skyblue' con 70% opacidad
border = "#1C1C1C", # Borde 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_s <- paste0("[", round(hist_pro$breaks[-length(hist_pro$breaks)], 2),
" - ", round(hist_pro$breaks[-1], 2), ")")
legend("topright", inset=c(-0.35, 0),
legend = intervalos_s,
fill = colores_degrade,
title = "Intervalos (%)",
cex = 0.8, bty = "n")
RESUMEN DESCRIPTIVO
RESUMEN DESCRIPTIVO
# Cargar las librerías al inicio
library(dplyr)
library(gt)
library(e1071) # Necesaria para el cálculo de Asimetría y Curtosis
#----------------------- ANÁLISIS ESTADÍSTICO S_pct_AES_ST -----------------------
# 1. Preparación de la variable continua
datos$S_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$S_pct_AES_ST))))
# 2. Limpieza de valores nulos o negativos
S_LIMPIA <- datos$S_pct_AES_ST[!is.na(datos$S_pct_AES_ST) & datos$S_pct_AES_ST >= 0]
# 3. Cálculos estadísticos descriptivos consolidados
resumen_stats_S <- 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(S_LIMPIA),
min(S_LIMPIA),
max(S_LIMPIA),
mean(S_LIMPIA),
median(S_LIMPIA),
sd(S_LIMPIA),
(sd(S_LIMPIA) / mean(S_LIMPIA)) * 100,
skewness(S_LIMPIA, type = 2),
kurtosis(S_LIMPIA)
)
)
# 4. Redondeo técnico para presentación en el reporte (3 decimales)
resumen_stats_S$Valor <- round(resumen_stats_S$Valor, 3)
#----------------------- SALIDA ESTÉTICA CON 'gt' -----------------------
tabla_stats_s_gt <- resumen_stats_S %>%
gt() %>%
tab_header(
title = md("**Tabla N° 3**"),
subtitle = md("Estadística Descriptiva para Concentraciones de Azufre (S)")
) %>%
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 en el documento de RMarkdown
tabla_stats_s_gt| Tabla N° 3 | |
| Estadística Descriptiva para Concentraciones de Azufre (S) | |
| Parámetro Estadístico | Resultado |
|---|---|
| Tamaño muestral (n) | 524.000 |
| Mínimo (Min) | 0.100 |
| Máximo (Max) | 44.000 |
| Media (x̄) | 9.137 |
| Mediana (Me) | 5.500 |
| Desviación Estándar (s) | 9.830 |
| Coef. Variación (CV) | 107.587 |
| Asimetría (As) | 1.353 |
| Curtosis (K) | 1.180 |
| Autores: Grupo 1 Semestre 2026 - 2026 |
|
CONCLUSION
El análisis descriptivo del azufre (S) sobre 524 muestras válidas reporta un rango de 0.100% a 44.000%, con una media de 9.137% y una mediana de 5.500%. Su coeficiente de variación (107.587%) y desviación estándar (9.830) reflejan una dispersión alta, característica del comportamiento geoquímico de este elemento. Finalmente, los índices de forma muestran una asimetría positiva de 1.353 y una curtosis de 1.180, lo que indica una distribución moderadamente asimétrica hacia valores bajos con presencia de valores atípicos que alteran la tendencia central, evidenciando la naturaleza de la mineralización en el sector estudiado.