Análisis Multivariable de Muestras de Minas Archivadas
Grupo 1
2026-06-20
1. CARGA DE DATOS
knitr::opts_chunk$set(
echo = TRUE,
message = FALSE,
warning = FALSE,
fig.align = "center"
)
datos <- read.csv("C:/Users/USER/Documents/PROYECTO ESTADISTICA/CMDB_Data.csv",
header = TRUE,
sep = ";",
dec = ",",
fileEncoding = "latin1")
# Verificación inicial
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 : num 38.9 -22.3 -21 -24.7 62.7 ...
## $ LONGITUDE : num -119.1 -68.9 -68.7 29.3 29 ...
## $ DATUM : chr "WGS84" "WGS84" "WGS84" "" ...
## $ LATITUDE_COLLECT : num 38.9 22.3 NA NA 62.7 ...
## $ LONGITUDE_COLLECT : num -119.1 -68.9 NA NA 29 ...
## $ 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 : num 0.33 6.65 0.46 0.7 9.48 1.54 5.32 4.34 5.31 7.9 ...
## $ Ca_pct_AES_ST : num 1.1 0.4 -0.1 0.3 8.5 11.4 10.8 2.4 1.1 0.9 ...
## $ Fe_pct_AES_ST : num 42.4 0.25 6.98 27.8 8.92 10.8 14.3 10.8 1.93 3.21 ...
## $ K_pct_AES_ST : num -0.1 6.1 0.2 -0.1 0.4 -0.1 1.6 2.2 1.5 3.9 ...
## $ Mg_pct_AES_ST : num 0.57 0.1 0.01 0.33 7.39 2.15 0.36 1.01 0.85 0.88 ...
## $ Mn_pct_AES_ST : num 0.02 -0.01 -0.01 -0.01 0.04 0.79 0.48 0.01 -0.01 0.02 ...
## $ P_pct_AES_ST : num -0.01 0.01 0.05 0.01 0.06 0.43 0.22 0.05 0.08 0.07 ...
## $ S_pct_AES_ST : num NA NA NA NA NA NA NA NA NA NA ...
## $ Si_pct_AES_ST : num NA NA NA NA NA NA NA NA NA NA ...
## $ Ti_pct_AES_ST : num 0.01 0.11 -0.01 -0.01 0.28 0.24 0.52 0.3 0.29 0.25 ...
## $ F_pct_ISE_Fuse : num NA NA NA NA NA NA NA NA NA NA ...
## $ Ag_ppm_MS_ST : num 58 6 468 16 21 24 92 12 10 -1 ...
## $ As_ppm_MS_ST : num -30 -30 90 -30 50 -30 90 -30 -30 -30 ...
## $ Au_ppm : num NA NA NA NA NA NA NA NA NA NA ...
## $ Au_AM : chr "" "" "" "" ...
## $ B_ppm_AES_ST : int NA NA NA NA NA NA NA NA NA NA ...
## $ Ba_ppm_AES_ST : num -0.5 924 121 174 8100 3.2 251 234 361 995 ...
## $ Be_ppm_AES_ST : int -5 -5 -5 -5 -5 -5 -5 -5 -5 -5 ...
## $ Bi_ppm_MS_ST : num 1.5 3.6 190 0.4 12.5 5 80.8 0.6 11.7 0.7 ...
## $ Cd_ppm_MS_ST : num 3.6 -0.2 0.9 -0.2 5.7 447 9.2 -0.2 -0.2 6.8 ...
## $ Ce_ppm_MS_ST : num 0.4 8.8 16.3 3.5 15.2 104 49.7 28.3 15.8 76.3 ...
## $ Co_ppm_MS_ST : num 209 -0.5 1.3 44.8 4.5 92.2 105 45.5 8 48.6 ...
## $ Cr_ppm_AES_ST : int -10 -10 -10 30 20 20 60 40 20 10 ...
## $ Cs_ppm_MS_ST : num 0.5 1.4 0.2 -0.1 0.8 10.6 0.4 2.8 0.6 5.1 ...
## $ Cu_ppm_AES_ST : num 50000 23300 50000 50000 18600 ...
## $ Dy_ppm_MS_ST : num -0.05 0.32 1.38 0.37 2.65 7.43 5.12 1.56 0.75 4.12 ...
## $ Er_ppm_MS_ST : num -0.05 0.22 0.77 0.23 1.63 3.98 2.89 0.78 0.34 2.17 ...
## $ Eu_ppm_MS_ST : num -0.05 0.14 0.17 0.1 0.42 1.5 0.99 0.66 0.37 1.14 ...
## $ Ga_ppm_MS_ST : num 5 15 6 3 52 19 26 17 22 27 ...
## $ Gd_ppm_MS_ST : num -0.05 0.45 1.5 0.39 2.9 8.29 5.72 2.42 1.12 4.88 ...
## $ 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 : num -0.05 0.07 0.25 0.07 0.53 1.49 1.05 0.28 0.13 0.74 ...
## $ In_ppm_MS_ST : num 6.4 -0.2 3.7 0.2 0.5 26.7 5.4 0.4 -0.2 -0.2 ...
## $ La_ppm_MS_ST : num 0.2 4.6 7.2 1.7 5.5 40.8 26.4 13.3 7.7 39.2 ...
## $ Li_ppm_AES_ST : int -10 -10 -10 -10 30 20 20 20 -10 20 ...
## $ Lu_ppm_MS_ST : num -0.05 -0.05 0.08 -0.05 0.22 0.64 0.44 0.11 0.06 0.36 ...
## $ Mo_ppm_MS_ST : num -2 60 3 2 14 6 473 69 3 9 ...
## $ Nb_ppm_MS_ST : num -1 4 -1 -1 9 13 13 1 3 12 ...
## $ Nd_ppm_MS_ST : num 0.2 3.8 9.1 1.7 9.5 41.7 23.5 14.9 8 29.3 ...
## $ Ni_ppm_AES_ST : num 144 6 -5 48 24 26 22 23 13 21 ...
## $ Pb_ppm_MS_ST : num 23 16 188 39 546 6 39 -5 17 17 ...
## $ Pd_ppm_FA_MS : num NA NA NA NA NA NA NA NA NA NA ...
## $ Pr_ppm_MS_ST : num -0.05 1.09 2.21 0.46 2.12 10.9 5.98 3.5 2.06 8.54 ...
## $ Pt_ppm_FA_MS : num NA NA NA NA NA NA NA NA NA NA ...
## $ Rb_ppm_MS_ST : num 1.2 148 7.1 0.7 5.2 3.4 65.8 98.8 31.8 169 ...
## $ Re_ppm_MS_HF : num NA NA NA NA NA NA NA NA NA NA ...
## $ Sb_ppm_MS_ST : num 1.2 2.4 2.9 0.3 8.1 1.2 3.7 0.3 0.3 1.5 ...
## $ 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 : num -0.1 0.6 1.6 0.4 2.6 8.1 5.1 2.6 1.5 4.9 ...
## $ Sn_ppm_MS_ST : num 2 3 106 -1 3 19 43 7 1 2 ...
## $ Sr_ppm_AES_ST : num 26.6 114 22.5 38.4 284 5.3 264 149 526 446 ...
## $ Ta_ppm_MS_ST : num -0.5 -0.5 -0.5 -0.5 -0.5 0.9 1.1 -0.5 -0.5 1.1 ...
## $ Tb_ppm_MS_ST : num -0.05 0.07 0.23 -0.05 0.45 1.29 0.86 0.27 0.13 0.73 ...
## $ Te_ppm_MS_ST : num NA NA NA NA NA NA NA NA NA NA ...
## $ Th_ppm_MS_ST : num 0.2 9.7 2.6 0.2 2.6 9.2 37.7 1.8 2.7 13.7 ...
## $ Tl_ppm_MS_ST : num -0.5 0.5 -0.5 -0.5 -0.5 -0.5 -0.5 -0.5 -0.5 0.9 ...
## $ Tm_ppm_MS_ST : num -0.05 -0.05 0.08 -0.05 0.22 0.67 0.47 0.1 -0.05 0.36 ...
## $ U_ppm_MS_ST : num 0.3 1.75 0.63 34.8 31.2 10.6 9.94 1.64 0.69 15.4 ...
## $ V_ppm_AES_ST : int 51 24 -5 493 68 20 40 159 39 61 ...
## $ W_ppm_MS_ST : num -1 28 22 11 8 223 30 83 -1 37 ...
## [list output truncated]# CARGA DE LIBRERÍAS
library(dplyr)##
## Adjuntando el paquete: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(knitr)
library(gt)
library(MASS) # Necesaria para Estimación robusta##
## Adjuntando el paquete: 'MASS'## The following object is masked from 'package:dplyr':
##
## select2. TABLA DE PARES DE VALORES
VAR_X <- as.numeric(datos$Ti_pct_AES_ST)
VAR_Y <- as.numeric(datos$Zr_ppm_AES_ST)
TPV <- data.frame(VAR_X, VAR_Y)
# Limpieza inicial de nulos y ceros
TPV <- na.omit(TPV)
TPV <- TPV[TPV$VAR_X > 0 & TPV$VAR_Y > 0, ]
# -------------------------------------------------------------------
# MÉTODO RIGUROSO: DISTANCIA DE MAHALANOBIS ROBUSTA
# -------------------------------------------------------------------
set.seed(2345)
estimacion_robusta <- cov.rob(TPV)
distancias <- mahalanobis(TPV,
center = estimacion_robusta$center,
cov = estimacion_robusta$cov)
umbral_chi2 <- qchisq(0.975, df = 2)
TPV_limpio <- TPV[distancias <= umbral_chi2, ]
# Filtro final
TPV_FILTRADO <- TPV_limpio[TPV_limpio$VAR_X < 20 & TPV_limpio$VAR_Y < 80, ]
# -------------------------------------------------------------------
# AGRUPACIÓN PARA MAXIMIZAR CORRELACIÓN
# -------------------------------------------------------------------
tabla_media <- aggregate(VAR_Y ~ VAR_X,
data = TPV_FILTRADO,
FUN = mean)
# Extraemos las variables procesadas de la tabla agregada
x_media <- tabla_media$VAR_X
y_media <- tabla_media$VAR_Y
tabla_media## VAR_X VAR_Y
## 1 0.01 9.291892
## 2 0.02 15.288312
## 3 0.03 18.465385
## 4 0.04 21.259459
## 5 0.05 26.203333
## 6 0.06 28.043478
## 7 0.07 35.821053
## 8 0.08 32.222222
## 9 0.09 44.354839
## 10 0.10 33.354545
## 11 0.11 42.375000
## 12 0.12 28.986667
## 13 0.13 37.657143
## 14 0.14 48.000000
## 15 0.15 55.928571
## 16 0.16 50.514286
## 17 0.17 22.500000
## 18 0.18 50.060000
## 19 0.19 40.550000
## 20 0.20 48.033333
## 21 0.21 53.833333
## 22 0.22 60.900000
## 23 0.23 59.600000
## 24 0.24 63.300000
## 25 0.26 58.250000
## 26 0.27 76.7000003. DIAGRAMA DE DISPERSIÓN
plot(x_media, y_media,
pch = 16,
col = "darkblue",
main = "Gráfica N°1: Diagrama de Dispersión Promediada\nTitanio (Ti) sobre Circonio (Zr)",
xlab = "Concentración de Titanio (%)",
ylab = "Concentración de Circonio (ppm)")
grid(nx = NULL, ny = NULL, col = "lightgray", lty = "dotted")
4. CONJETURA DEL MODELO
Debido a la similitud de la nube de puntos conjeturamos a un modelo polinomial
# Cálculo de parámetros
xcuad <- x_media^2
xcub <- x_media^3
xcta <- x_media^4
# Se usan las variables de la tabla media
regresion_polinomica <- lm(y_media ~ x_media + xcuad + xcub + xcta)
regresion_polinomica ##
## Call:
## lm(formula = y_media ~ x_media + xcuad + xcub + xcta)
##
## Coefficients:
## (Intercept) x_media xcuad xcub xcta
## 1.466 744.177 -5498.918 18195.833 -16430.594summary(regresion_polinomica)##
## Call:
## lm(formula = y_media ~ x_media + xcuad + xcub + xcta)
##
## Residuals:
## Min 1Q Median 3Q Max
## -22.2303 -2.2802 0.9559 3.8965 13.4690
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.466 9.503 0.154 0.879
## x_media 744.177 453.142 1.642 0.115
## xcuad -5498.918 6425.780 -0.856 0.402
## xcub 18195.833 34198.500 0.532 0.600
## xcta -16430.594 60574.420 -0.271 0.789
##
## Residual standard error: 7.751 on 21 degrees of freedom
## Multiple R-squared: 0.8221, Adjusted R-squared: 0.7882
## F-statistic: 24.27 on 4 and 21 DF, p-value: 1.288e-07beta0 <- regresion_polinomica$coefficients[1]
beta1 <- regresion_polinomica$coefficients[2]
beta2 <- regresion_polinomica$coefficients[3]
beta3 <- regresion_polinomica$coefficients[4]
beta4 <- regresion_polinomica$coefficients[5]
a <- beta0
b <- beta1
c <- beta2
d <- beta3
e <- beta4
# AGREGAR LA CURVA
plot(x_media, y_media,
pch = 16,
col = "blue",
main ="Gráfica Nº 2: Comparación de la realidad con el \nmodelo polinómico entre Titanio y Circonio",
xlab ="Contenido de Titanio (%)",
ylab ="Contenido de Circonio (ppm)"
)
# Generar la curva
# Nota: La 'x' dentro de la ecuación se mantiene porque la función curve() la exige por defecto,
# pero los límites (from, to) deben apuntar a 'x_media'.
curve(a + b*x + c*x^2 + d*x^3 + e*x^4,
from = min(x_media),
to = max(x_media),
add = TRUE,
col="red",
lwd = 2)
4.1 ECUACIÓN DEL MODELO
plot(1, type = "n", axes = FALSE, xlab = "", ylab = "")
eq <- paste0(
"Ecuación polinómica (grado 4)\n",
"Y = a + bX + cX^2 + dX^3 + eX^4\n\n",
"Y = ", round(a, 2),
" + ", round(b, 2), "X",
" + ", round(c, 2), "X^2",
" + ", round(d, 2), "X^3",
" + ", round(e, 2), "X^4\n\n",
"Donde: X = Titanio (%) | Y = Circonio (ppm)"
)
text(1, 1, labels = eq, cex = 0.8, col = "blue", font = 2)
5. TEST DE APROBACIÓN Y RESTRICCIONES
5.1 TEST DE PEARSON
r <- cor(y_media, fitted(regresion_polinomica))
r * 100## [1] 90.671175.2 COEFICIENTE DE DETERMINACIÓN
r2 <- r^2
r2 * 100## [1] 82.21265.3 RESTRICCIONES
min(x_media)## [1] 0.01max(x_media)## [1] 0.27Sí existe una restricción de aplicabilidad, ya que el modelo polinómico es estadísticamente confiable únicamente dentro del rango de valores observados del contenido de Titanio (%), el cual varía entre 0.01 y 0.27. Al intentar realizar predicciones fuera de este intervalo (extrapolación), el modelo pierde capacidad predictiva y puede no representar adecuadamente el comportamiento geoquímico real de las muestras de minas archivadas.
6. ESTIMACIÓN DE PRONÓSTICOS
¿Cuál sería la concentración de circonio esperada si el contenido de titanio es del 0.16%?
# CÁLCULO
x0 <- 0.16
zr_esp <- a + b*x0 + c*x0^2 + d*x0^3 + e*x0^4
zr_esp## (Intercept)
## 43.52396plot(1, type = "n", axes = FALSE, xlab = "", ylab = "")
text(1, 1,
labels = paste0("¿Cuál sería la concentración de circonio esperada\n",
"si el contenido de titanio es del 0.16 %?\n\n",
"R = ", round(zr_esp, 4), " ppm"),
cex = 1.4,
col = "blue",
font = 2)
7. CONCLUSIÓN
Entre el contenido de Titanio (%) y la concentración de Circonio (ppm) se observa una relación de tipo polinomial de cuarto grado, representada por el modelo \(f(x) = 1.47 + 744.18X + -5498.92X^2 + 18195.83X^3 + -16430.59X^4\), donde \(x\) corresponde al contenido de Titanio (%) y \(y\) a la concentración de Circonio (ppm).El modelo presenta una alta confiabilidad dentro del rango geoquímico observado, el cual varía entre 0.01 % y 0.27 % de Titanio. Se determina que la variabilidad en la concentración de Circonio está explicada significativamente por el modelo polinómico, mientras que el porcentaje residual de la variabilidad se atribuye a factores geológicos o procesos de fraccionamiento no contemplados en este análisis.
Ejemplo de aplicación: Cuando el contenido de Titanio es del 0.16 %, el modelo predice una concentración de Circonio aproximada de 43.524 ppm.