Análisis Estadístico por Variables Cuantitativas Au_ppm
Grupo 1
2026-23-05
CARGA DE DATOS Y LIBRERIAS
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)
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 |
||
POLÍGONO DE FRECUENCIAS
#----------------------- 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]
#----------------------- PREPARACIÓN DEL POLÍGONO -----------------------
# 2. Definimos los cortes de clase (bins) usando pretty
au_simplificado <- 5
breaks_p <- pretty(Au_VAR, n = au_simplificado)
# 3. Calculamos el histograma internamente (sin graficar) para extraer las frecuencias
hist_data <- hist(Au_VAR, breaks = breaks_p, plot = FALSE, right = FALSE)
# 4. TRUCO ESTADÍSTICO: Añadir clases con frecuencia 0 a los extremos
# Calculamos la amplitud del intervalo (ancho de banda)
amplitud <- diff(breaks_p[1:2])
# Creamos las marcas de clase de los extremos artificiales
mc_inicio <- hist_data$mids[1] - amplitud
mc_final <- hist_data$mids[length(hist_data$mids)] + amplitud
# Unimos todo en los vectores definitivos para el gráfico (X e Y)
marcas_clase <- c(mc_inicio, hist_data$mids, mc_final)
frecuencias <- c(0, hist_data$counts, 0)
# Detectamos el máximo real para escalar el eje Y de forma continua
max_y <- max(frecuencias)
#----------------------- GRAFICAR POLÍGONO DE FRECUENCIAS -----------------------
# 5. Configurar lienzo limpio para el gráfico lineal
# 'type = "n"' genera un gráfico invisible para configurar los ejes a nuestra medida
plot(marcas_clase, frecuencias,
type = "n",
main = "Gráfica 9: Polígono de Frecuencias para Concentraciones de Oro (Au)",
xlab = "Concentración de Oro - Au (ppm)",
ylab = "Cantidad de muestras",
xlim = c(min(breaks_p), max(breaks_p)), # Ajusta el ancho al rango de tus cortes reales
ylim = c(0, max_y * 1.1), # 10% de margen superior libre
xaxt = "n", yaxt = "n",
panel.first = grid(nx = NULL, ny = NULL, col = "gray90")) # Rejilla sutil de fondo
# 6. Dibujar el polígono (Línea de estructura y puntos de control)
lines(marcas_clase, frecuencias, type = "b", pch = 19, col = "darkblue", lwd = 3)
# 7. Rellenar el área bajo la curva (Estética profesional opcional, puedes comentarla si no te gusta)
polygon(marcas_clase, frecuencias, col = rgb(0, 0, 0.5, 0.15), border = NA)
# 8. Personalización estricta de ejes continuos
# Eje X con los cortes exactos de tus intervalos
axis(1, at = breaks_p, labels = breaks_p, cex.axis = 0.8)
# Eje Y inteligente con tu máximo absoluto integrado sin cortes de línea
marcas_eje_y <- pretty(c(0, max_y))
marcas_eje_y <- marcas_eje_y[marcas_eje_y < (max_y * 0.9)] # Filtra colisiones numéricas
axis(2, at = c(marcas_eje_y, max_y), labels = c(marcas_eje_y, max_y), las = 1, cex.axis = 0.8)
ANÁLISIS GRÁFICO: HISTOGRAMA DISTRIBUCIÓN DE ORO
#----------------------- PROCESAMIENTO Au_ppm -----------------------
# 1. Conversión de Au_ppm a numérico (blindado contra comas y textos)
datos$Au_ppm <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Au_ppm))))
# Creamos variable de trabajo para las gráficas y FILTRAMOS negativos/NAs
Au_VAR <- datos$Au_ppm[!is.na(datos$Au_ppm) & datos$Au_ppm >= 0]
#----------------------- TABLA DE FRECUENCIAS SIMPLIFICADA -----------------------
# Agrupamos por rangos automáticos (bins) para legibilidad
au_simplificado <- 5
# Usamos pretty para obtener cortes redondeados y estéticos
breaks_s <- pretty(Au_VAR, n = au_simplificado)
# 2. Generación del Histograma
# Mantenemos la lógica original aplicada ahora al Oro
hist(Au_VAR,
breaks = breaks_s,
main = "Grafica 1: Distribucion de Au_ppm (Simplificada)",
xlab = "Concentracion de Au (ppm)",
ylab = "Cantidad de muestras",
col = "gold",
right = FALSE)
ANÁLISIS DESCRIPTIVO Y AGRUPACIÓN EN CLASES (STRUGES) DE ORO
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 |
|||||||||
HISTOGRAMA MEJORADO DE LA VARIABLE
#----------------------- PREPARACIÓN DE DATOS (Oro) -----------------------
# Usamos 'datos' en minúsculas.
# Filtramos NAs, números negativos, y limitamos a < 10 para excluir outliers extremos.
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 & datos$Au_ppm < 10]
# Definimos intervalos manuales de 1 en 1 para que el oro sea legible
breaks_au <- seq(0, ceiling(max(Au_VAR)), by = 1)
# Cálculo de la tabla de frecuencias para extraer los datos
h_data_au <- hist(Au_VAR, breaks = breaks_au, plot = FALSE)
MC_au <- h_data_au$mids
Ni_asc_au <- cumsum(h_data_au$counts)
Ni_desc_au <- rev(cumsum(rev(h_data_au$counts)))
#----------------------- 1. HISTOGRAMA MEJORADO (Au) -----------------------
# Aumentamos margen superior para que el título y los números tengan espacio
par(mar=c(5, 5, 5, 2))
h_plot_au <- hist(Au_VAR, breaks = breaks_au,
main = "Gráfica 2: Distribución del Contenido de Oro (ppm)",
xlab = "Contenido de Oro (ppm)",
ylab = "Frecuencia (Cantidad)",
col = "gold", border = "darkgoldenrod", # Paleta adaptada al Oro
xaxt = "n", # Quitamos eje X para poner números enteros limpios
las = 1,
ylim = c(0, max(h_data_au$counts) * 1.2)) # Espacio dinámico para las etiquetas
# Eje X con números enteros claros
axis(1, at = breaks_au, labels = breaks_au, font = 2)
# Etiquetas con los valores exactos encima de las barras
text(h_plot_au$mids, h_plot_au$counts, labels = h_plot_au$counts,
adj = c(0.5, -0.5), cex = 0.9, font = 2, col = "black")
ANÁLISIS VISUAL ACUMULADO: OJIVA ASCENDENTE Y DESCENDENTE
#----------------------- OJIVA PROFESIONAL (Au) -----------------------
# Restauramos los márgenes a la normalidad ya que pondremos la leyenda adentro (estética limpia)
par(mar=c(5, 5, 4, 2))
plot(MC_au, Ni_asc_au,
main = "Gráfia 3: Ojiva Combinada 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_au) * 1.05),
panel.first = grid(nx = NULL, ny = NULL, col = "gray90")) # Rejilla de fondo
# Línea descendente
lines(MC_au, Ni_desc_au, type = "b", pch = 17, col = "chocolate", lwd = 3, lty = 2)
# Eje X con los intervalos exactos
axis(1, at = breaks_au, labels = breaks_au)
# Leyenda reubicada en el espacio vacío del lado derecho para evitar que se corte
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
cex = 0.85) # Tamaño de letra ajustado
#----------------------- 2. OJIVA PROFESIONAL (Au) - EN PORCENTAJES (Hi) -----------------------
# 1. Definir los cortes del eje X uniendo el límite inferior de cada clase y el último superior
breaks_au <- c(liminf, limsup[length(limsup)])
# 2. Restaurar los márgenes para la leyenda
par(mar=c(5, 5, 4, 2))
# 3. Graficar usando las variables calculadas en el paso de Sturges (MC y Hi_asc)
plot(MC, Hi_asc,
main = "Gráfica 4: 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),
panel.first = grid(nx = NULL, ny = NULL, col = "gray90"))
# 4. Línea descendente (utilizando Hi_desc)
lines(MC, Hi_desc, type = "b", pch = 17, col = "chocolate", lwd = 3, lty = 2)
# 5. Dibujar el Eje X con los intervalos exactos (redondeados a 2 decimales para estética)
axis(1, at = breaks_au, labels = round(breaks_au, 2), cex.axis = 0.8)
# 6. Leyenda reubicada
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)
ANÁLISIS VISUAL POR RANGOS DE AU_PPM
#----------------------- PREPARACIÓN 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]
#----------------------- CÁLCULO DE INTERVALOS (STURGES EXACTO) -----------------------
k <- floor(1 + 3.322 * log10(length(Au_VAR)))
R_rango <- max(Au_VAR) - min(Au_VAR)
A_amplitud <- R_rango / k
breaks_au <- seq(from = min(Au_VAR), by = A_amplitud, length.out = k + 1)
# Usamos right = FALSE para que el conteo sea [a, b) idéntico a tu tabla
h_info_au <- hist(Au_VAR, breaks = breaks_au, plot = FALSE, right = FALSE)
# Etiquetas con los intervalos exactos de la tabla
intervalos_au <- paste0("[", round(h_info_au$breaks[-length(h_info_au$breaks)], 3),
" - \n", round(h_info_au$breaks[-1], 3), ")")
# Paleta dorada
colores_au <- colorRampPalette(c("#FFD54F","#FFF8E1", "#FFB300", "#F57F17", "#E65100"))(length(h_info_au$counts))
#----------------------- HISTOGRAMA REAL (BARRAS JUNTAS) -----------------------
par(mar=c(7, 5, 4, 2), xpd = TRUE)
bp_au <- barplot(h_info_au$counts,
names.arg = intervalos_au,
col = colores_au,
border = "black",
space = 0,
main = "Gráfica 5: Distribución de Oro (Au_ppm)",
xlab = "",
ylab = "Frecuencia Absoluta n(abs)",
las = 1,
cex.names = 0.7,
ylim = c(0, max(h_info_au$counts) * 1.15))
# Título del eje X
mtext("Intervalos de Clase (ppm)", side = 1, line = 4, font = 2)
# Valores exactos sobre las barras
text(x = bp_au,
y = h_info_au$counts,
labels = h_info_au$counts,
pos = 3,
cex = 1,
font = 2,
col = "black")
BOXPLOT
#----------------------- 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 (Con los 127 datos)
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 con todos los datos (escala hasta 1500)
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 (VISTA LIMPIA - CORREGIDO) -----------------------
# Graficamos de forma simple controlando únicamente la escala horizontal de los datos (ylim)
boxplot(Au_VAR,
horizontal = TRUE,
outline = FALSE,
col = "#C8E6C9",
border = "#2E7D32",
main = "Gráfica 8: 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)
RESUMEN DESCRIPTIVO
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 (ppm)",
"Máximo (ppm)",
"Media (ppm)",
"Mediana (ppm)",
"Desviación Estándar",
"Coef. Variación (%)",
"Asimetría",
"Curtosis"),
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 (ppm) | 0.01 |
| Máximo (ppm) | 1500.11 |
| Media (ppm) | 39.33 |
| Mediana (ppm) | 0.23 |
| Desviación Estándar | 198.48 |
| Coef. Variación (%) | 504.62 |
| Asimetría | 6.75 |
| Curtosis | 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.