Análisis Multivariable Lineal 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$La_ppm_MS_ST)
VAR_Y <- as.numeric(datos$Ce_ppm_MS_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, ]
# Imprimir el tamaño muestral total
total_datos <- nrow(TPV)
cat("Total de datos válidos utilizados para el análisis completo:", total_datos, "\n\n")## Total de datos válidos utilizados para el análisis completo: 1263# -------------------------------------------------------------------
# AGRUPACIÓN
# -------------------------------------------------------------------
tabla_media <- aggregate(VAR_Y ~ VAR_X,
data = TPV,
FUN = mean)
# Extraemos las variables procesadas de la tabla agregada
x_media <- tabla_media$VAR_X
y_media <- tabla_media$VAR_Y
# Mostrar la tabla final
cat("Mostrando las primeras 20 filas de la tabla:\n")## Mostrando las primeras 20 filas de la tabla:print(head(tabla_media, n = 20))## VAR_X VAR_Y
## 1 0.1 0.3000000
## 2 0.2 0.4676471
## 3 0.3 0.5481481
## 4 0.4 1.5095238
## 5 0.5 0.9388889
## 6 0.6 1.2473684
## 7 0.7 1.6722222
## 8 0.8 1.4916667
## 9 0.9 1.5937500
## 10 1.0 2.3000000
## 11 1.1 2.1666667
## 12 1.2 2.1818182
## 13 1.3 2.6222222
## 14 1.4 2.3222222
## 15 1.5 2.4714286
## 16 1.6 3.1615385
## 17 1.7 3.0588235
## 18 1.8 4.1533333
## 19 1.9 4.1846154
## 20 2.0 4.37692313. DIAGRAMA DE DISPERSIÓN
plot(x_media, y_media,
pch = 16,
col = "darkblue",
main = "Gráfica N°1: Diagrama de Dispersión Promediada\nLantano sobre Cerio",
xlab = "Concentración de Lantano (La ppm)",
ylab = "Concentración de Cerio (Ce ppm)")
# Añadir la cuadrícula
grid(nx = NULL, ny = NULL, col = "lightgray", lty = "dotted")
4. CONJETURA DEL MODELO
DEBIDO A QUE LA NUBE DE PUNTOS ES COMPLEJA SE PROCEDE A TRATAR A LOS DATOS
4.1 TABLA DE PARES DE VALORES: tratamiento de datos (valor unico x, unico y)
VAR_X <- as.numeric(datos$La_ppm_MS_ST)
VAR_Y <- as.numeric(datos$Ce_ppm_MS_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: RANGO INTERCUARTÍLICO (IQR) UNIVARIADO
# -------------------------------------------------------------------
# 1. Límites para VAR_X
q1_x <- quantile(TPV$VAR_X, 0.25)
q3_x <- quantile(TPV$VAR_X, 0.75)
iqr_x <- q3_x - q1_x
limite_inferior_x <- q1_x - 1.5 * iqr_x
limite_superior_x <- q3_x + 1.5 * iqr_x
# 2. Límites para VAR_Y
q1_y <- quantile(TPV$VAR_Y, 0.25)
q3_y <- quantile(TPV$VAR_Y, 0.75)
iqr_y <- q3_y - q1_y
limite_inferior_y <- q1_y - 1.5 * iqr_y
limite_superior_y <- q3_y + 1.5 * iqr_y
# 3. Aplicar el filtro IQR de forma simultánea
TPV_limpio <- TPV[TPV$VAR_X >= limite_inferior_x & TPV$VAR_X <= limite_superior_x &
TPV$VAR_Y >= limite_inferior_y & TPV$VAR_Y <= limite_superior_y, ]
# Filtro final (manteniendo tus límites fijos de corte)
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
# Mostrar la tabla final
cat("Mostrando las primeras 20 filas de la tabla (Filtrado por IQR):\n")## Mostrando las primeras 20 filas de la tabla (Filtrado por IQR):print(head(tabla_media, n = 20))## VAR_X VAR_Y
## 1 0.1 0.3000000
## 2 0.2 0.4676471
## 3 0.3 0.5481481
## 4 0.4 1.5095238
## 5 0.5 0.9388889
## 6 0.6 1.2473684
## 7 0.7 1.6722222
## 8 0.8 1.4916667
## 9 0.9 1.5937500
## 10 1.0 2.3000000
## 11 1.1 2.1666667
## 12 1.2 2.1818182
## 13 1.3 2.6222222
## 14 1.4 2.3222222
## 15 1.5 2.4714286
## 16 1.6 3.1615385
## 17 1.7 3.0588235
## 18 1.8 4.1533333
## 19 1.9 4.1846154
## 20 2.0 4.37692314.2 DIAGRAMA DE DISPERSIÓN
plot(x_media, y_media,
pch = 16,
col = "darkblue",
main = "Gráfica N°2: Diagrama de Dispersión Promediada\nLantano (La) sobre Cerio (Ce)",
xlab = "Concentración de Lantano (La ppm)",
ylab = "Concentración de Cerio (Ce ppm)")
grid(nx = NULL, ny = NULL, col = "lightgray", lty = "dotted")
4.3 CONJETURA DEL MODELO
Debido a la similitud de la nube de puntos conjeturamos a un modelo lineal
# 1. DIAGRAMA DE DISPERSIÓN
plot(x_media, y_media,
pch = 16,
col = "darkblue",
main = "Gráfica N°3: Modelo Lineal sobre Promedios\nLantano sobre Cerio",
xlab = "Concentración de Lantano (La ppm)",
ylab = "Concentración de Cerio (Ce ppm)")
grid(nx = NULL, ny = NULL, col = "lightgray", lty = "dotted")
# 2. REGRESIÓN LINEAL PURA (Sin transformaciones)
regresion_lineal <- lm(y_media ~ x_media)
# Resumen estadístico
summary(regresion_lineal)##
## Call:
## lm(formula = y_media ~ x_media)
##
## Residuals:
## Min 1Q Median 3Q Max
## -18.2101 -1.2334 -0.0052 1.3783 12.1207
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.1413 0.5378 0.263 0.793
## x_media 1.9371 0.0490 39.536 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 3.681 on 173 degrees of freedom
## Multiple R-squared: 0.9004, Adjusted R-squared: 0.8998
## F-statistic: 1563 on 1 and 173 DF, p-value: < 2.2e-16# 3. EXTRACCIÓN DE COEFICIENTES
# a es el intercepto, b es la pendiente
a <- regresion_lineal$coefficients[1]
b <- regresion_lineal$coefficients[2]
# 4. AGREGAR LA LÍNEA AL GRÁFICO
abline(a, b, col = "red", lwd = 2)
4.4 ECUACIÓN DEL MODELO
plot(1, type = "n", axes = FALSE, xlab = "", ylab = "")
# Texto ajustado a la forma lineal Y = a + bX
eq <- paste0(
"Ecuación lineal\n",
"Y = a + bX\n",
"Y = ", round(a, 4), " + ", round(b, 4), " X"
)
text(1, 1, labels = eq, cex = 1.7, col = "black", font = 2)
5. TEST DE APROBACIÓN
5.1 TEST DE PEARSON
r <- cor(x_media, y_media)
r * 100## [1] 94.88684APRUEBA EL TEST
6. RESTICCIONES
No existen restricciones, la ecuación funciona para los valores fuera de lo observado. Sin embargo, si se eligen valores fuera de los comunes el modelo no es confiable.
7. ESTIMACIÓN DE PRONÓSTICOS
Si la concentración promedio de Lantano (La) en una muestra es del 2ppm, ¿cuál sería la concentración promedio esperada de Cerio (Ce)?
# Definimos el valor de Cerio que queremos evaluar como ejemplo
al_ejemplo <- 2
# Cálculo del valor esperado de Cerio (Y_Esp = a + b * X)
Y_Esp <- a + b * al_ejemplo
# Graficar el resultado de forma limpia en el reporte
plot(1, type = "n", axes = FALSE, xlab = "", ylab = "")
text(x = 1, y = 1,
labels = paste("¿Cuál sería el promedio Cerio (Ce)\nsi el de Lantano (La) es ", al_ejemplo, "ppm?\n",
"Resultado esperado =", round(Y_Esp, 2), "ppm"),
cex = 1.5,
col = "darkblue",
font = 2)
8. CONCLUSIÓN
Entre el promedio de concentración de Lantano y del Cerio existe una relación de tipo lineal descrita por el modelo f(x) = 0.0023 + 1.9761x, siendo “x” el promedio de Lantano (La) y “y” el promedio de Cerio (Ce).
Ejemplo: Cuando el promedio de concentración de Lantano es del 2 ppm, se espera obtener un promedio de Cerio del 3.95 ppm.