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$Pr_ppm_MS_ST)
VAR_Y <- as.numeric(datos$Sm_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(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.05 0.1000000
## 2    0.06 0.1000000
## 3    0.07 0.6000000
## 4    0.08 1.3000000
## 5    0.09 0.2833333
## 6    0.10 0.1625000
## 7    0.11 0.2333333
## 8    0.12 0.2375000
## 9    0.13 0.3333333
## 10   0.14 0.2888889
## 11   0.15 0.2750000
## 12   0.16 0.6166667
## 13   0.17 0.1875000
## 14   0.18 0.4500000
## 15   0.19 0.1714286
## 16   0.20 0.2000000
## 17   0.21 0.4400000
## 18   0.22 0.2571429
## 19   0.23 0.3250000
## 20   0.24 0.2714286
## 21   0.25 0.2000000
## 22   0.26 0.4000000
## 23   0.27 0.5571429
## 24   0.28 0.3166667
## 25   0.29 0.3333333
## 26   0.30 0.3666667
## 27   0.31 0.3714286
## 28   0.32 0.5250000
## 29   0.33 0.4636364
## 30   0.34 0.2750000
## 31   0.35 0.3375000
## 32   0.36 0.2666667
## 33   0.37 0.3000000
## 34   0.38 0.6125000
## 35   0.39 0.4666667
## 36   0.40 0.5750000
## 37   0.41 0.6285714
## 38   0.42 0.4500000
## 39   0.43 0.7500000
## 40   0.44 0.9500000
## 41   0.45 1.3666667
## 42   0.46 0.5250000
## 43   0.47 0.5000000
## 44   0.48 0.7000000
## 45   0.49 0.4666667
## 46   0.50 0.2500000
## 47   0.51 0.7250000
## 48   0.52 0.6250000
## 49   0.53 0.5333333
## 50   0.54 0.7666667
## 51   0.55 0.5625000
## 52   0.56 0.4333333
## 53   0.57 0.6800000
## 54   0.58 0.7500000
## 55   0.59 0.8000000
## 56   0.60 0.9200000
## 57   0.61 0.5666667
## 58   0.62 0.7200000
## 59   0.63 0.5500000
## 60   0.64 0.4333333
## 61   0.66 0.7333333
## 62   0.67 0.7200000
## 63   0.68 0.8500000
## 64   0.69 1.2400000
## 65   0.71 1.0750000
## 66   0.72 0.7400000
## 67   0.73 0.6500000
## 68   0.76 0.6000000
## 69   0.77 1.2333333
## 70   0.78 0.8500000
## 71   0.79 1.0000000
## 72   0.80 1.0666667
## 73   0.81 0.6333333
## 74   0.82 1.1000000
## 75   0.83 0.9250000
## 76   0.84 0.9000000
## 77   0.85 0.7500000
## 78   0.87 0.9750000
## 79   0.88 0.4000000
## 80   0.89 0.8750000
## 81   0.90 0.6500000
## 82   0.92 0.7000000
## 83   0.93 0.4000000
## 84   0.94 0.8000000
## 85   0.95 0.7000000
## 86   0.96 0.5666667
## 87   0.97 0.3000000
## 88   0.98 1.8000000
## 89   0.99 1.1000000
## 90   1.00 0.7000000
## 91   1.01 0.8000000
## 92   1.02 1.0000000
## 93   1.03 0.7000000
## 94   1.04 1.5500000
## 95   1.05 0.8000000
## 96   1.07 1.1000000
## 97   1.08 1.4000000
## 98   1.09 0.8250000
## 99   1.10 1.1750000
## 100  1.11 0.9000000
## 101  1.12 0.9000000
## 102  1.13 1.3000000
## 103  1.14 1.4000000
## 104  1.15 0.8000000
## 105  1.16 1.0500000
## 106  1.18 1.2000000
## 107  1.20 1.1666667
## 108  1.21 1.6500000
## 109  1.22 0.7000000
## 110  1.23 1.6500000
## 111  1.24 1.0333333
## 112  1.25 0.7000000
## 113  1.26 2.0000000
## 114  1.27 1.8333333
## 115  1.28 1.5000000
## 116  1.29 1.2000000
## 117  1.31 2.0000000
## 118  1.32 1.2333333
## 119  1.33 2.1000000
## 120  1.34 1.3000000
## 121  1.36 0.9000000
## 122  1.37 1.0500000
## 123  1.38 1.5000000
## 124  1.39 1.8000000
## 125  1.40 1.0000000
## 126  1.41 1.6000000
## 127  1.42 1.3000000
## 128  1.43 1.1000000
## 129  1.45 1.6333333
## 130  1.46 1.7000000
## 131  1.47 0.8500000
## 132  1.48 1.3000000
## 133  1.51 1.3000000
## 134  1.54 1.2000000
## 135  1.55 1.6000000
## 136  1.57 1.0000000
## 137  1.59 1.0000000
## 138  1.60 1.3333333
## 139  1.62 1.8500000
## 140  1.63 1.2000000
## 141  1.64 1.6000000
## 142  1.65 0.7000000
## 143  1.66 1.6000000
## 144  1.68 1.7000000
## 145  1.69 1.1000000
## 146  1.71 1.1500000
## 147  1.72 2.0000000
## 148  1.73 1.0000000
## 149  1.74 2.5500000
## 150  1.76 1.9250000
## 151  1.77 2.1000000
## 152  1.78 1.7000000
## 153  1.81 1.7000000
## 154  1.82 1.6000000
## 155  1.83 1.2500000
## 156  1.84 1.5000000
## 157  1.85 0.9000000
## 158  1.86 1.1000000
## 159  1.87 1.7000000
## 160  1.88 0.5500000
## 161  1.89 1.1000000
## 162  1.90 1.8250000
## 163  1.92 2.2500000
## 164  1.93 1.6000000
## 165  1.95 2.1500000
## 166  1.96 1.6000000
## 167  1.97 1.4500000
## 168  1.98 1.3000000
## 169  1.99 2.1500000
## 170  2.00 1.2000000
## 171  2.01 1.8500000
## 172  2.02 1.8000000
## 173  2.03 2.0333333
## 174  2.05 1.6500000
## 175  2.06 1.8000000
## 176  2.07 2.0500000
## 177  2.08 1.8000000
## 178  2.09 1.9000000
## 179  2.12 2.4500000
## 180  2.14 1.7000000
## 181  2.15 2.0000000
## 182  2.16 1.4500000
## 183  2.17 1.5666667
## 184  2.21 1.4500000
## 185  2.24 2.5000000
## 186  2.25 2.8000000
## 187  2.27 2.3000000
## 188  2.28 1.7333333
## 189  2.30 1.6000000
## 190  2.31 2.4000000
## 191  2.32 1.6666667
## 192  2.34 2.6000000
## 193  2.35 2.7000000
## 194  2.38 2.0666667
## 195  2.39 2.1000000
## 196  2.43 1.5000000
## 197  2.44 2.2250000
## 198  2.45 2.1000000
## 199  2.47 1.7000000
## 200  2.48 3.0000000
## 201  2.49 2.7000000
## 202  2.50 1.2000000
## 203  2.51 2.2500000
## 204  2.52 1.5000000
## 205  2.53 1.6000000
## 206  2.54 1.4500000
## 207  2.55 2.6000000
## 208  2.57 2.2000000
## 209  2.58 1.4000000
## 210  2.60 1.6000000
## 211  2.61 1.7000000
## 212  2.63 1.7000000
## 213  2.66 1.9000000
## 214  2.67 2.1500000
## 215  2.69 1.6000000
## 216  2.72 2.0333333
## 217  2.73 2.3000000
## 218  2.74 2.2000000
## 219  2.76 2.0000000
## 220  2.82 2.0000000
## 221  2.85 2.5000000
## 222  2.86 2.4000000
## 223  2.88 2.5666667
## 224  2.89 2.4000000
## 225  2.90 2.1500000
## 226  2.91 2.1000000
## 227  2.92 2.2000000
## 228  2.93 2.1000000
## 229  2.95 2.2000000
## 230  2.96 2.3000000
## 231  2.99 1.5000000
## 232  3.00 2.1000000
## 233  3.04 3.3000000
## 234  3.10 2.5000000
## 235  3.17 2.1000000
## 236  3.19 2.0000000
## 237  3.20 2.3000000
## 238  3.21 2.6000000
## 239  3.22 2.5000000
## 240  3.24 2.1000000
## 241  3.25 3.4000000
## 242  3.26 3.1000000
## 243  3.27 2.3500000
## 244  3.29 1.8000000
## 245  3.30 2.5000000
## 246  3.38 1.9000000
## 247  3.41 2.6666667
## 248  3.45 2.4000000
## 249  3.46 3.2000000
## 250  3.47 2.2000000
## 251  3.48 3.9000000
## 252  3.49 1.6000000
## 253  3.50 2.6000000
## 254  3.52 3.2000000
## 255  3.53 2.5000000
## 256  3.54 3.3000000
## 257  3.57 2.5000000
## 258  3.58 1.8000000
## 259  3.59 3.6000000
## 260  3.60 3.0000000
## 261  3.61 2.9000000
## 262  3.66 2.8000000
## 263  3.68 2.2000000
## 264  3.69 2.4000000
## 265  3.70 2.7666667
## 266  3.72 3.9000000
## 267  3.73 2.8000000
## 268  3.79 3.6000000
## 269  3.81 2.8000000
## 270  3.82 2.0000000
## 271  3.83 3.8000000
## 272  3.85 2.6000000
## 273  3.89 2.7500000
## 274  3.90 3.9000000
## 275  3.91 2.4500000
## 276  3.92 2.6000000
## 277  3.93 2.5000000
## 278  3.95 2.0000000
## 279  3.99 4.1000000
## 280  4.00 2.3000000
## 281  4.05 2.4000000
## 282  4.07 3.4500000
## 283  4.08 3.5000000
## 284  4.09 3.1000000
## 285  4.11 2.5000000
## 286  4.12 3.3000000
## 287  4.16 3.0000000
## 288  4.18 2.4000000
## 289  4.19 2.2000000
## 290  4.20 2.6000000
## 291  4.21 2.2000000
## 292  4.24 2.8000000
## 293  4.28 4.3000000
## 294  4.33 3.6500000
## 295  4.36 3.6000000
## 296  4.39 3.4000000
## 297  4.44 3.2000000
## 298  4.50 3.1000000
## 299  4.51 4.0000000
## 300  4.54 3.1000000
## 301  4.57 3.4000000
## 302  4.58 3.1000000
## 303  4.62 2.8000000
## 304  4.63 2.9000000
## 305  4.64 3.3000000
## 306  4.65 2.5000000
## 307  4.67 3.5000000
## 308  4.71 2.9000000
## 309  4.73 3.1500000
## 310  4.80 3.5000000
## 311  4.83 3.6000000
## 312  4.88 3.0000000
## 313  4.90 3.2500000
## 314  4.94 3.0000000
## 315  5.02 3.9000000
## 316  5.06 4.6000000
## 317  5.17 4.4000000
## 318  5.19 3.5000000
## 319  5.20 3.4000000
## 320  5.25 3.2000000
## 321  5.27 3.8000000
## 322  5.30 3.5000000
## 323  5.32 4.0000000
## 324  5.38 3.2000000
## 325  5.46 4.5000000
## 326  5.47 3.9000000
## 327  5.48 3.5000000
## 328  5.56 3.4000000
## 329  5.64 3.7000000
## 330  5.65 3.8000000
## 331  5.66 4.4000000
## 332  5.67 3.9000000
## 333  5.69 3.8000000
## 334  5.75 4.3000000
## 335  5.79 4.1000000
## 336  5.83 3.6000000
## 337  5.84 4.2000000
## 338  5.85 3.8000000
## 339  5.86 4.5000000
## 340  5.89 4.3000000
## 341  5.92 4.6000000
## 342  5.94 4.0000000
## 343  6.00 4.4000000
## 344  6.05 3.9000000
## 345  6.17 4.7000000

3. DIAGRAMA DE DISPERSIÓN

plot(x_media, y_media,
     pch = 16,           
     col = "darkblue",   
     main = "Gráfica N°1: Diagrama de Dispersión Promediada\nPraseodimio (Pr) sobre Samario (Sm)",
     xlab = "Concentración de Praseodimio (ppm)",
     ylab = "Concentración de Samario (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 potencial

# 1. Aplicamos logaritmo a ambas variables para linealizar
x_log <- log(x_media)
y_log <- log(y_media)

# 2. Regresión lineal en el espacio logarítmico
regresion_potencial <- lm(y_log ~ x_log)

# 3. Extracción de coeficientes
beta0 <- regresion_potencial$coefficients[1]
b     <- regresion_potencial$coefficients[2]
a     <- exp(beta0) # Convertimos el intercepto a su escala original

plot(x_media, y_media,
     pch = 16,
     col = "blue",
     main = "Gráfica N°2: Modelo Potencial\nRelación entre Praseodimio y Samario",
     xlab = "Concentración de Praseodimio (ppm)",
     ylab = "Concentración de Samario (ppm)")

grid(nx = NULL, ny = NULL, col = "lightgray", lty = "dotted")

# Generar la curva: Y = a * X^b
curve(a * x^b, 
      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 = "")

# Construcción dinámica de la ecuación
eq_text <- paste0(
  "Ecuación Potencial\n",
  "Y = a * X^b\n\n",
  "Y = ", round(a, 4), " * X ^ ", round(b, 4), "\n\n"
)

text(x = 1, y = 1,
     labels = eq_text,
     cex = 1.5,      # Ajustado a 1.5 para evitar que se corte en los bordes
     col = "blue", 
     font = 2)       # Fuente 2 es negrita, usualmente más legible que la 6

5. TEST DE APROBACIÓN Y RESTRICCIONES

5.1 Test de Pearson

r <- cor(x_log, y_log)
r * 100
## [1] 92.20947

5.2 COEFICIENTE DE DETERMINACIÓN

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

5.3RESTRICCIONES

min(x_media)
## [1] 0.05
max(x_media)
## [1] 6.17

Sí existe una restricción de aplicabilidad, ya que el modelo potencial es estadísticamente confiable únicamente dentro del rango de valores observados del contenido de Praseodimio (ppm), el cual varía entre 0.05 y 6.17. 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ÓSTICOS

¿Cuál es la concentración de Samario (Sm) esperada en una muestra de roca si, mediante análisis geoquímico, se ha determinado un contenido de Praseodimio (Pr) de 5 ppm?

# 1. Definimos el valor de entrada
x_input <- 5 

# 2. Calculamos con los coeficientes del modelo potencial (Y = a * X^b)
y_esp <- a * (x_input^b)

# 3. Gráfica de resultado
plot(1, type = "n", axes = FALSE, xlab = "", ylab = "")

# 4. Texto dinámico con la pregunta y el resultado
resultado_texto <- paste0(
  "¿Cuál sería la concentración de Samario (Sm) esperada\n",
  "si se tiene un contenido de Praseodimio (Pr) de ", x_input, " ppm?\n\n",
  "R = ", round(y_esp, 2), " ppm"
)

text(x = 1, y = 1,
     labels = resultado_texto,
     cex = 1.3,      # Ajustado para que no se corte
     col = "blue", 
     font = 2)       # Fuente negrita estándar

7. CONCLUSIÓN

Entre el contenido de Praseodimio (Pr, ppm) y la concentración de Samario (Sm, ppm) se observa una relación de tipo potencial, representada por el modelo \(f(x) = 1.017 \cdot X^{0.728}\), donde \(x\) corresponde al contenido de Praseodimio (ppm) y \(y\) a la concentración de Samario (ppm). El modelo presenta una alta confiabilidad dentro del rango geoquímico observado, el cual varía entre 0.05 ppm y 6.17 ppm de Praseodimio. Se determina que la variabilidad en la concentración de Samario está explicada significativamente por el modelo potencial, mientras que el porcentaje residual de la variabilidad se atribuye a factores geológicos o procesos de fraccionamiento magmático no contemplados en este análisis.

Ejemplo de aplicación: Cuando el contenido de Praseodimio es de 5 ppm, el modelo predice una concentración de Samario aproximada de 3.28 ppm.