Análisis Estadístico por Variables Cuantitativas Au_ppm
Grupo 1
2026-23-05
CARGA DE DATOS
CARGA DE DATOS
knitr::opts_chunk$set(
echo = TRUE, # Muestra el código R en el reporte final.
message = FALSE,
warning = FALSE, # Message y warning evitan que se impriman alertas o mensajes de carga estorbosos en el HTML.
fig.align = "center" # Centra automáticamente todas las gráficas generadas.
)
datos <- read.csv("C:/Users/USER/Documents/PROYECTO ESTADISTICA/CMDB_Data.csv",
header = TRUE, # Indica que la primera fila contienen los nombres de las variables.
sep = ";", # Define que los puntos y comas es el separador de las columnas del archivo.
dec = ".", # Establece el punto como el operador decimal para los números.
fileEncoding = "latin1")
# Verificación inicial del set de datos
str(datos)## 'data.frame': 1366 obs. of 103 variables:
## $ ï..LAB_ID : chr "C355417" "C360759" "C360762" "C360763" ...
## $ PREVIOUS_LAB_ID1 : chr "" "" "" "" ...
## $ PREVIOUS_LAB_ID2 : chr "" "" "" "" ...
## $ PREVIOUS_LAB_ID3 : chr "" "" "" "" ...
## $ FIELD_ID : chr "RM0001" "RM0027" "RM0030" "RM0031" ...
## $ JOB_ID : chr "MRP11968" "MRP12307" "MRP12307" "MRP12307" ...
## $ PREVIOUS_JOB_ID1 : chr "" "" "" "" ...
## $ PREVIOUS_JOB_ID2 : chr "" "" "" "" ...
## $ PREVIOUS_JOB_ID3 : chr "" "" "" "" ...
## $ SUBMITTER : chr "Rare Metals Task" "Rare Metals Task" "Rare Metals Task" "Rare Metals Task" ...
## $ PROJECT_NAME : chr "Critical and Rare Metals" "Critical and Rare Metals" "Critical and Rare Metals" "Critical and Rare Metals" ...
## $ DATE_SUBMITTED : chr "30/6/2011" "31/8/2011" "31/8/2011" "31/8/2011" ...
## $ COLLECTION : chr "Mackay-Keck Ore Deposits Collection" "Mackay-Stanford Ore Deposits Collection" "Mackay-Stanford Ore Deposits Collection" "Mackay-Stanford Ore Deposits Collection" ...
## $ COLLECTION_ID : chr "PHNC08_39_1183" "OD21441" "OD22811" "OD25716" ...
## $ CONTINENT : chr "North America" "South America" "South America" "Africa" ...
## $ COUNTRY : chr "United States" "Chile" "Chile" "South Africa" ...
## $ STATE_PROVINCE : chr "Nevada" "Antofagasta" "Tarapacá" "Transvaal" ...
## $ COUNTY : chr "Lyon" "El Loa" "El Tamarugal" "" ...
## $ DISTRICT_NAME : chr "Yerington" "Chuquicamata" "Collahuasi/Quebrada Blanca" "" ...
## $ DEPOSIT_NAME : chr "Pumpkin Hollow" "" "" "" ...
## $ MINE_NAME : chr "Pumpkin Hollow" "Chuquicamata mine" "Collahuasi district" "" ...
## $ DISTRICT_NAME_COLLECT: chr "Yerington" "" "" "" ...
## $ DEPOSIT_NAME_COLLECT : chr "" "" "" "" ...
## $ MINE_NAME_COLLECT : chr "Pumpkin Hollow" "Chuquicamata" "Poduosa mine" "Messina Mines Ltd." ...
## $ LOCATE_DESC : chr "" "" "Level 25" "" ...
## $ LATITUDE : chr "38,94021" "-22,2871" "-21,0309" "-24,7" ...
## $ LONGITUDE : chr "-119,05178" "-68,8991" "-68,74951" "29,3" ...
## $ DATUM : chr "WGS84" "WGS84" "WGS84" "" ...
## $ LATITUDE_COLLECT : chr "38,92492" "22,28944" "" "" ...
## $ LONGITUDE_COLLECT : chr "-119,1071" "-68,90111" "" "" ...
## $ DATUM_COLLECT : chr "" "WGS84" "" "" ...
## $ COORDINATES_QUAL : chr "100 m" "Exact" "" "" ...
## $ COORDINATES_SOURCE : chr "1) iTouchMap.com, approx, A. Orkild-Norton; 2) Mineral Resource Deposit Database Deposit ID 10174173, ore body, M. Granitto" "1) Mindat.org, approx, A. Orkild-Norton; 2) Open-File Report 2017-1079 ID 549, mine, M. Granitto" "1) No coordinates; 2) Mineral Resource Deposit Database Deposit ID 10057511, district, M. Granitto" "1) No coordinates; 2) Google Earth Pro, approx ctr of former province of Transvaal, M. Granitto" ...
## $ PRIMARY_CLASS : chr "rock" "rock" "rock" "rock" ...
## $ SYSTEM_TYPE : chr "IOA-IOCG" "Porphyry Cu-Mo-Au" "Porphyry Cu-Mo-Au" "IOA-IOCG" ...
## $ DEPOSIT_TYPE : chr "IOCG" "Supergene Cu" "Porphyry Cu" "IOCG" ...
## $ SAMPLE_DESC : chr "Nearly solid chalcopyrite mixed with small light brown irregular inclusions of unknown mineralogy; clouds of ma"| __truncated__ "Chalcocite-bronchatite-antlerite(?); highly microfractured igneous rock with green copper sulfates coating microfractures" "Bornite-chalcopyrite; mostly massive chalcopyrite with numerous inclusions of micro-chalcopyrite and widely sca"| __truncated__ "Massive chalcopyrite, IOCG in shear zone; mostly massive fine grain cuprite with widely distributed malachite t"| __truncated__ ...
## $ Al_pct_AES_ST : chr "0,33" "6,65" "0,46" "0,7" ...
## $ Ca_pct_AES_ST : chr "1,1" "0,4" "-0,1" "0,3" ...
## $ Fe_pct_AES_ST : chr "42,4" "0,25" "6,98" "27,8" ...
## $ K_pct_AES_ST : chr "-0,1" "6,1" "0,2" "-0,1" ...
## $ Mg_pct_AES_ST : chr "0,57" "0,1" "0,01" "0,33" ...
## $ Mn_pct_AES_ST : chr "0,02" "-0,01" "-0,01" "-0,01" ...
## $ P_pct_AES_ST : chr "-0,01" "0,01" "0,05" "0,01" ...
## $ S_pct_AES_ST : chr "" "" "" "" ...
## $ Si_pct_AES_ST : chr "" "" "" "" ...
## $ Ti_pct_AES_ST : chr "0,01" "0,11" "-0,01" "-0,01" ...
## $ F_pct_ISE_Fuse : chr "" "" "" "" ...
## $ Ag_ppm_MS_ST : chr "58" "6" "468" "16" ...
## $ As_ppm_MS_ST : chr "-30" "-30" "90" "-30" ...
## $ Au_ppm : chr "" "" "" "" ...
## $ Au_AM : chr "" "" "" "" ...
## $ B_ppm_AES_ST : int NA NA NA NA NA NA NA NA NA NA ...
## $ Ba_ppm_AES_ST : chr "-0,5" "924" "121" "174" ...
## $ Be_ppm_AES_ST : int -5 -5 -5 -5 -5 -5 -5 -5 -5 -5 ...
## $ Bi_ppm_MS_ST : chr "1,5" "3,6" "190" "0,4" ...
## $ Cd_ppm_MS_ST : chr "3,6" "-0,2" "0,9" "-0,2" ...
## $ Ce_ppm_MS_ST : chr "0,4" "8,8" "16,3" "3,5" ...
## $ Co_ppm_MS_ST : chr "209" "-0,5" "1,3" "44,8" ...
## $ Cr_ppm_AES_ST : int -10 -10 -10 30 20 20 60 40 20 10 ...
## $ Cs_ppm_MS_ST : chr "0,5" "1,4" "0,2" "-0,1" ...
## $ Cu_ppm_AES_ST : chr "50000,11111" "23300" "50000,11111" "50000,11111" ...
## $ Dy_ppm_MS_ST : chr "-0,05" "0,32" "1,38" "0,37" ...
## $ Er_ppm_MS_ST : chr "-0,05" "0,22" "0,77" "0,23" ...
## $ Eu_ppm_MS_ST : chr "-0,05" "0,14" "0,17" "0,1" ...
## $ Ga_ppm_MS_ST : chr "5" "15" "6" "3" ...
## $ Gd_ppm_MS_ST : chr "-0,05" "0,45" "1,5" "0,39" ...
## $ Ge_ppm_MS_ST : int -1 5 -1 -1 3 8 8 1 2 2 ...
## $ Hf_ppm_MS_ST : int -1 4 -1 -1 5 13 12 2 3 6 ...
## $ Ho_ppm_MS_ST : chr "-0,05" "0,07" "0,25" "0,07" ...
## $ In_ppm_MS_ST : chr "6,4" "-0,2" "3,7" "0,2" ...
## $ La_ppm_MS_ST : chr "0,2" "4,6" "7,2" "1,7" ...
## $ Li_ppm_AES_ST : int -10 -10 -10 -10 30 20 20 20 -10 20 ...
## $ Lu_ppm_MS_ST : chr "-0,05" "-0,05" "0,08" "-0,05" ...
## $ Mo_ppm_MS_ST : chr "-2" "60" "3" "2" ...
## $ Nb_ppm_MS_ST : chr "-1" "4" "-1" "-1" ...
## $ Nd_ppm_MS_ST : chr "0,2" "3,8" "9,1" "1,7" ...
## $ Ni_ppm_AES_ST : chr "144" "6" "-5" "48" ...
## $ Pb_ppm_MS_ST : chr "23" "16" "188" "39" ...
## $ Pd_ppm_FA_MS : chr "" "" "" "" ...
## $ Pr_ppm_MS_ST : chr "-0,05" "1,09" "2,21" "0,46" ...
## $ Pt_ppm_FA_MS : chr "" "" "" "" ...
## $ Rb_ppm_MS_ST : chr "1,2" "148" "7,1" "0,7" ...
## $ Re_ppm_MS_HF : chr "" "" "" "" ...
## $ Sb_ppm_MS_ST : chr "1,2" "2,4" "2,9" "0,3" ...
## $ Sc_ppm_AES_ST : int -5 -5 -5 -5 11 6 15 10 5 6 ...
## $ Se_ppm_MS_ST : int NA NA NA NA NA NA NA NA NA NA ...
## $ Sm_ppm_MS_ST : chr "-0,1" "0,6" "1,6" "0,4" ...
## $ Sn_ppm_MS_ST : chr "2" "3" "106" "-1" ...
## $ Sr_ppm_AES_ST : chr "26,6" "114" "22,5" "38,4" ...
## $ Ta_ppm_MS_ST : chr "-0,5" "-0,5" "-0,5" "-0,5" ...
## $ Tb_ppm_MS_ST : chr "-0,05" "0,07" "0,23" "-0,05" ...
## $ Te_ppm_MS_ST : chr "" "" "" "" ...
## $ Th_ppm_MS_ST : chr "0,2" "9,7" "2,6" "0,2" ...
## $ Tl_ppm_MS_ST : chr "-0,5" "0,5" "-0,5" "-0,5" ...
## $ Tm_ppm_MS_ST : chr "-0,05" "-0,05" "0,08" "-0,05" ...
## $ U_ppm_MS_ST : chr "0,3" "1,75" "0,63" "34,8" ...
## $ V_ppm_AES_ST : int 51 24 -5 493 68 20 40 159 39 61 ...
## $ W_ppm_MS_ST : chr "-1" "28" "22" "11" ...
## [list output truncated]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 |
||
ANÁLISIS DESCRIPTIVO Y AGRUPACIÓN EN CLASES (STRUGES) DE ORO
ANÁLISIS DESCRIPTIVO Y AGRUPACIÓN EN CLASES (STRUGES) DE ORO
# Cargar las librerias necesarias
library(dplyr)
library(gt)
#------------------------- 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 |
|||||||||
POLÍGONO DE FRECUENCIAS
POLÍGONO DE FRECUENCIAS ABSOLUTAS DEL ORO (Au)
#----------------------- PROCESAMIENTO Au_ppm -----------------------
# 1. Conversión de Au_ppm a numérico y limpieza de datos
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. Reemplazamos 'pretty' por el cálculo estricto de Sturges
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
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
#----------------------- ANCLAJE A CERO -----------------------
# 5. Creamos las clases vacías a los extremos para que el polígono cierre en el eje X
mc_inicio_au <- hist_objeto_au$mids[1] - amplitud_au
mc_final_au <- hist_objeto_au$mids[length(hist_objeto_au$mids)] + amplitud_au
# Unimos los vectores definitivos para el gráfico (Marcas de Clase y Frecuencias hi)
marcas_clase_au <- c(mc_inicio_au, hist_objeto_au$mids, 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) -----------------------
par(mar = c(5, 5, 4, 2))
# 6. Inicializar el lienzo con los límites ajustados 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 = "Marca de Clase - MC (ppm)",
ylab = "Frecuencia Relativa - hi (%)",
xlim = c(min(marcas_clase_au), max(marcas_clase_au)), # Ajuste exacto para incluir los anclajes
ylim = c(0, max_y_hi_au * 1.15), # 15% de margen superior libre (pico muy alto)
xaxt = "n", yaxt = "n",
panel.first = grid(nx = NULL, ny = NULL, col = "gray90"))
# 7. Dibujar el polígono (Color dorado oscuro/bronce)
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: Imprime las Marcas de Clase (MC) reales de la tabla (3 decimales)
axis(1, at = hist_objeto_au$mids, labels = round(hist_objeto_au$mids, 3), 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), 2), las = 1, cex.axis = 0.8)
ANÁLISIS GRÁFICO: HISTOGRAMA DISTRIBUCIÓN DEL ORO
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)) 
#----------------------- 2. HISTOGRAMA REGLA DE STURGES -----------------------
# Calculamos k y los cortes exactos matemáticamente
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)
# Extraemos la información del histograma de forma invisible
h_info_au <- hist(Au_VAR, breaks = breaks_au, plot = FALSE, right = FALSE)
# Preparamos las etiquetas y colores
intervalos_au <- paste0("[", round(h_info_au$breaks[-length(h_info_au$breaks)], 3),
" - ", round(h_info_au$breaks[-1], 3), ")")
colores_hist_au <- colorRampPalette(c("#FFF2CC", "#FFD700", "#DAA520", "#B8860B"))(length(h_info_au$counts))
# Graficamos con margen derecho ampliado para la leyenda
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 = "Concentración de Au (ppm)",
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))
# Eje X y Leyenda
axis(1, at = breaks_au, labels = round(breaks_au, 1), font = 2, las = 0.7, cex.axis = 0.7)
legend("topright", inset=c(-0.35, 0), legend = intervalos_au, fill = colores_hist_au, title = "Intervalos (ppm)", cex = 0.85, bty = "n")
ANÁLISIS VISUAL ACUMULADO: OJIVA ASCENDENTE Y DESCENDENTE
OJIVAS ni Y hi
#----------------------- OJIVA INTEGRADA Y PROFESIONAL (Oro) -----------------------
# 1. Construimos los cortes exactos del eje X
cortes_eje_x_au <- c(liminf, limsup[length(limsup)])
# Restauramos los márgenes a la normalidad
par(mar=c(5, 5, 4, 2))
plot(MC, Ni_asc,
main = "Gráfica 4: Ojiva Acumulada de Frecuencias de 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"))
# Línea descendente
lines(MC, Ni_desc, type = "b", pch = 17, col = "chocolate", lwd = 3, lty = 2)
# Eje X con los intervalos exactos
axis(1, at = cortes_eje_x_au, labels = round(cortes_eje_x_au, 2), 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",
cex = 0.85) 
#----------------------- OJIVA PROFESIONAL EN PORCENTAJES (Au) - FRECUENCIAS RELATIVAS ---------
par(mar=c(5, 5, 4, 2))
plot(MC, Hi_asc,
main = "Gráfica 5: Ojiva Acumulada de Frecuencias de Oro (hi)",
xlab = "Contenido de Oro (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%
panel.first = grid(nx = NULL, ny = NULL, col = "gray90"))
# Línea descendente
lines(MC, Hi_desc, type = "b", pch = 17, col = "chocolate", lwd = 3, lty = 2)
# Eje X con los intervalos exactos
axis(1, at = cortes_eje_x_au, labels = round(cortes_eje_x_au, 2), cex.axis = 0.8)
# Leyenda adaptada a porcentajes
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)
BOXPLOT
BOXPLOTS DE VALORES ATÍPICOS Y DISTRIBUCIÓN LIMPIA
#----------------------- 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")
#----------------------- 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)
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
axis(1, at = breaks_au, labels = round(breaks_au, 1), 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
intervalos_au <- paste0("[", round(hist_pro_au$breaks[-length(hist_pro_au$breaks)], 2),
" - ", round(hist_pro_au$breaks[-1], 2), ")")
legend("topright", inset = c(-0.35, 0),
legend = intervalos_au,
fill = colores_hist_au,
title = "Intervalos (ppm)",
cex = 0.8, bty = "n")
RESUMEN DESCRIPTIVO
RESUMEN DESCRIPTIVO
# Cargar librerias necesarias
library(dplyr)
library(gt)
library(e1071) # Necesaria para calcular Asimetría (skewness) y Curtosis (kurtosis)
#----------------------- 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° 3**"),
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° 3 | |
| 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 |
|
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.