Análisis Estadístico por Variables Cuantitativas Ti_pct_AES_ST
Grupo 1
2026-05-31
CARGA DE DATOS
CARGA DE DATOS
knitr::opts_chunk$set(
echo = TRUE, # Muestra el código R en el reporte final.
message = FALSE,
warning = FALSE, # Message y warning evitan que se impriman alertas o mensajes de carga estorbosos en el HTML.
fig.align = "center" # Centra automáticamente todas las gráficas generadas.
)
datos <- read.csv("C:/Users/Martin/Desktop/Estadistica/CMDB_Data.csv",
header = TRUE, # Indica que la primera fila contienen los nombres de las variables.
sep = ";", # Define que los puntos y comas es el separador de las columnas del archivo.
dec = ".", # Establece el punto como el operador decimal para los números.
fileEncoding = "latin1")
# Verificación inicial del set de datos
str(datos)## 'data.frame': 1366 obs. of 103 variables:
## $ ï..LAB_ID : chr "C355417" "C360759" "C360762" "C360763" ...
## $ PREVIOUS_LAB_ID1 : chr "" "" "" "" ...
## $ PREVIOUS_LAB_ID2 : chr "" "" "" "" ...
## $ PREVIOUS_LAB_ID3 : chr "" "" "" "" ...
## $ FIELD_ID : chr "RM0001" "RM0027" "RM0030" "RM0031" ...
## $ JOB_ID : chr "MRP11968" "MRP12307" "MRP12307" "MRP12307" ...
## $ PREVIOUS_JOB_ID1 : chr "" "" "" "" ...
## $ PREVIOUS_JOB_ID2 : chr "" "" "" "" ...
## $ PREVIOUS_JOB_ID3 : chr "" "" "" "" ...
## $ SUBMITTER : chr "Rare Metals Task" "Rare Metals Task" "Rare Metals Task" "Rare Metals Task" ...
## $ PROJECT_NAME : chr "Critical and Rare Metals" "Critical and Rare Metals" "Critical and Rare Metals" "Critical and Rare Metals" ...
## $ X0 : chr "30/6/2011" "31/8/2011" "31/8/2011" "31/8/2011" ...
## $ COLLECTION : chr "Mackay-Keck Ore Deposits Collection" "Mackay-Stanford Ore Deposits Collection" "Mackay-Stanford Ore Deposits Collection" "Mackay-Stanford Ore Deposits Collection" ...
## $ COLLECTION_ID : chr "PHNC08_39_1183" "OD21441" "OD22811" "OD25716" ...
## $ CONTINENT : chr "North America" "South America" "South America" "Africa" ...
## $ COUNTRY : chr "United States" "Chile" "Chile" "South Africa" ...
## $ STATE_PROVINCE : chr "Nevada" "Antofagasta" "Tarapacá" "Transvaal" ...
## $ COUNTY : chr "Lyon" "El Loa" "El Tamarugal" "" ...
## $ DISTRICT_NAME : chr "Yerington" "Chuquicamata" "Collahuasi/Quebrada Blanca" "" ...
## $ DEPOSIT_NAME : chr "Pumpkin Hollow" "" "" "" ...
## $ MINE_NAME : chr "Pumpkin Hollow" "Chuquicamata mine" "Collahuasi district" "" ...
## $ DISTRICT_NAME_COLLECT: chr "Yerington" "" "" "" ...
## $ DEPOSIT_NAME_COLLECT : chr "" "" "" "" ...
## $ MINE_NAME_COLLECT : chr "Pumpkin Hollow" "Chuquicamata" "Poduosa mine" "Messina Mines Ltd." ...
## $ LOCATE_DESC : chr "" "" "Level 25" "" ...
## $ LATITUDE : chr "38,94021" "-22,2871" "-21,0309" "-24,7" ...
## $ LONGITUDE : chr "-119,05178" "-68,8991" "-68,74951" "29,3" ...
## $ DATUM : chr "WGS84" "WGS84" "WGS84" "" ...
## $ LATITUDE_COLLECT : chr "38,92492" "22,28944" "" "" ...
## $ LONGITUDE_COLLECT : chr "-119,1071" "-68,90111" "" "" ...
## $ DATUM_COLLECT : chr "" "WGS84" "" "" ...
## $ COORDINATES_QUAL : chr "100 m" "0m" "" "" ...
## $ COORDINATES_SOURCE : chr "1) iTouchMap.com, approx, A. Orkild-Norton; 2) Mineral Resource Deposit Database Deposit ID 10174173, ore body, M. Granitto" "1) Mindat.org, approx, A. Orkild-Norton; 2) Open-File Report 2017-1079 ID 549, mine, M. Granitto" "1) No coordinates; 2) Mineral Resource Deposit Database Deposit ID 10057511, district, M. Granitto" "1) No coordinates; 2) Google Earth Pro, approx ctr of former province of Transvaal, M. Granitto" ...
## $ PRIMARY_CLASS : chr "rock" "rock" "rock" "rock" ...
## $ SYSTEM_TYPE : chr "IOA-IOCG" "Porphyry Cu-Mo-Au" "Porphyry Cu-Mo-Au" "IOA-IOCG" ...
## $ DEPOSIT_TYPE : chr "IOCG" "Supergene Cu" "Porphyry Cu" "IOCG" ...
## $ SAMPLE_DESC : chr "Nearly solid chalcopyrite mixed with small light brown irregular inclusions of unknown mineralogy; clouds of ma"| __truncated__ "Chalcocite-bronchatite-antlerite(?); highly microfractured igneous rock with green copper sulfates coating microfractures" "Bornite-chalcopyrite; mostly massive chalcopyrite with numerous inclusions of micro-chalcopyrite and widely sca"| __truncated__ "Massive chalcopyrite, IOCG in shear zone; mostly massive fine grain cuprite with widely distributed malachite t"| __truncated__ ...
## $ Al_pct_AES_ST : chr "0,33" "6,65" "0,46" "0,7" ...
## $ Ca_pct_AES_ST : chr "1,1" "0,4" "-0,1" "0,3" ...
## $ Fe_pct_AES_ST : chr "42,4" "0,25" "6,98" "27,8" ...
## $ K_pct_AES_ST : chr "-0,1" "6,1" "0,2" "-0,1" ...
## $ Mg_pct_AES_ST : chr "0,57" "0,1" "0,01" "0,33" ...
## $ Mn_pct_AES_ST : chr "0,02" "-0,01" "-0,01" "-0,01" ...
## $ P_pct_AES_ST : chr "-0,01" "0,01" "0,05" "0,01" ...
## $ S_pct_AES_ST : chr "" "" "" "" ...
## $ Si_pct_AES_ST : chr "" "" "" "" ...
## $ Ti_pct_AES_ST : chr "0,01" "0,11" "-0,01" "-0,01" ...
## $ F_pct_ISE_Fuse : chr "" "" "" "" ...
## $ Ag_ppm_MS_ST : chr "58" "6" "468" "16" ...
## $ As_ppm_MS_ST : chr "-30" "-30" "90" "-30" ...
## $ Au_ppm : chr "" "" "" "" ...
## $ Au_AM : chr "" "" "" "" ...
## $ B_ppm_AES_ST : int NA NA NA NA NA NA NA NA NA NA ...
## $ Ba_ppm_AES_ST : chr "-0,5" "924" "121" "174" ...
## $ Be_ppm_AES_ST : int -5 -5 -5 -5 -5 -5 -5 -5 -5 -5 ...
## $ Bi_ppm_MS_ST : chr "1,5" "3,6" "190" "0,4" ...
## $ Cd_ppm_MS_ST : chr "3,6" "-0,2" "0,9" "-0,2" ...
## $ Ce_ppm_MS_ST : chr "0,4" "8,8" "16,3" "3,5" ...
## $ Co_ppm_MS_ST : chr "209" "-0,5" "1,3" "44,8" ...
## $ Cr_ppm_AES_ST : int -10 -10 -10 30 20 20 60 40 20 10 ...
## $ Cs_ppm_MS_ST : chr "0,5" "1,4" "0,2" "-0,1" ...
## $ Cu_ppm_AES_ST : chr "50000,11111" "23300" "50000,11111" "50000,11111" ...
## $ Dy_ppm_MS_ST : chr "-0,05" "0,32" "1,38" "0,37" ...
## $ Er_ppm_MS_ST : chr "-0,05" "0,22" "0,77" "0,23" ...
## $ Eu_ppm_MS_ST : chr "-0,05" "0,14" "0,17" "0,1" ...
## $ Ga_ppm_MS_ST : chr "5" "15" "6" "3" ...
## $ Gd_ppm_MS_ST : chr "-0,05" "0,45" "1,5" "0,39" ...
## $ Ge_ppm_MS_ST : int -1 5 -1 -1 3 8 8 1 2 2 ...
## $ Hf_ppm_MS_ST : int -1 4 -1 -1 5 13 12 2 3 6 ...
## $ Ho_ppm_MS_ST : chr "-0,05" "0,07" "0,25" "0,07" ...
## $ In_ppm_MS_ST : chr "6,4" "-0,2" "3,7" "0,2" ...
## $ La_ppm_MS_ST : chr "0,2" "4,6" "7,2" "1,7" ...
## $ Li_ppm_AES_ST : int -10 -10 -10 -10 30 20 20 20 -10 20 ...
## $ Lu_ppm_MS_ST : chr "-0,05" "-0,05" "0,08" "-0,05" ...
## $ Mo_ppm_MS_ST : chr "-2" "60" "3" "2" ...
## $ Nb_ppm_MS_ST : chr "-1" "4" "-1" "-1" ...
## $ Nd_ppm_MS_ST : chr "0,2" "3,8" "9,1" "1,7" ...
## $ Ni_ppm_AES_ST : chr "144" "6" "-5" "48" ...
## $ Pb_ppm_MS_ST : chr "23" "16" "188" "39" ...
## $ Pd_ppm_FA_MS : chr "" "" "" "" ...
## $ Pr_ppm_MS_ST : chr "-0,05" "1,09" "2,21" "0,46" ...
## $ Pt_ppm_FA_MS : chr "" "" "" "" ...
## $ Rb_ppm_MS_ST : chr "1,2" "148" "7,1" "0,7" ...
## $ Re_ppm_MS_HF : chr "" "" "" "" ...
## $ Sb_ppm_MS_ST : chr "1,2" "2,4" "2,9" "0,3" ...
## $ Sc_ppm_AES_ST : int -5 -5 -5 -5 11 6 15 10 5 6 ...
## $ Se_ppm_MS_ST : int NA NA NA NA NA NA NA NA NA NA ...
## $ Sm_ppm_MS_ST : chr "-0,1" "0,6" "1,6" "0,4" ...
## $ Sn_ppm_MS_ST : chr "2" "3" "106" "-1" ...
## $ Sr_ppm_AES_ST : chr "26,6" "114" "22,5" "38,4" ...
## $ Ta_ppm_MS_ST : chr "-0,5" "-0,5" "-0,5" "-0,5" ...
## $ Tb_ppm_MS_ST : chr "-0,05" "0,07" "0,23" "-0,05" ...
## $ Te_ppm_MS_ST : chr "" "" "" "" ...
## $ Th_ppm_MS_ST : chr "0,2" "9,7" "2,6" "0,2" ...
## $ Tl_ppm_MS_ST : chr "-0,5" "0,5" "-0,5" "-0,5" ...
## $ Tm_ppm_MS_ST : chr "-0,05" "-0,05" "0,08" "-0,05" ...
## $ U_ppm_MS_ST : chr "0,3" "1,75" "0,63" "34,8" ...
## $ V_ppm_AES_ST : int 51 24 -5 493 68 20 40 159 39 61 ...
## $ W_ppm_MS_ST : chr "-1" "28" "22" "11" ...
## [list output truncated]Se cargaron los datos de todas las variables.
ANÁLISIS DE FRECUENCIAS: CONCENTRACIÓN DE TITANIO (Ti)
ANÁLISIS DE FRECUENCIAS: CONCENTRACIÓN DE TITANIO (Ti)
library(dplyr)
library(gt)
#----------------------- PROCESAMIENTO Ti_pct_AES_ST -----------------------
# 1. Limpieza y preparación de la variable
datos$Ti_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Ti_pct_AES_ST))))
# Separar registros con concentraciones válidas de los nulos/negativos
ti_numerico <- datos$Ti_pct_AES_ST[datos$Ti_pct_AES_ST >= 0 & !is.na(datos$Ti_pct_AES_ST)]
n_sin_datos <- sum(is.na(datos$Ti_pct_AES_ST) | datos$Ti_pct_AES_ST < 0)
# 2. Tabla de Frecuencias de los valores geoquímicos reales
TDF_VALIDOS <- as.data.frame(table(ti_numerico), stringsAsFactors = FALSE)
colnames(TDF_VALIDOS) <- c("CATEGORIA", "ni")
# Convertir categoría a numérico para ordenar de menor a mayor concentración (%)
TDF_VALIDOS$CATEGORIA <- as.numeric(TDF_VALIDOS$CATEGORIA)
TDF_VALIDOS <- TDF_VALIDOS[order(TDF_VALIDOS$CATEGORIA), ]
# Definición de horizontes cuantitativos
total_variable <- sum(TDF_VALIDOS$ni) # Total de muestras con datos de Ti
total_general <- total_variable + n_sin_datos # Total absoluto de la matriz
# 3. Agrupación: Top 10 valores de concentración más bajos + Otros
if(nrow(TDF_VALIDOS) > 10) {
tabla_top <- head(TDF_VALIDOS, 10)
sum_otros <- sum(TDF_VALIDOS$ni[11:nrow(TDF_VALIDOS)])
fila_otros <- data.frame(CATEGORIA = "Otras Concentraciones", ni = sum_otros)
tabla_final_base <- rbind(tabla_top, fila_otros)
} else {
tabla_final_base <- TDF_VALIDOS
}
# Convertir CATEGORIA a carácter para permitir la unión de las filas de totales
tabla_final_base$CATEGORIA <- as.character(tabla_final_base$CATEGORIA)
# 4. Calcular frecuencias (hi) escaladas a 100 respecto al total general
tabla_final_base$hi <- round((tabla_final_base$ni / total_general) * 100, 4)
# 5. FILA DEL TOTAL EXCLUSIVO DE LA VARIABLE (Muestras con lecturas de Ti)
fila_total_var <- data.frame(
CATEGORIA = "TOTAL VARIABLE (Ti)",
ni = total_variable,
hi = round((total_variable / total_general) * 100, 4)
)
# 6. FILA DE CONTRASTE: REGISTROS SIN INFORMACIÓN ANALÍTICA
fila_sin_datos <- data.frame(
CATEGORIA = "Sin Datos",
ni = n_sin_datos,
hi = round((n_sin_datos / total_general) * 100, 4)
)
# 7. FILA DEL TOTAL GENERAL DEL PROYECTO
fila_total_general <- data.frame(
CATEGORIA = "TOTAL GENERAL",
ni = total_general,
hi = 100 # Forzado para cierre perfecto de balance estadístico
)
# Consolidar toda la matriz de datos en orden lógico estructurado
tabla_final <- rbind(tabla_final_base, fila_total_var, fila_sin_datos, fila_total_general)
colnames(tabla_final) <- c("Valor Ti (%)", "ni", "hi")
#----------------------- GENERAR SALIDA ESTÉTICA CON 'gt' -----------------------
tabla_ti_completa_gt <- tabla_final %>%
gt() %>%
tab_header(
title = md("**Tabla N° 1**"),
subtitle = md("Distribución de frecuencias para concentraciones de Titanio (Ti)")
) %>%
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_ti_completa_gt| Tabla N° 1 | ||
| Distribución de frecuencias para concentraciones de Titanio (Ti) | ||
| Valor Ti (%) | ni | hi |
|---|---|---|
| 0.01 | 75 | 5.4905 |
| 0.02 | 83 | 6.0761 |
| 0.03 | 56 | 4.0996 |
| 0.04 | 46 | 3.3675 |
| 0.05 | 35 | 2.5622 |
| 0.06 | 27 | 1.9766 |
| 0.07 | 23 | 1.6837 |
| 0.08 | 23 | 1.6837 |
| 0.09 | 40 | 2.9283 |
| 0.1 | 14 | 1.0249 |
| Otras Concentraciones | 542 | 39.6779 |
| TOTAL VARIABLE (Ti) | 964 | 70.5710 |
| Sin Datos | 402 | 29.4290 |
| TOTAL GENERAL | 1366 | 100.0000 |
| Autores: Grupo 1 Semestre 2026 - 2026 |
||
ANÁLISIS DESCRIPTIVO Y AGRUPACIÓN EN CLASES (STRUGES) DEL TITANIO
ANÁLISIS DESCRIPTIVO Y AGRUPACIÓN EN CLASES (STRUGES) DEL TITANIO
# Cargar las librerías al inicio
library(dplyr)
library(gt)
#------------------------- PREPARACIÓN DE DATOS -------------------------
datos$Ti_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Ti_pct_AES_ST))))
# Creamos la variable de trabajo Ti asegurando que los datos estén limpios y sin negativos
Ti <- datos$Ti_pct_AES_ST[!is.na(datos$Ti_pct_AES_ST) & datos$Ti_pct_AES_ST >= 0]
#------------------------- ANÁLISIS DE CONCENTRACIÓN (ESTADÍSTICOS) -------------------------
cat("\n=======================================================\n")##
## =======================================================cat("ANÁLISIS DE CONCENTRACIÓN (Ti_pct_AES_ST):\n")## ANÁLISIS DE CONCENTRACIÓN (Ti_pct_AES_ST):cat("La concentración promedio es: ", round(mean(Ti, na.rm = TRUE), 3), " % \n")## La concentración promedio es: 0.212 %cat("La concentración máxima detectada es: ", max(Ti, na.rm = TRUE), " % \n")## La concentración máxima detectada es: 2.42 %cat("Total de muestras analizadas: ", sum(!is.na(Ti)), " registros \n")## Total de muestras analizadas: 964 registroscat("=======================================================\n")## =======================================================#------------------------- TABLA DE FRECUENCIAS - STURGES -------------------------
# 1. Parámetros básicos: Rango, Número de clases (Sturges) y Amplitud
R <- max(Ti, na.rm = TRUE) - min(Ti, na.rm = TRUE)
k <- floor(1 + 3.322 * log10(length(Ti)))
A <- R / k
# 2. Definición de límites y Marcas de Clase (MC)
liminf <- seq(from = min(Ti, 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(Ti >= liminf[i] & Ti <= limsup[i], na.rm = TRUE)
} else {
n[i] <- sum(Ti >= liminf[i] & Ti < 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 -------------------------
TablaTi_Sturges <- data.frame(
Clase = as.character(1:k),
liminf = round(liminf, 3),
limsup = round(limsup, 3),
MC = round(MC, 3),
n = n,
hi = round(hi, 2),
Ni_asc = Ni_asc,
Hi_asc = round(Hi_asc, 2),
Ni_desc = Ni_desc,
Hi_desc = round(Hi_desc, 2)
)
# Fila de TOTALES para cierre de tabla
fila_totales_Ti <- data.frame(
Clase = "**TOTALES**",
liminf = NA,
limsup = NA,
MC = NA,
n = sum(n),
hi = 100,
Ni_asc = NA,
Hi_asc = NA,
Ni_desc = NA,
Hi_desc = NA
)
# Unión de cuerpo y totales
TablaTi_Final <- rbind(TablaTi_Sturges, fila_totales_Ti)
#------------------------- MOSTRAR TABLA FINAL CON 'gt' -------------------------
tabla_sturges_ti_gt <- TablaTi_Final %>%
gt() %>%
tab_header(
title = md("**Tabla N° 2**"),
subtitle = md("Distribución de frecuencias para concentraciones de Titanio (Ti_pct_AES_ST) <br> mediante Regla de Sturges")
) %>%
tab_source_note(
source_note = md("Autores: Grupo 1 <br> Semestre 2026 - 2026")
) %>%
fmt_markdown(columns = Clase) %>%
cols_label(
Clase = "Clase",
liminf = "Linf (%)",
limsup = "Lsup (%)",
MC = "MC (%)",
n = "n (abs)",
hi = "hi (%)",
Ni_asc = "Ni (↑)",
Hi_asc = "Hi (↑)",
Ni_desc = "Ni (↓)",
Hi_desc = "Hi (↓)"
) %>%
tab_options(
table.border.top.color = "black",
table.border.bottom.color = "black",
heading.border.bottom.color = "black",
heading.border.bottom.width = px(2),
column_labels.border.top.color = "black",
column_labels.border.bottom.color = "black",
column_labels.border.bottom.width = px(2),
table_body.hlines.color = "gray",
table_body.border.bottom.color = "black",
row.striping.include_table_body = TRUE
) %>%
sub_missing(
columns = everything(),
missing_text = "NA"
)
# Renderizar la tabla en el reporte
tabla_sturges_ti_gt| Tabla N° 2 | |||||||||
| Distribución de frecuencias para concentraciones de Titanio (Ti_pct_AES_ST) mediante Regla de Sturges |
|||||||||
| Clase | Linf (%) | Lsup (%) | MC (%) | n (abs) | hi (%) | Ni (↑) | Hi (↑) | Ni (↓) | Hi (↓) |
|---|---|---|---|---|---|---|---|---|---|
| 1 | 0.010 | 0.251 | 0.130 | 666 | 69.09 | 666 | 69.09 | 964 | 100.00 |
| 2 | 0.251 | 0.492 | 0.372 | 211 | 21.89 | 877 | 90.98 | 298 | 30.91 |
| 3 | 0.492 | 0.733 | 0.613 | 52 | 5.39 | 929 | 96.37 | 87 | 9.02 |
| 4 | 0.733 | 0.974 | 0.854 | 16 | 1.66 | 945 | 98.03 | 35 | 3.63 |
| 5 | 0.974 | 1.215 | 1.094 | 10 | 1.04 | 955 | 99.07 | 19 | 1.97 |
| 6 | 1.215 | 1.456 | 1.336 | 2 | 0.21 | 957 | 99.27 | 9 | 0.93 |
| 7 | 1.456 | 1.697 | 1.577 | 4 | 0.41 | 961 | 99.69 | 7 | 0.73 |
| 8 | 1.697 | 1.938 | 1.818 | 1 | 0.10 | 962 | 99.79 | 3 | 0.31 |
| 9 | 1.938 | 2.179 | 2.059 | 1 | 0.10 | 963 | 99.90 | 2 | 0.21 |
| 10 | 2.179 | 2.420 | 2.300 | 1 | 0.10 | 964 | 100.00 | 1 | 0.10 |
| TOTALES | NA | NA | NA | 964 | 100.00 | NA | NA | NA | NA |
| Autores: Grupo 1 Semestre 2026 - 2026 |
|||||||||
POLÍGONO DE FRECUENCIA
POLÍGONO DE FRECUENCIAS RELATIVAS DEL TITANIO (Ti)
#----------------------- PROCESAMIENTO AUTOMÁTICO Ti_PCT_AES_ST -----------------------
# 1. Conversión de la variable a numérico y limpieza de datos
datos$Ti_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Ti_pct_AES_ST))))
Ti_VAR <- datos$Ti_pct_AES_ST[!is.na(datos$Ti_pct_AES_ST) & datos$Ti_pct_AES_ST >= 0]
#----------------------- EXTRACCIÓN METODOLÓGICA DE STURGES -----------------------
# 2. Parámetros base desde la tabla
n_total <- length(Ti_VAR)
k_sturges <- floor(1 + 3.322 * log10(n_total))
rango_ti <- max(Ti_VAR) - min(Ti_VAR)
amplitud_ti <- rango_ti / k_sturges
breaks_sturges <- seq(from = min(Ti_VAR), by = amplitud_ti, length.out = k_sturges + 1)
# 3. Captura de datos en memoria (plot = FALSE)
hist_objeto <- hist(Ti_VAR, breaks = breaks_sturges, plot = FALSE, right = FALSE)
# Extraemos las Marcas de Clase (MC) reales del gráfico
mc_reales <- hist_objeto$mids
# Convertimos los conteos absolutos a frecuencias relativas porcentuales (hi %)
hi_porcentaje <- (hist_objeto$counts / n_total) * 100
#----------------------- ANCLAJE A CERO CON MARCAS DE CLASE -----------------------
# 4. Creamos los extremos ficticios para que el polígono toque el eje X en cero
mc_inicio <- mc_reales[1] - amplitud_ti
mc_final <- mc_reales[length(mc_reales)] + amplitud_ti
# Unimos los puntos: Marcas de Clase (X) y Frecuencias Relativas hi (Y)
marcas_clase_ti <- c(mc_inicio, mc_reales, mc_final)
frecuencias_hi_ti <- c(0, hi_porcentaje, 0)
# Detectamos el porcentaje máximo real para calibrar el eje Y
max_y_hi <- max(frecuencias_hi_ti)
#----------------------- GRAFICAR POLÍGONO DE FRECUENCIAS (hi) -----------------------
par(mar = c(6, 5, 4, 2)) # Margen inferior ligeramente amplio para las MC verticales
# 5. Inicializar el lienzo ajustado a las Marcas de Clase y porcentajes
plot(marcas_clase_ti, frecuencias_hi_ti,
type = "n",
main = "Gráfica 1: Polígono de Frecuencias Relativas de Titanio (Ti)",
xlab = "Concentración de Ti (%)",
ylab = "Frecuencia Relativa - hi (%)",
xlim = c(mc_inicio, mc_final),
ylim = c(0, max_y_hi * 1.1), # Un 10% de espacio arriba del pico más alto
xaxt = "n", yaxt = "n",
panel.first = grid(nx = NULL, ny = NULL, col = "gray90")) # Rejilla de fondo
# 6. DIBUJAR EL POLÍGONO
lines(marcas_clase_ti, frecuencias_hi_ti, type = "l", col = "darkblue", lwd = 3)
# Luego dibujamos los puntos (pch=19) ÚNICAMENTE en las marcas de clase reales de tu tabla
points(mc_reales, hi_porcentaje, pch = 19, col = "darkblue", cex = 1.2)
# 7. Relleno translúcido bajo la curva
polygon(marcas_clase_ti, frecuencias_hi_ti, col = rgb(0, 0, 0.5, 0.12), border = NA)
#----------------------- PERSONALIZACIÓN DE EJES CONTINUOS -----------------------
# Eje X: Imprime las Marcas de Clase
axis(1, at = mc_reales, labels = round(mc_reales, 3), cex.axis = 0.75, las = 1)
# Eje Y: Valores horizontales dinámicos calculados a partir de los datos
marcas_eje_y <- pretty(c(0, max_y_hi))
axis(2, at = marcas_eje_y,
labels = paste0(marcas_eje_y, "%"),
las = 1, cex.axis = 0.8)
ANÁLISIS GRÁFICO: HISTOGRAMA DISTRIBUCIÓN DE TITANIO
HISTOGRAMA DISTRIBUCIÓN DE TITANIO
#----------------------- PROCESAMIENTO Ti_pct_AES_ST -----------------------
# 1. Conversión de Ti_pct_AES_ST a numérico
datos$Ti_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Ti_pct_AES_ST))))
# Creamos variable de trabajo para las gráficas y FILTRAMOS los negativos
Ti_VAR <- datos$Ti_pct_AES_ST
Ti_VAR <- Ti_VAR[Ti_VAR >= 0 & !is.na(Ti_VAR)]
#----------------------- TABLA DE FRECUENCIAS SIMPLIFICADA -----------------------
# Al ser continua, agrupamos por rangos automáticos (bins) para que la tabla sea legible
k_simplificado <- 5
breaks_ti_simp <- pretty(Ti_VAR, n = k_simplificado)
HistogramaTi <- hist(Ti_VAR, breaks = breaks_ti_simp, plot = FALSE)
# 2. Generación del Histograma Simplificado
total_muestras_ti <- length(Ti_VAR)
hist(Ti_VAR,
breaks = breaks_ti_simp,
main = "Grafica 2: Distribucion de Ti_pct_AES_ST (Simplificada)",
xlab = "Concentracion de Ti (%)",
ylab = "Cantidad de muestras",
col = "#81C784",
ylim = c(0, total_muestras_ti), # REGLA: Límite Y fijado al total de muestras
right = FALSE)
# ==============================================================================
# 1. PREPARACIÓN DE DATOS (MÉTODO STURGES)
# ==============================================================================
datos$Ti_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Ti_pct_AES_ST))))
Ti_VAR <- datos$Ti_pct_AES_ST[!is.na(datos$Ti_pct_AES_ST) & datos$Ti_pct_AES_ST >= 0]
# ==============================================================================
# 2. CONFIGURACIÓN METODOLÓGICA (STURGES)
# ==============================================================================
k_sturges <- floor(1 + 3.322 * log10(length(Ti_VAR)))
rango_ti <- max(Ti_VAR) - min(Ti_VAR)
amplitud_ti <- rango_ti / k_sturges
breaks_sturges <- seq(from = min(Ti_VAR), by = amplitud_ti, length.out = k_sturges + 1)
# CREACIÓN CRÍTICA DEL OBJETO
hist_pro <- hist(Ti_VAR, breaks = breaks_sturges, plot = FALSE, right = FALSE)
# ==============================================================================
# 3. TEXTOS Y COLORES
# ==============================================================================
colores_degrade <- colorRampPalette(c("cyan", "blue", "purple"))(k_sturges)
etiquetas_intervalos <- paste0("[", round(breaks_sturges[1:k_sturges], 3), " - ",
round(breaks_sturges[2:(k_sturges+1)], 3), "]")
# ==============================================================================
# 4. CONSTRUCCIÓN DE LA GRÁFICA (BARPLOT)
# ==============================================================================
par(mar = c(6, 5, 4, 11))
# Guardamos el barplot en un objeto 'bp' para obtener las coordenadas exactas de las barras
# REGLA APLICADA: ylim = c(0, length(Ti_VAR))
bp <- barplot(hist_pro$counts,
names.arg = rep("", k_sturges),
col = colores_degrade,
border = "white",
main = "Grafica 3: Distribucion de Ti_pct_AES_ST (Regla de Sturges)",
ylab = "Frecuencia (Cantidad)",
xlab = "Contenido de Titanio (%)",
ylim = c(0, length(Ti_VAR)),
yaxt = "n")
# Añadir frecuencias arriba de cada barra
text(x = bp,
y = hist_pro$counts,
labels = hist_pro$counts,
pos = 3, cex = 0.85, font = 2)
# ==============================================================================
# 5. PERSONALIZACIÓN DE EJES Y LEYENDA
# ==============================================================================
# Eje Y (Fijamos marcas usando el límite total)
marcas_y <- pretty(c(0, length(Ti_VAR)))
axis(2, at = marcas_y, labels = marcas_y, las = 1, cex.axis = 0.85)
# 6. EJE X
# Calculamos los puntos de quiebre de las barras
ancho_barra <- bp[2] - bp[1]
posiciones_bordes_x <- c(bp - (ancho_barra / 2), max(bp) + (ancho_barra / 2))
# Dibujamos el eje X usando todos los breaks de Sturges
axis(1, at = posiciones_bordes_x,
labels = round(breaks_sturges, 2), cex.axis = 0.7)
# 7. Leyenda a la derecha
legend(x = max(bp) + (ancho_barra * 1.5), y = max(hist_pro$counts),
legend = etiquetas_intervalos,
fill = colores_degrade,
title = "Intervalos (%)",
xpd = TRUE, bty = "n", cex = 0.8)
ANÁLISIS VISUAL ACUMULADO: OJIVA ASCENDENTE Y DESCENDENTE
OJIVAS ni Y hi
#----------------------- PREPARACIÓN DE CORTES ENTEROS -----------------------
paso_ti <- if (ceiling(max(Ti_VAR)) > 10) 1 else 0.5
breaks_entero <- seq(0, ceiling(max(Ti_VAR)) + paso_ti, by = paso_ti)
#----------------------- OJIVA INTEGRADA Y PROFESIONAL -----------------------
par(mar=c(5, 5, 4, 2))
plot(MC, Ni_asc,
main = "Gráfica 4: Ojiva Combinada de Frecuencias del Titanio (ni)",
xlab = "Contenido de Titanio (%)",
ylab = "Frecuencia Acumulada (N muestras)",
type = "b", pch = 19, col = "blue", lwd = 3,
xaxt = "n", las = 1,
ylim = c(0, max(Ni_asc) * 1.05),
panel.first = grid(nx = NULL, ny = NULL, col = "gray90"))
# Segunda línea (Descendente)
lines(MC, Ni_desc, type = "b", pch = 17, col = "red", lwd = 3, lty = 2)
# Eje X con los intervalos exactos
axis(1, at = breaks_entero, labels = breaks_entero)
# Leyenda reubicada en el espacio vacío del lado derecho
legend("right",
legend = c("Acumulada Menor que (Ascendente)", "Acumulada Mayor que (Descendente)"),
col = c("blue", "red"),
lty = c(1, 2),
pch = c(19, 17),
lwd = 2,
title = "Tipo de Ojiva",
bty = "n",
cex = 0.85) 
#----------------------- OJIVA PROFESIONAL TITANIO - EN PORCENTAJES (Hi) -----------------------
MC_graficar <- MC[!is.na(MC)]
Hi_asc_graficar <- Hi_asc[1:length(MC_graficar)]
Hi_desc_graficar <- Hi_desc[1:length(MC_graficar)]
# Definir los cortes del eje X
breaks_ti <- c(liminf[!is.na(liminf)], limsup[length(limsup) - 1])
# 2. Configurar los márgenes para la leyenda
par(mar=c(5, 5, 4, 2))
# 3. Graficar la curva ascendente
plot(MC_graficar, Hi_asc_graficar,
main = "Gráfica 5 : Ojiva Acumulada de Frecuencias de Titanio (hi)",
xlab = "Concentración de Titanio - Ti (%)",
ylab = "Frecuencia Relativa Acumulada (%)",
type = "b", pch = 19, col = "blue", lwd = 3,
xaxt = "n", las = 1,
ylim = c(0, 105),
panel.first = grid(nx = NULL, ny = NULL, col = "gray90"))
# 4. Línea descendente perfectamente emparejada
lines(MC_graficar, Hi_desc_graficar, type = "b", pch = 17, col = "red", lwd = 3, lty = 2)
# 5. Dibujar el Eje X con los intervalos exactos
axis(1, at = breaks_ti, labels = round(breaks_ti, 3), cex.axis = 0.8)
# 6. Leyenda técnica reubicada
legend("right",
legend = c("Acumulada Menor que (Ascendente %)", "Acumulada Mayor que (Descendente %)"),
col = c("blue", "red"),
lty = c(1, 2),
pch = c(19, 17),
lwd = 2,
title = "Tipo de Ojiva",
bty = "n",
cex = 0.85)
BOXPLOT
BOXPLOTS DE VALORES ATÍPICOS Y DISTRIBUCIÓN LIMPIA
#----------------------- PREPARACIÓN DE DATOS (Titanio) -----------------------
# Conversión a numérico y limpieza de valores nulos o en cero
datos$Ti_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Ti_pct_AES_ST))))
Ti_VAR <- datos$Ti_pct_AES_ST[!is.na(datos$Ti_pct_AES_ST) & datos$Ti_pct_AES_ST > 0]
#----------------------- BOXPLOT: ANÁLISIS DE VALORES ATÍPICOS -----------------------
par(mar=c(5, 6, 5, 2), xpd = FALSE)
# Cálculos estadísticos previos
stats_ti <- boxplot.stats(Ti_VAR)
media_ti <- round(mean(Ti_VAR), 3)
mediana_ti <- round(median(Ti_VAR), 3)
n_outliers <- length(stats_ti$out)
# Generación del Boxplot
boxplot(Ti_VAR, horizontal = TRUE, col = "#E0E0E0", border = "#424242",
main = " Gráfica 6: Análisis de Valores Atípicos (Titanio)",
xlab = "Concentración de Ti (%)",
pch = 21,
bg = "red",
col.outline = "darkred",
frame = FALSE)
# Punto de Media y etiquetas de texto mejor ubicadas
points(media_ti, 1,
col = "blue",
pch = 18,
cex = 2)
text(media_ti, 1.25,
labels = paste("Media:", media_ti),
col = "blue",
font = 2,
cex = 0.9)
text(mediana_ti, 0.75,
labels = paste("Mediana:", mediana_ti),
col = "#424242",
font = 2,
cex = 0.9)
# Leyenda
legend("topright",
legend = paste("Atípicos detectados:", n_outliers),
pch = 21,
pt.bg = "red",
bty = "n",
text.col = "darkred",
cex = 0.9)
#-----------------------BOXPLOT: DISTRIBUCIÓN LIMPIA (TITANIO) -----------------------
par(mar=c(5, 6, 5, 2))
# Generación del Boxplot sin valores atípicos (outline = FALSE)
boxplot(Ti_VAR,
horizontal = TRUE,
outline = FALSE,
col = "#E0E0E0",
border = "#424242",
main = "Gráfica 7: Distribución del Cuerpo Mineral (Sin Atípicos) - Titanio",
xlab = "Concentración de Ti (%)",
frame = FALSE)
# Agregar cuadrícula de fondo
grid(nx = NULL,
ny = NA,
col = "gray85",
lty = "dashed")
# Valores sobre la vista limpia
points(media_ti, 1,
col = "#E65100",
pch = 18,
cex = 2)
text(media_ti, 1.25,
labels = paste("Media:", media_ti),
col = "#BF360C",
font = 2,
cex = 0.9)
text(mediana_ti, 0.75,
labels = paste("Mediana:", mediana_ti),
col = "#424242",
font = 2,
cex = 0.9)
HISTOGRAMA CON BOXPLOT SUPERPUESTO (TITANIO)
HISTOGRAMA CON BOXPLOT FLOTANTE (TITANIO)
#----------------------- PREPARACIÓN DE DATOS -----------------------
datos$Ti_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Ti_pct_AES_ST))))
Ti_VAR <- datos$Ti_pct_AES_ST[!is.na(datos$Ti_pct_AES_ST) & datos$Ti_pct_AES_ST >= 0]
total_muestras_ti <- length(Ti_VAR)
# Metodología de Sturges
k_sturges <- floor(1 + 3.322 * log10(total_muestras_ti))
rango_ti <- max(Ti_VAR) - min(Ti_VAR)
amplitud_ti <- rango_ti / k_sturges
breaks_sturges <- seq(from = min(Ti_VAR), by = amplitud_ti, length.out = k_sturges + 1)
#----------------------- CÁLCULO DEL HISTOGRAMA (INVISIBLE) -----------------------
hist_pro <- hist(Ti_VAR, breaks = breaks_sturges, plot = FALSE, right = FALSE)
#----------------------- CÁLCULO DEL RANGO X TOTAL -----------------------
xlim_range <- range(c(Ti_VAR, breaks_sturges))
# Aseguramos márgenes
par(mar = c(5, 5, 4, 12), xpd = TRUE)
#----------------------- GRÁFICA INTEGRADA (HISTOGRAMA) -----------------------
colores_degrade <- colorRampPalette(c("cyan", "blue", "purple"))(length(hist_pro$counts))
hist(Ti_VAR,
breaks = breaks_sturges,
col = colores_degrade,
border = "white",
main = "Gráfica 8: Distribución de Titanio con Boxplot Interno",
xlab = "Concentración de Titanio (%)",
ylab = "Frecuencia (Cantidad)",
xlim = xlim_range,
ylim = c(0, total_muestras_ti), # REGLA: Límite Y fijado al total de muestras
las = 1,
labels = TRUE,
right = FALSE,
xaxt = "n")
axis(1, at = breaks_sturges, labels = round(breaks_sturges, 3), font = 2, cex.axis = 0.5)
# 3. Superponemos el Boxplot directamente
# Usamos el espacio superior que quedó libre para hacer flotar la caja elegantemente
altura_flotacion <- total_muestras_ti * 0.70 # El boxplot flotará al 70% de la altura total
grosor_caja <- total_muestras_ti * 0.15
boxplot(Ti_VAR,
horizontal = TRUE,
add = TRUE,
axes = FALSE,
at = altura_flotacion,
boxwex = grosor_caja,
col = rgb(0.53, 0.81, 0.98, alpha = 0.7),
border = "#1C1C1C",
lwd = 1.5,
pch = 21, bg = "red",
outcol = "darkred")
# 4. Añadimos la leyenda lateral
intervalos_ti <- paste0("[", round(hist_pro$breaks[-length(hist_pro$breaks)], 3),
" - ", round(hist_pro$breaks[-1], 3), ")")
legend("topright", inset=c(-0.35, 0),
legend = intervalos_ti,
fill = colores_degrade,
title = "Intervalos (%)",
cex = 0.8, bty = "n")
RESUMEN DESCRIPTIVO
RESUMEN DESCRIPTIVO
# Cargar las librerías al inicio
library(dplyr)
library(gt)
library(e1071) # Necesaria para el cálculo de Asimetría y Curtosis
#----------------------- ANÁLISIS ESTADÍSTICO Ti_pct_AES_ST -----------------------
# 1. Preparación de la variable continua
datos$Ti_pct_AES_ST <- suppressWarnings(as.numeric(gsub(",", ".", as.character(datos$Ti_pct_AES_ST))))
# 2. Limpieza de valores nulos o negativos
Ti_LIMPIA <- datos$Ti_pct_AES_ST[!is.na(datos$Ti_pct_AES_ST) & datos$Ti_pct_AES_ST >= 0]
# 3. Cálculos estadísticos descriptivos consolidados aplicando simbología
resumen_stats_Ti <- 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(Ti_LIMPIA),
min(Ti_LIMPIA),
max(Ti_LIMPIA),
mean(Ti_LIMPIA),
median(Ti_LIMPIA),
sd(Ti_LIMPIA),
(sd(Ti_LIMPIA) / mean(Ti_LIMPIA)) * 100,
skewness(Ti_LIMPIA, type = 2),
kurtosis(Ti_LIMPIA)
)
)
# 4. Redondeo técnico para presentación en el reporte (2 decimales)
resumen_stats_Ti$Valor <- round(resumen_stats_Ti$Valor, 2)
#----------------------- SALIDA ESTÉTICA CON 'gt' -----------------------
tabla_stats_ti_gt <- resumen_stats_Ti %>%
gt() %>%
tab_header(
title = md("**Tabla N° 3**"),
subtitle = md("Estadística Descriptiva para Concentraciones de Titanio (Ti)")
) %>%
tab_source_note(
source_note = md("Autores: Grupo 1 <br> Semestre 2026 - 2026")
) %>%
cols_label(
Estadistico = "Parámetro Estadístico",
Valor = "Resultado"
) %>%
tab_options(
table.border.top.color = "black",
table.border.bottom.color = "black",
heading.border.bottom.color = "black",
heading.border.bottom.width = px(2),
column_labels.border.top.color = "black",
column_labels.border.bottom.color = "black",
column_labels.border.bottom.width = px(2),
table_body.hlines.color = "gray",
table_body.border.bottom.color = "black",
row.striping.include_table_body = TRUE
)
# Renderizar la tabla en el documento de RMarkdown
tabla_stats_ti_gt| Tabla N° 3 | |
| Estadística Descriptiva para Concentraciones de Titanio (Ti) | |
| Parámetro Estadístico | Resultado |
|---|---|
| Tamaño muestral (n) | 964.00 |
| Mínimo (Min) | 0.01 |
| Máximo (Max) | 2.42 |
| Media (x̄) | 0.21 |
| Mediana (Me) | 0.13 |
| Desviación Estándar (s) | 0.25 |
| Coef. Variación (CV) | 118.16 |
| Asimetría (As) | 3.08 |
| Curtosis (K) | 15.47 |
| Autores: Grupo 1 Semestre 2026 - 2026 |
|
CONCLUSION
CONCLUSIÓN DE LA VARIABLE Ti_pct_AES_ST
El análisis descriptivo del titanio (Ti) sobre 964 muestras válidas reporta un rango de 0.01% a 2.42%, con una media de 0.21% y una mediana de 0.13%. Su coeficiente de variación (118.16%) y desviación estándar (0.25) reflejan una dispersión alta, característica del comportamiento geoquímico heterogéneo de este elemento en el yacimiento. Finalmente, los índices de forma muestran una asimetría fuertemente positiva de 3.08 y una curtosis elevada de 15.47, lo que indica una distribución agrupada hacia valores bajos con presencia de colas pesadas y valores atípicos, evidenciando la naturaleza de la mineralización en el sector estudiado.