Análisis Estadístico por Variables Cuantitativas Au_ppm
Grupo 1
2026-23-05
1. CARGA DE DATOS Y LIBRERIAS
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]# Cargar librerias necesarias
library(dplyr)##
## Adjuntando el paquete: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(gt)
library(e1071) # Necesaria para calcular Asimetría (skewness) y Curtosis (kurtosis)2. ANÁLISIS Y DISTRIBUCIÓN DE FRECUENCIAS: CONCENTRACIÓN DE ORO (Au)
CONCENTRACIÓN DE ORO (Au)
# Cargar las librerias necesarias
library(dplyr)
library(gt)
#----------------------- PROCESAMIENTO Au_ppm -----------------------
# 1. Conversión a numérico y cambio de comas por puntos
datos$Au_ppm <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Au_ppm))))
# Separar registros con concentraciones válidas de los nulos/negativos
au_numerico <- datos$Au_ppm[datos$Au_ppm >= 0 & !is.na(datos$Au_ppm)]
n_sin_datos <- sum(is.na(datos$Au_ppm) | datos$Au_ppm < 0)
# 2. Tabla de Frecuencias de los valores geoquímicos reales
TDF_VALIDOS <- as.data.frame(table(au_numerico), stringsAsFactors = FALSE)
colnames(TDF_VALIDOS) <- c("CATEGORIA", "ni")
# 3. Ordenar de mayor a menor frecuencia de aparición
TDF_VALIDOS <- TDF_VALIDOS[order(-TDF_VALIDOS$ni), ]
# Definición de horizontes cuantitativos
total_variable <- sum(TDF_VALIDOS$ni) # Total solo de la variable con datos
total_general <- total_variable + n_sin_datos # Total absoluto del proyecto
# 4. Agrupación Top 10 de concentraciones reales
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
}
# Calcular frecuencias (hi) escaladas a 100
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 Au)
fila_total_var <- data.frame(
CATEGORIA = "TOTAL VARIABLE (Au)",
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 # Forzamos el 100 para el cierre perfecto
)
# Consolidar toda la matriz de datos en orden descendente y lógico
tabla_final <- rbind(tabla_final_base, fila_total_var, fila_sin_datos, fila_total_general)
colnames(tabla_final) <- c("Valor Au (ppm)", "ni", "hi")
#----------------------- GENERAR SALIDA ESTÉTICA -----------------------
tabla_au_completa_gt <- tabla_final %>%
gt() %>%
tab_header(
title = md("**Tabla N° 1**"),
subtitle = md("Distribución de frecuencias para concentraciones de Oro (Au)")
) %>%
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_au_completa_gt| Tabla N° 1 | ||
| Distribución de frecuencias para concentraciones de Oro (Au) | ||
| Valor Au (ppm) | ni | hi |
|---|---|---|
| 1 | 8 | 0.5857 |
| 4 | 4 | 0.2928 |
| 0.012 | 3 | 0.2196 |
| 0.02 | 3 | 0.2196 |
| 0.026 | 3 | 0.2196 |
| 0.021 | 2 | 0.1464 |
| 0.023 | 2 | 0.1464 |
| 0.025 | 2 | 0.1464 |
| 0.029 | 2 | 0.1464 |
| 0.034 | 2 | 0.1464 |
| Otras Concentraciones | 96 | 7.0278 |
| TOTAL VARIABLE (Au) | 127 | 9.2972 |
| Sin Datos | 1239 | 90.7028 |
| TOTAL GENERAL | 1366 | 100.0000 |
| Autores: Grupo 1 Semestre 2026 - 2026 |
||
3. ANÁLISIS DESCRIPTIVO Y AGRUPACIÓN EN CLASES (STRUGES) DE ORO
3.1 ANÁLISIS DESCRIPTIVO Y AGRUPACIÓN EN CLASES (STRUGES) DE ORO
#------------------------- PREPARACIÓN DE DATOS (Oro) -------------------------
# Conversión a numérico (reemplazando comas por puntos y manejando advertencias)
datos$Au_ppm <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Au_ppm))))
# Creamos la variable de trabajo Au asegurando que los datos estén limpios desde el inicio
Au_VAR <- datos$Au_ppm[!is.na(datos$Au_ppm) & datos$Au_ppm >= 0]
Au_Limpio <- Au_VAR
#------------------------- ANÁLISIS DE LIDERAZGO (ESTADÍSTICOS) -------------------------
cat("\n=======================================================\n")##
## =======================================================cat("ANÁLISIS DE CONCENTRACIÓN (Au_ppm):\n")## ANÁLISIS DE CONCENTRACIÓN (Au_ppm):cat("La concentración promedio es: ", round(mean(Au_VAR, na.rm = TRUE), 2), " ppm \n")## La concentración promedio es: 39.33 ppmcat("La concentración máxima detectada es: ", max(Au_VAR, na.rm = TRUE), " ppm \n")## La concentración máxima detectada es: 1500.111 ppmcat("Total de muestras analizadas: ", sum(!is.na(Au_VAR)), " registros \n")## Total de muestras analizadas: 127 registroscat("=======================================================\n")## =======================================================#------------------------- TABLA DE FRECUENCIAS - STURGES -------------------------
# 1. Parámetros básicos: Rango, Número de clases (Sturges) y Amplitud
R <- max(Au_Limpio) - min(Au_Limpio)
k <- floor(1 + 3.322 * log10(length(Au_Limpio)))
A <- R / k
# 2. Definición de límites y Marcas de Clase (MC)
liminf <- seq(from = min(Au_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(Au_VAR >= liminf[i] & Au_VAR <= limsup[i], na.rm = TRUE)
} else {
n[i] <- sum(Au_VAR >= liminf[i] & Au_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 -------------------------
TablaAu_Sturges <- data.frame(
Clase = as.character(1:k), # Se convierte a caracter 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
fila_totales_Au <- 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
TablaAu_Final <- rbind(TablaAu_Sturges, fila_totales_Au)
#------------------------- MOSTRAR TABLA FINAL CON 'gt' -------------------------
tabla_sturges_gt <- TablaAu_Final %>%
gt() %>%
tab_header(
title = md("**Tabla N° 2**"),
subtitle = md("Distribución de frecuencias para concentraciones de Oro (Au_ppm) <br> mediante Regla de Sturges")
) %>%
tab_source_note(
source_note = md("Autores: Grupo 1 <br> Semestre 2026 - 2026")
) %>%
fmt_markdown(columns = Clase) %>% # Renderiza las negritas de "**TOTALES**"
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
tabla_sturges_gt| Tabla N° 2 | |||||||||
| Distribución de frecuencias para concentraciones de Oro (Au_ppm) mediante Regla de Sturges |
|||||||||
| Clase | Linf (ppm) | Lsup (ppm) | MC (ppm) | n (abs) | hi (%) | Ni (↑) | Hi (↑) | Ni (↓) | Hi (↓) |
|---|---|---|---|---|---|---|---|---|---|
| 1 | 0.007 | 214.308 | 107.157 | 124 | 97.64 | 124 | 97.64 | 127 | 100.00 |
| 2 | 214.308 | 428.608 | 321.458 | 0 | 0.00 | 124 | 97.64 | 3 | 2.36 |
| 3 | 428.608 | 642.909 | 535.758 | 0 | 0.00 | 124 | 97.64 | 3 | 2.36 |
| 4 | 642.909 | 857.209 | 750.059 | 1 | 0.79 | 125 | 98.43 | 3 | 2.36 |
| 5 | 857.209 | 1071.510 | 964.360 | 0 | 0.00 | 125 | 98.43 | 2 | 1.57 |
| 6 | 1071.510 | 1285.811 | 1178.660 | 0 | 0.00 | 125 | 98.43 | 2 | 1.57 |
| 7 | 1285.811 | 1500.111 | 1392.961 | 2 | 1.57 | 127 | 100.00 | 2 | 1.57 |
| TOTALES | NA | NA | NA | 127 | 100.00 | NA | 100.00 | NA | 100.00 |
| Autores: Grupo 1 Semestre 2026 - 2026 |
|||||||||
3.2 Tabla simplificada
#------------------------- PREPARACIÓN DE DATOS -------------------------
# reemplazamos comas por puntos
datos$Au_ppm <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Au_ppm))))
# Creamos la variable de trabajo ORO asegurando que los datos estén limpios y sin negativos
ORO <- datos$Au_ppm[!is.na(datos$Au_ppm) & datos$Au_ppm >= 0]
#------------------------- ANÁLISIS DE CONCENTRACIÓN (ESTADÍSTICOS) -------------------------
cat("\n=======================================================\n")##
## =======================================================cat("ANÁLISIS DE CONCENTRACIÓN (Au_ppm):\n")## ANÁLISIS DE CONCENTRACIÓN (Au_ppm):cat("La concentración promedio es: ", round(mean(ORO, na.rm = TRUE), 0), " ppm \n") # Redondeado a 0## La concentración promedio es: 39 ppmcat("La concentración máxima detectada es: ", round(max(ORO, na.rm = TRUE), 0), " ppm \n") # Redondeado a 0## La concentración máxima detectada es: 1500 ppmcat("Total de muestras analizadas: ", sum(!is.na(ORO)), " registros \n")## Total de muestras analizadas: 127 registroscat("=======================================================\n")## =======================================================#------------------------- TABLA DE FRECUENCIAS - STURGES -------------------------
# 1. Parámetros básicos: Rango, Número de clases (Sturges) y Amplitud
R <- max(ORO, na.rm = TRUE) - min(ORO, na.rm = TRUE)
k <- floor(1 + 3.322 * log10(length(ORO)))
A <- R / k
# 2. Definición de límites y Marcas de Clase (MC)
liminf <- seq(from = min(ORO, 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(ORO >= liminf[i] & ORO <= limsup[i], na.rm = TRUE)
} else {
n[i] <- sum(ORO >= liminf[i] & ORO < 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 -------------------------
TablaAu_Sturges <- data.frame(
Clase = as.character(1:k), # Se convierte a carácter para poder añadir "TOTALES" luego
liminf = round(liminf, 0), # Sin decimales
limsup = round(limsup, 0), # Sin decimales
MC = round(MC, 0), # Sin decimales
n = n,
hi = round(hi, 0), # Sin decimales
Ni_asc = Ni_asc,
Hi_asc = round(Hi_asc, 0), # Sin decimales
Ni_desc = Ni_desc,
Hi_desc = round(Hi_desc, 0) # Sin decimales
)
# Fila de TOTALES para el cierre de balance formal
fila_totales_Au <- 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 totales
TablaAu_Final <- rbind(TablaAu_Sturges, fila_totales_Au)
#------------------------- MOSTRAR TABLA FINAL CON 'gt' -------------------------
tabla_sturges_au_gt <- TablaAu_Final %>%
gt() %>%
tab_header(
title = md("**Tabla N° 3**"),
subtitle = md("Distribución de frecuencias para concentraciones de Oro (Au_ppm) <br> mediante Regla de Sturges")
) %>%
tab_source_note(
source_note = md("Autores: Grupo 1 <br> Semestre 2026 - 2026")
) %>%
fmt_markdown(columns = Clase) %>% # Renderiza correctamente las negritas de "**TOTALES**"
fmt_number(
columns = c(liminf, limsup, MC, n, hi, Ni_asc, Hi_asc, Ni_desc, Hi_desc),
decimals = 0 # Fuerza a la tabla de gt a no mostrar ningún decimal
) %>%
cols_label(
Clase = "Clase",
liminf = "Linf (ppm)",
limsup = "Lsup (ppm)",
MC = "MC (ppm)",
n = "n (abs)",
hi = "hi (%)",
Ni_asc = "Ni (↑)",
Hi_asc = "Hi (↑)",
Ni_desc = "Ni (↓)",
Hi_desc = "Hi (↓)"
) %>%
tab_options(
table.border.top.color = "black",
table.border.bottom.color = "black",
heading.border.bottom.color = "black",
heading.border.bottom.width = px(2),
column_labels.border.top.color = "black",
column_labels.border.bottom.color = "black",
column_labels.border.bottom.width = px(2),
table_body.hlines.color = "gray",
table_body.border.bottom.color = "black",
row.striping.include_table_body = TRUE
) %>%
sub_missing(
columns = everything(),
missing_text = "-" # Reemplaza los molestos NA por guiones limpios y estéticos
)
# Renderizar la tabla en el reporte
tabla_sturges_au_gt| Tabla N° 3 | |||||||||
| Distribución de frecuencias para concentraciones de Oro (Au_ppm) mediante Regla de Sturges |
|||||||||
| Clase | Linf (ppm) | Lsup (ppm) | MC (ppm) | n (abs) | hi (%) | Ni (↑) | Hi (↑) | Ni (↓) | Hi (↓) |
|---|---|---|---|---|---|---|---|---|---|
| 1 | 0 | 214 | 107 | 124 | 98 | 124 | 98 | 127 | 100 |
| 2 | 214 | 429 | 321 | 0 | 0 | 124 | 98 | 3 | 2 |
| 3 | 429 | 643 | 536 | 0 | 0 | 124 | 98 | 3 | 2 |
| 4 | 643 | 857 | 750 | 1 | 1 | 125 | 98 | 3 | 2 |
| 5 | 857 | 1,072 | 964 | 0 | 0 | 125 | 98 | 2 | 2 |
| 6 | 1,072 | 1,286 | 1,179 | 0 | 0 | 125 | 98 | 2 | 2 |
| 7 | 1,286 | 1,500 | 1,393 | 2 | 2 | 127 | 100 | 2 | 2 |
| TOTALES | - | - | - | 127 | 100 | - | 100 | - | 100 |
| Autores: Grupo 1 Semestre 2026 - 2026 |
|||||||||
4. POLÍGONO DE FRECUENCIAS
POLÍGONO DE FRECUENCIAS ABSOLUTAS DEL ORO (Au)
#----------------------- PROCESAMIENTO AUTOMÁTICO Au_ppm -----------------------
# 1. Conversión de la variable a numérico y limpieza de datos (Oro)
datos$Au_ppm <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Au_ppm))))
Au_VAR <- datos$Au_ppm[!is.na(datos$Au_ppm) & datos$Au_ppm >= 0]
#----------------------- EXTRACCIÓN METODOLÓGICA DE STURGES -----------------------
# 2. Calculamos los parámetros de Sturges para el Oro automáticamente
n_total_au <- length(Au_VAR)
k_sturges_au <- floor(1 + 3.322 * log10(n_total_au))
# 3. Definimos los cortes de intervalos (breaks) usando el rango real del Oro
rango_au <- max(Au_VAR) - min(Au_VAR)
amplitud_au <- rango_au / k_sturges_au
breaks_sturges_au <- seq(from = min(Au_VAR), by = amplitud_au, length.out = k_sturges_au + 1)
# 4. CAPTURA DE DATOS OCULTOS: Agrupación y conteo en memoria para Oro
hist_objeto_au <- hist(Au_VAR, breaks = breaks_sturges_au, plot = FALSE, right = FALSE)
# NUEVO: Cálculo de las Frecuencias Relativas hi (%)
hi_au_pct <- (hist_objeto_au$counts / n_total_au) * 100
# Extraemos y REDONDEAMOS las Marcas de Clase (MC) a 0 decimales
mc_reales_au <- round(hist_objeto_au$mids, 0)
amplitud_au_red <- round(amplitud_au, 0)
#----------------------- ANCLAJE A CERO -----------------------
# 5. Creamos las clases vacías a los extremos usando las marcas sin decimales
mc_inicio_au <- mc_reales_au[1] - amplitud_au_red
mc_final_au <- mc_reales_au[length(mc_reales_au)] + amplitud_au_red
# Unimos los vectores definitivos para el gráfico (Marcas de Clase y Frecuencias hi)
marcas_clase_au <- c(mc_inicio_au, mc_reales_au, mc_final_au)
frecuencias_hi_au <- c(0, hi_au_pct, 0) # Anclamos el porcentaje a 0 en los extremos
# Detectamos la frecuencia relativa máxima real del oro para el eje Y
max_y_hi_au <- max(frecuencias_hi_au)
#----------------------- GRAFICAR POLÍGONO DE FRECUENCIAS (Oro) -----------------------
# Aumentamos el margen inferior (mar[1]=6) para las etiquetas verticales
par(mar = c(6, 5, 4, 2))
# 6. Inicializar el lienzo ajustando los límites de los ejes a MC e hi
plot(marcas_clase_au, frecuencias_hi_au,
type = "n",
main = "Gráfica 1: Polígono de Frecuencias Relativas de Oro (Au)",
xlab = "", # Dejamos el xlab vacío para reposicionarlo más abajo
ylab = "Frecuencia Relativa - hi (%)",
xlim = c(min(marcas_clase_au), max(marcas_clase_au)), # Ajuste exacto a las marcas de clase y anclajes
ylim = c(0, max_y_hi_au * 1.15), # 15% de margen superior libre
xaxt = "n", yaxt = "n",
panel.first = grid(nx = NULL, ny = NULL, col = "gray90"))
# Título del eje X posicionado manualmente para evitar cruces con las etiquetas
title(xlab = "Marca de Clase - MC (ppm)", line = 4.5)
# 7. Dibujar el polígono
lines(marcas_clase_au, frecuencias_hi_au, type = "b", pch = 19, col = "darkgoldenrod4", lwd = 3)
# 8. Relleno translúcido a juego debajo de la curva
polygon(marcas_clase_au, frecuencias_hi_au, col = rgb(0.72, 0.53, 0.04, 0.15), border = NA)
#----------------------- PERSONALIZACIÓN DE EJES CONTINUOS -----------------------
# Eje X
axis(1, at = mc_reales_au, labels = mc_reales_au, cex.axis = 0.75, las = 1)
# Eje Y: Imprime marcas proporcionales y ancla el valor de hi más alto detectado
marcas_eje_y_hi_au <- pretty(c(0, max_y_hi_au))
marcas_eje_y_hi_au <- marcas_eje_y_hi_au[marcas_eje_y_hi_au < (max_y_hi_au * 0.95)]
axis(2, at = c(marcas_eje_y_hi_au, max_y_hi_au), labels = round(c(marcas_eje_y_hi_au, max_y_hi_au), 0), las = 1, cex.axis = 0.8)
5. ANÁLISIS GRÁFICO: HISTOGRAMA DISTRIBUCIÓN DEL ORO
5.1 HISTOGRAMA DISTRIBUCIÓN DEL ORO
#----------------------- PREPARACIÓN ÚNICA DE DATOS (Oro) -----------------------
# Limpiamos y filtramos la variable una sola vez para ambas gráficas
datos$Au_ppm <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Au_ppm))))
Au_VAR <- datos$Au_ppm[!is.na(datos$Au_ppm) & datos$Au_ppm >= 0]
#----------------------- 1. HISTOGRAMA SIMPLIFICADO -----------------------
# Usamos pretty() directamente en la función para ahorrar líneas de código
par(mar = c(5, 5, 4, 2))
hist(Au_VAR,
breaks = pretty(Au_VAR, n = 5),
main = "Gráfica 2: Distribución de Au_ppm (Simplificada)",
xlab = "Concentración de Au (ppm)",
ylab = "Cantidad de muestras",
col = "gold3",
border = "black",
right = FALSE,
las = 1,
ylim = c(0, 140)) 
5.2 Histograma mejorado
#----------------------- PREPARACIÓN DE DATOS (Oro) -----------------------
# Limpieza de comas y exclusión de negativos y NAs
datos$Au_ppm <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Au_ppm))))
Au_VAR <- datos$Au_ppm[!is.na(datos$Au_ppm) & datos$Au_ppm >= 0]
#----------------------- CÁLCULO DE INTERVALOS (STURGES) -----------------------
# Calculamos matemáticamente las clases y la amplitud
k_au <- floor(1 + 3.322 * log10(length(Au_VAR)))
breaks_au <- seq(from = min(Au_VAR), by = ((max(Au_VAR) - min(Au_VAR)) / k_au), length.out = k_au + 1)
# Calculamos el histograma de forma invisible
h_info_au <- hist(Au_VAR, breaks = breaks_au, plot = FALSE, right = FALSE)
# Creamos las etiquetas para la leyenda (SIN DECIMALES)
intervalos_au <- paste0("[", round(h_info_au$breaks[-length(h_info_au$breaks)], 0),
" - ", round(h_info_au$breaks[-1], 0), ")")
# Paleta dorada
colores_hist_au <- colorRampPalette(c("#FFF2CC", "#FFD700", "#DAA520", "#B8860B"))(length(h_info_au$counts))
#----------------------- HISTOGRAMA Y LEYENDA CORREGIDA -----------------------
# Aumentamos el margen derecho e inferior
par(mar=c(6, 5, 5, 12), xpd=TRUE)
hist(Au_VAR,
breaks = breaks_au,
main = "Gráfica 3: Distribución de Au_ppm (Regla de Sturges)",
xlab = "", # Quitamos el título general para que no choque con los números
ylab = "Frecuencia (Cantidad de muestras)",
col = colores_hist_au,
border = "white",
labels = TRUE, # Imprime los valores sobre las barras
right = FALSE,
las = 1,
xaxt = "n",
ylim = c(0, max(h_info_au$counts) * 1.15))
# Título del eje X desplazado hacia abajo
mtext("Concentración de Au (ppm)", side = 1, line = 4.5, font = 1)
# Eje X dinámico (SIN DECIMALES)
axis(1, at = breaks_au, labels = round(breaks_au, 0), font = 2, las = 1, cex.axis = 0.7)
# Leyenda
legend("topright", inset=c(-0.35, 0),
legend = intervalos_au,
fill = colores_hist_au,
title = "Intervalos (ppm)",
cex = 0.85, bty = "n")
6. ANÁLISIS VISUAL ACUMULADO: OJIVA ASCENDENTE Y DESCENDENTE
6.1 Ojiva ni
#----------------------- OJIVA INTEGRADA Y PROFESIONAL (Oro) -----------------------
# 1. Construimos los cortes del eje X
cortes_eje_x_au <- c(liminf, limsup[length(limsup)])
# Restauramos los márgenes
par(mar=c(5, 5, 4, 2))
# Usamos directamente
plot(MC, Ni_asc,
main = "Gráfica 4: Ojiva Acumulada de Frecuencias de Oro (ni)",
xlab = "Contenido de Oro (ppm)",
ylab = "Frecuencia Acumulada (N muestras)",
type = "b", pch = 19, col = "darkgoldenrod", 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 = "chocolate", lwd = 3, lty = 2)
# Eje X SIN DECIMALES
axis(1, at = cortes_eje_x_au, labels = round(cortes_eje_x_au, 0), cex.axis = 0.8)
# Leyenda
legend("right",
legend = c("Acumulada Menor que (Ascendente)", "Acumulada Mayor que (Descendente)"),
col = c("darkgoldenrod", "chocolate"),
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)
6.2 Ojiva hi
#----------------------- OJIVA PROFESIONAL ORO - EN PORCENTAJES (Hi) -----------------------
par(mar=c(5, 5, 4, 2))
plot(MC, Hi_asc,
main = "Gráfica 5: Ojiva Acumulada de Frecuencias de Oro (hi)",
xlab = "Concentración de Oro - Au (ppm)",
ylab = "Frecuencia Relativa Acumulada (%)",
type = "b", pch = 19, col = "darkgoldenrod", 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
# Segunda línea descendente
lines(MC, Hi_desc, type = "b", pch = 17, col = "chocolate", lwd = 3, lty = 2)
# Eje X con los intervalos exactos SIN DECIMALES
axis(1, at = cortes_eje_x_au, labels = round(cortes_eje_x_au, 0), cex.axis = 0.8)
# Leyenda técnica
legend("right",
legend = c("Acumulada Menor que (Ascendente %)", "Acumulada Mayor que (Descendente %)"),
col = c("darkgoldenrod", "chocolate"),
lty = c(1, 2),
pch = c(19, 17),
lwd = 2,
title = "Tipo de Ojiva",
bty = "n",
cex = 0.85)
7. BOXPLOT
7.1 BOXPLOTS DE VALORES ATÍPICOS
#----------------------- PREPARACIÓN DE DATOS ÚNICA (Oro) -----------------------
# Limpiamos comas y tomamos TODOS los valores reales (>= 0), eliminando el filtro < 10
datos$Au_ppm <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Au_ppm))))
Au_VAR <- datos$Au_ppm[!is.na(datos$Au_ppm) & datos$Au_ppm >= 0]
# Cálculos estadísticos REALES
media_au <- round(mean(Au_VAR), 2)
mediana_au <- round(median(Au_VAR), 2)
outliers_au <- boxplot.stats(Au_VAR)$out
n_outliers <- length(outliers_au)
#----------------------- DIAGRAMA DE CAJA (CON ATÍPICOS) -----------------------
par(mar=c(5, 6, 4, 2))
# Creación del Boxplot
boxplot(Au_VAR,
horizontal = TRUE,
col = "#FFF9C4",
border = "#F9A825",
main = "Gráfica 6: Boxplot Oro (Análisis General con Atípicos)",
xlab = "Concentración de Au (ppm)",
pch = 21,
bg = "red",
col.outline = "darkred")
# Agregar punto de media
points(media_au, 1,
col = "blue",
pch = 18,
cex = 2)
# Etiquetas de valores (Separadas verticalmente para que no se encimen en la gráfica)
text(media_au, 1.30,
labels = paste("Media:", media_au),
col = "blue",
font = 2,
cex = 0.8,
pos = 4)
text(mediana_au, 0.70,
labels = paste("Mediana:", mediana_au),
col = "#F9A825",
font = 2,
cex = 0.8,
pos = 4)
# Leyenda para los valores atípicos
legend("topright",
legend = c(paste("Outliers totales:", n_outliers)),
pch = 21,
pt.bg = "red",
bty = "n")
7.2 Boxplot distribución limpia
#----------------------- DIAGRAMA DE CAJA (DISTRIBUCIÓN LIMPIA) -----------------------
# Graficamos de forma simple
boxplot(Au_VAR,
horizontal = TRUE,
outline = FALSE,
col = "#C8E6C9",
border = "#2E7D32",
main = "Gráfica 7: Boxplot Oro (Cuerpo de Distribución y Media)",
xlab = "Concentración de Au (ppm)",
ylim = c(0, 45)) # Controla perfectamente el zoom de los datos en el eje horizontal
grid(nx = NULL, ny = NA, col = "gray85", lty = "dotted")
# Agregar punto de la media real
points(media_au, 1,
col = "darkred",
pch = 18,
cex = 2)
#----------------------- ETIQUETAS VISIBLES Y SEGURAS -----------------------
# Colocamos la Media
text(x = media_au,
y = 1.25,
labels = paste("Media:", media_au),
col = "darkred",
font = 2,
cex = 0.8)
#Configuramos para que el valor de la mediana aparezca
text(x = 6,
y = 1.25,
labels = paste("Mediana:", mediana_au),
col = "#2E7D32",
font = 2,
cex = 0.8)
8. HISTOGRAMA CON BOXPLOT SUPERPUESTO (ORO)
HISTOGRAMA CON BOXPLOT FLOTANTE (ORO)
#----------------------- PREPARACIÓN DE DATOS -----------------------
# Limpieza y filtrado de la variable Au_ppm
datos$Au_ppm <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Au_ppm))))
Au_VAR <- datos$Au_ppm[!is.na(datos$Au_ppm) & datos$Au_ppm >= 0]
#----------------------- METODOLOGÍA DE STURGES EXACTA -----------------------
# Cálculo dinámico de clases y amplitud
k_au <- floor(1 + 3.322 * log10(length(Au_VAR)))
breaks_au <- seq(from = min(Au_VAR), by = ((max(Au_VAR) - min(Au_VAR)) / k_au), length.out = k_au + 1)
#----------------------- CÁLCULO DEL HISTOGRAMA (INVISIBLE) -----------------------
# Calculamos el histograma internamente para extraer datos
hist_pro_au <- hist(Au_VAR, breaks = breaks_au, plot = FALSE, right = FALSE)
max_y_au <- max(hist_pro_au$counts)
#----------------------- CÁLCULO DEL RANGO X TOTAL (CORRECCIÓN) -----------------------
# Calculamos el rango necesario para abarcar tanto las barras como los atípicos extremos
xlim_range <- range(c(Au_VAR, breaks_au))
# 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
colores_hist_au <- colorRampPalette(c("#FFF2CC", "#FFD700", "#DAA520", "#B8860B"))(length(hist_pro_au$counts))
hist(Au_VAR,
breaks = breaks_au,
col = colores_hist_au,
border = "white",
main = "Gráfica 8: Distribución de Oro con Boxplot Interno",
xlab = "Concentración de Au (ppm)",
ylab = "Frecuencia (Cantidad de muestras)",
xlim = xlim_range, # Asegura que todo el eje X sea visible junto con los atípicos
ylim = c(0, max_y_au * 1.15), # Añadimos espacio extra en la parte superior para los números
las = 1,
labels = TRUE, # Muestra las cantidades encima de las barras
right = FALSE,
xaxt = "n") # Suprime el eje X por defecto
# 2. Personalización del eje X (SIN DECIMALES)
axis(1, at = breaks_au, labels = round(breaks_au, 0), font = 2, cex.axis = 0.7)
# 3. Superponemos el Boxplot directamente
boxplot(Au_VAR,
horizontal = TRUE,
add = TRUE, # Superpone la gráfica en el mismo lienzo
axes = FALSE, # Oculta ejes propios del boxplot
at = max_y_au / 2, # Altura de flotación (mitad del eje Y)
boxwex = max_y_au / 3, # Grosor de la caja proporcional
col = adjustcolor("#FFF9C4", alpha.f = 0.7), # Color crema con 70% opacidad
border = "#F9A825", # Borde ocre/dorado
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 con los intervalos matemáticos (SIN DECIMALES)
intervalos_au <- paste0("[", round(hist_pro_au$breaks[-length(hist_pro_au$breaks)], 0),
" - ", round(hist_pro_au$breaks[-1], 0), ")")
legend("topright", inset = c(-0.35, 0),
legend = intervalos_au,
fill = colores_hist_au,
title = "Intervalos (ppm)",
cex = 0.8, bty = "n")
9. RESUMEN DESCRIPTIVO
RESUMEN DESCRIPTIVO
#----------------------- ANÁLISIS ESTADÍSTICO Au_ppm -----------------------
# 0. Limpieza automática de nombres (elimina espacios invisibles)
colnames(datos) <- trimws(colnames(datos))
# 1. Preparación de la variable y cálculos
if("Au_ppm" %in% colnames(datos)) {
# Conversión a numérico (reemplazo de coma por punto)
datos$Au_ppm <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Au_ppm))))
# 2. CORRECCIÓN AQUÍ: Tomamos todos los valores válidos (mayores o iguales a 0)
# Eliminamos el filtro de (< 10) para no perder los valores atípicos altos
AU_LIMPIA <- datos$Au_ppm[!is.na(datos$Au_ppm) & datos$Au_ppm >= 0]
# 3. Cálculos estadísticos descriptivos
resumen_stats_Au <- 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(AU_LIMPIA),
min(AU_LIMPIA),
max(AU_LIMPIA),
mean(AU_LIMPIA),
median(AU_LIMPIA),
sd(AU_LIMPIA),
(sd(AU_LIMPIA) / mean(AU_LIMPIA)) * 100,
skewness(AU_LIMPIA, type = 2),
kurtosis(AU_LIMPIA)
)
)
# 4. Redondeo para presentación en el reporte
resumen_stats_Au$Valor <- round(resumen_stats_Au$Valor, 2)
}
#----------------------- SALIDA ESTÉTICA CON 'gt' -----------------------
tabla_stats_au_gt <- resumen_stats_Au %>%
gt() %>%
tab_header(
title = md("**Tabla N° 4**"),
subtitle = md("Estadística Descriptiva para Concentraciones de Oro (Au)")
) %>%
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
tabla_stats_au_gt| Tabla N° 4 | |
| Estadística Descriptiva para Concentraciones de Oro (Au) | |
| Parámetro Estadístico | Resultado |
|---|---|
| Tamaño muestral (n) | 127.00 |
| Mínimo (Min) | 0.01 |
| Máximo (Max) | 1500.11 |
| Media ( x̅) | 39.33 |
| Mediana (Me) | 0.23 |
| Desviación Estándar (s) | 198.48 |
| Coef. Variación (CV) | 504.62 |
| Asimetría (As) | 6.75 |
| Curtosis (K) | 44.27 |
| Autores: Grupo 1 Semestre 2026 - 2026 |
|
10. CONCLUSIÓN
CONCLUSIÓN DE LA VARIABLE Au_ppm
El análisis estadístico de la variable oro (Au) para las 127 muestras revela una población extremadamente heterogénea, evidenciada por un coeficiente de variación del 504.62%. Las concentraciones fluctúan entre 0.01 y un máximo anómalo de 1500.11 ppm. A pesar de que la media se sitúa en 39.33 ppm, la mediana de apenas 0.23 ppm demuestra que este promedio está fuertemente sesgado por valores atípicos extremos. La asimetría altamente positiva (6.75) y la curtosis masiva (44.27) confirman el comportamiento típico de estos yacimientos: una acumulación abrumadora de depósitos con leyes auríferas marginales, contrastada por casos aislados de enriquecimiento extraordinario que representan los principales objetivos de interés económico.