Análisis Multivariable Logarítmica 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_l.csv",
header = TRUE,
sep = ";",
dec = ",",
fileEncoding = "latin1")
# 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$Hf_ppm_MS_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, ]
# 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: 400# -------------------------------------------------------------------
# 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.4548 62.6617
## 2 0.4552 70.3363
## 3 0.4566 68.0608
## 4 0.4587 62.6688
## 5 0.4647 68.5739
## 6 0.4658 59.3010
## 7 0.4696 60.4681
## 8 0.4731 64.0702
## 9 0.4741 64.2892
## 10 0.4799 74.6079
## 11 0.4827 73.7827
## 12 0.4850 73.5856
## 13 0.4887 64.4891
## 14 0.4930 61.9955
## 15 0.4941 67.2603
## 16 0.4989 64.6630
## 17 0.5052 71.4924
## 18 0.5104 66.2180
## 19 0.5118 65.7008
## 20 0.5203 68.61993. DIAGRAMA DE DISPERSIÓN
plot(x_media, y_media,
pch = 16,
col = "darkblue",
cex = 0.7,
main = "Gráfica N°1: Diagrama de Dispersión\nHafnio (Hf) sobre Circonio (Zr)",
xlab = "Concentración de Hafnio (ppm)",
ylab = "Concentración de Circonio (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$Hf_ppm_MS_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(123)
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
# 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.4548 62.6617
## 2 0.4552 70.3363
## 3 0.4566 68.0608
## 4 0.4587 62.6688
## 5 0.4647 68.5739
## 6 0.4658 59.3010
## 7 0.4696 60.4681
## 8 0.4731 64.0702
## 9 0.4741 64.2892
## 10 0.4799 74.6079
## 11 0.4827 73.7827
## 12 0.4850 73.5856
## 13 0.4887 64.4891
## 14 0.4930 61.9955
## 15 0.4941 67.2603
## 16 0.4989 64.6630
## 17 0.5052 71.4924
## 18 0.5104 66.2180
## 19 0.5118 65.7008
## 20 0.5203 68.61994.1 DIAGRAMA DE DISPERSIÓN
plot(TPV$VAR_X, TPV$VAR_Y,
pch = 16,
col = "darkblue",
cex = 0.7,
main = "Gráfica N°2: Diagrama de Dispersión\nHafnio (Hf) sobre Circonio (Zr)",
xlab = "Concentración de Hafnio (ppm)",
ylab = "Concentración de Circonio (ppm)")
grid(nx = NULL, ny = NULL, col = "lightgray", lty = "dotted")
4.2 CONJETURA DEL MODELO
Debido a la similitud de la nube de puntos conjeturamos a un modelo logarítmico
# Modelo logarítmico: Y = a + b ln(X)
regresion_logaritmico <- lm(VAR_Y ~ log(VAR_X), data = TPV)
summary(regresion_logaritmico)##
## Call:
## lm(formula = VAR_Y ~ log(VAR_X), data = TPV)
##
## Residuals:
## Min 1Q Median 3Q Max
## -20.2335 -3.7609 -0.1579 3.6402 15.6218
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 90.5810 0.3160 286.68 <2e-16 ***
## log(VAR_X) 32.9221 0.5838 56.39 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 6.002 on 398 degrees of freedom
## Multiple R-squared: 0.8888, Adjusted R-squared: 0.8885
## F-statistic: 3180 on 1 and 398 DF, p-value: < 2.2e-16# Extraer coeficientes
a <- coef(regresion_logaritmico)[1]
b <- coef(regresion_logaritmico)[2]
# Gráfico con curva logarítmica
plot(TPV$VAR_X, TPV$VAR_Y,
pch = 16,
col = "blue",
cex = 0.7,
main = "Gráfica N°3: Modelo Logarítmico\nHafnio (Hf) sobre Circonio (Zr)",
xlab = "Concentración de Hafnio (ppm)",
ylab = "Concentración de Circonio (ppm)")
grid(nx = NULL, ny = NULL, col = "lightgray", lty = "dotted")
# Crear valores ordenados para que la curva salga suave
x_ordenado <- seq(min(TPV$VAR_X), max(TPV$VAR_X), length.out = 400)
y_ajustado <- a + b * log(x_ordenado)
lines(x_ordenado, y_ajustado,
col = "red",
lwd = 2)
4.3 ECUACIÓN DEL MODELO
plot(1, type = "n", axes = FALSE, xlab = "", ylab = "")
eq <- paste0(
"Ecuación logarítmica\n",
"Y = a + b log(x)\n",
"Y = ", round(a, 2), " + ", round(b, 2), " log(x)"
)
text(1, 1, labels = eq, cex = 1.7, col = "blue", font = 2)
5. TEST DE APROBACIÓN Y RESTRICCIONES
5.1 Test de pearson
r <- cor(log(TPV$VAR_X), TPV$VAR_Y)
r * 100## [1] 94.274035.2 COEFICIENTE DE DETERMINACIÓN
r2 <- r^2
r2 * 100## [1] 88.875935.3 RESTRICCIONES
min(TPV$VAR_X)## [1] 0.4548max(TPV$VAR_X)## [1] 3.1924Sí existe una restricción de aplicabilidad, ya que el modelo logarítmico es estadísticamente confiable únicamente dentro del rango de valores observados del contenido de Hafnio (ppm), el cual varía entre 0.4548 y 3.1924. Al intentar realizar predicciones fuera de este intervalo, 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ÓSTICO
¿Cuál sería la concentración esperada de Circonio si el contenido analizado de Hafnio es de 2 ppm?
# 1. Definimos el valor de entrada para el elemento independiente
x_input <- 2
# 2. Aplicamos la ecuación del modelo logarítmico: Y = a + b * ln(X)
y_esp <- a + (b * log(x_input))
# 3. Imprimimos el valor exacto en consola para verificación
cat("Concentración esperada calculada:", y_esp, "\n")## Concentración esperada calculada: 113.4009# 4. Generamos el gráfico de presentación
plot(1, type = "n", axes = FALSE, xlab = "", ylab = "")
resultado_texto <- paste0(
"¿Cuál sería la concentración esperada de Circonio (Zr)\n",
"si el contenido analizado de Hafnio (Hf) es de ", x_input, " ppm?\n\n",
"R = ", round(y_esp, 4), " ppm"
)
text(x = 1, y = 1,
labels = resultado_texto,
cex = 1.3,
col = "blue",
font = 2) 
7. CONCLUSIÓN
Entre el contenido de Hafnio (ppm) y la concentración de Circonio (ppm) se observa una relación de tipo logarítmica, representada por el modelo \(f(x) =90.58+32.92 \log(x)\), donde \(x\) corresponde al contenido de Hafnio y \(y\) a la concentración de Circonio.
Ejemplo de aplicación: Cuando el contenido de Hafnio es de 2 ppm, el modelo predice una concentración de Circonio aproximada de 113.4009 ppm.