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, union
library(knitr)
library(gt)
library(MASS) # Necesaria para Estimación robusta
## 
## Adjuntando el paquete: 'MASS'
## The following object is masked from 'package:dplyr':
## 
##     select

2. 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, ]

# -------------------------------------------------------------------
# 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  

tabla_media
##     VAR_X      VAR_Y
## 1     0.1  0.3000000
## 2     0.2  0.4676471
## 3     0.3  0.5481481
## 4     0.4  0.8750000
## 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  3.7428571
## 19    1.9  4.1846154
## 20    2.0  4.3769231
## 21    2.1  3.2200000
## 22    2.2  3.5500000
## 23    2.3  3.9800000
## 24    2.4  5.2000000
## 25    2.5  4.9000000
## 26    2.6  5.3555556
## 27    2.7  4.7285714
## 28    2.8  6.2875000
## 29    2.9  6.1000000
## 30    3.0  5.4666667
## 31    3.1  5.4875000
## 32    3.2  5.1833333
## 33    3.3  6.5666667
## 34    3.4  6.6888889
## 35    3.5  5.6000000
## 36    3.6  7.1333333
## 37    3.7  7.3600000
## 38    3.8  6.1600000
## 39    3.9  7.1444444
## 40    4.0  6.5625000
## 41    4.1  9.0285714
## 42    4.2  8.1250000
## 43    4.3  6.2500000
## 44    4.4  8.9500000
## 45    4.5  8.9333333
## 46    4.6  9.8333333
## 47    4.7 12.5666667
## 48    4.8  9.3000000
## 49    4.9 11.4400000
## 50    5.0  7.8250000
## 51    5.1 12.4750000
## 52    5.2 11.3500000
## 53    5.3 11.5000000
## 54    5.4 11.9000000
## 55    5.5 10.6000000
## 56    5.6 11.9750000
## 57    5.7  8.6500000
## 58    5.8 10.7500000
## 59    5.9  8.8666667
## 60    6.0 11.0000000
## 61    6.1 11.9555556
## 62    6.2 11.2500000
## 63    6.3 14.0666667
## 64    6.5 13.5000000
## 65    6.6 14.4500000
## 66    6.7 13.5500000
## 67    6.8 13.0000000
## 68    6.9 15.3375000
## 69    7.0 15.8000000
## 70    7.1 17.1000000
## 71    7.2 16.0250000
## 72    7.3 14.5500000
## 73    7.6 15.3500000
## 74    7.7 15.5500000
## 75    7.8 15.5333333
## 76    7.9 15.1500000
## 77    8.1 16.5250000
## 78    8.2 15.7666667
## 79    8.3 16.0500000
## 80    8.4 16.0500000
## 81    8.5 18.3000000
## 82    8.6 15.1750000
## 83    8.7 16.6000000
## 84    8.9 17.3250000
## 85    9.0 17.3000000
## 86    9.1 19.7750000
## 87    9.2 14.9000000
## 88    9.3 19.4333333
## 89    9.4 16.9000000
## 90    9.5 19.9000000
## 91    9.6 17.9250000
## 92    9.8 19.7000000
## 93   10.0 21.6000000
## 94   10.1 19.8000000
## 95   10.2 19.9500000
## 96   10.3 21.1000000
## 97   10.4 20.6500000
## 98   10.6 15.7000000
## 99   10.7 21.3500000
## 100  10.8 21.0500000
## 101  10.9 21.5000000
## 102  11.0 20.2000000
## 103  11.1 24.2500000
## 104  11.2 22.6000000
## 105  11.3 20.8666667
## 106  11.4 26.8000000
## 107  11.5 23.0666667
## 108  11.6 24.5666667
## 109  11.7 22.8000000
## 110  11.8 23.5000000
## 111  11.9 19.6500000
## 112  12.0 19.2000000
## 113  12.1 26.6500000
## 114  12.2 22.4000000
## 115  12.6 26.0000000
## 116  12.7 23.7666667
## 117  12.8 26.3000000
## 118  12.9 22.6000000
## 119  13.0 26.0000000
## 120  13.1 28.6000000
## 121  13.3 28.3000000
## 122  13.5 27.8000000
## 123  13.6 26.3666667
## 124  13.7 27.9000000
## 125  13.8 27.0000000
## 126  13.9 27.5000000
## 127  14.1 27.9000000
## 128  14.3 31.5000000
## 129  14.4 28.0000000
## 130  14.5 29.8000000
## 131  14.6 30.6500000
## 132  14.9 30.0500000
## 133  15.1 29.7750000
## 134  15.2 27.1000000
## 135  15.4 28.5000000
## 136  15.5 32.1000000
## 137  15.8 32.3000000
## 138  15.9 31.7666667
## 139  16.0 28.9000000
## 140  16.2 30.5000000
## 141  16.3 32.2500000
## 142  16.4 31.3000000
## 143  16.5 33.2000000
## 144  16.6 33.7000000
## 145  16.7 32.7500000
## 146  16.8 33.9000000
## 147  17.2 33.3000000
## 148  17.3 36.1000000
## 149  17.6 31.6000000
## 150  17.8 35.9000000
## 151  18.3 36.9000000
## 152  18.4 34.0000000
## 153  18.7 35.8000000
## 154  18.8 37.4000000
## 155  19.0 38.0000000
## 156  19.1 37.9500000
## 157  19.2 39.6000000
## 158  19.3 38.2000000
## 159  19.4 38.1000000

3. DIAGRAMA DE DISPERSIÓN

plot(x_media, y_media,
     pch = 16,           
     col = "darkblue",   
     main = "Gráfica N°1: 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. CONJETURA DEL MODELO

Debido a la similitud de la nube de puntos conjeturamos a un modelo lineal

# 1. DIAGRAMA DE DISPERSIÓN BASE
plot(x_media, y_media,
     pch = 16,
     col = "darkblue",
     main = "Gráfica N°2: 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 
## -5.2489 -0.5310  0.0432  0.7381  4.2702 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 0.002314   0.214180   0.011    0.991    
## x_media     1.976095   0.020752  95.224   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.429 on 157 degrees of freedom
## Multiple R-squared:  0.983,  Adjusted R-squared:  0.9829 
## F-statistic:  9068 on 1 and 157 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.1 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 Y RESTRICCIONES

5.1 TEST DE PEARSON

r <- cor(x_media, y_media)
r * 100
## [1] 99.14536

5.2 COEFICIENTE DE DETERMINACIÓN

r2 <- r^2
r2 * 100
## [1] 98.29802

5.3 RESTRICCIONES

min(x_media)
## [1] 0.1
max(x_media)
## [1] 19.4

“Sí existe restricción, ya que el modelo lineal es confiable únicamente dentro del rango de valores observados del promedio, el cual varía entre 0.1 y 19.4. Al utilizar valores fuera de este intervalo, la predicción del Cerio puede no representar adecuadamente el comportamiento real de las muestras de minas archivadas.”

6. 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)

7. 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 ppm) y “y” el promedio de Cerio (Ce ppm). Sí existe restricción en este escenario, ya que el modelo solo es estadísticamente confiable dentro del rango de valores observados del promedio del Lantano, el cual varía entre 0.1 y 19.4. Además, la variabilidad de la concentración de Potasio está influenciada en un 98.29% por el promedio del Lantano, mientras que el porcentaje restante se debe a otros factores no contemplados en este análisis.

Ejemplo: Cuando el promedio de concentración de Lantano es del 2 ppm, se espera obtener un promedio de Cerio del 3.95 ppm.