CARGA DE DATOS Y LIBRERÍAS

CARGA DE DATOS

#cargar datos
datos <- read.csv("C:/Users/joeja/Desktop/Proyecto Estadística/datos_depurados1.csv",
                  header = TRUE, sep = ",", dec = ".")

CARGA DE LIBRERIAS

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

TABLA DE PARES DE VALORES

#Extraer Variables

zinc <- as.numeric(datos$zngrd)/10
oro <- as.numeric(datos$augrd)

#Definir Variables

y <- oro #Variable Dependiente
x <- zinc #Variable Independiente

#TABLA DE PARES DE VALORES
TPV<- data.frame(x,y)
TPV
##         x     y
## 1  0.2288 0.500
## 2  0.3140 0.608
## 3  0.3007 0.715
## 4  0.2492 0.823
## 5  0.2922 0.930
## 6  0.3803 1.038
## 7  0.1000 1.146
## 8  0.3259 1.253
## 9  0.2000 1.361
## 10 0.3271 1.468
## 11 0.3414 1.576
## 12 0.2000 1.684
## 13 0.4316 1.791
## 14 0.3636 1.899
## 15 0.3768 2.006
## 16 0.3833 2.114
## 17 0.4816 2.222
## 18 0.0000 3.000
## 19 0.0000 3.000
## 20 0.4345 2.544
## 21 0.4521 2.652
## 22 0.4836 2.759
## 23 0.4039 2.867
## 24 0.4829 2.975
## 25 0.4031 3.082
## 26 0.4299 3.190
## 27 0.0000 3.000
## 28 0.4129 3.405
## 29 0.4635 3.513
## 30 0.4439 3.620
## 31 0.4711 3.728
## 32 0.3882 3.835
## 33 0.4305 3.943
## 34 0.4747 4.051
## 35 0.5386 4.158
## 36 0.0000 2.000
## 37 0.5213 4.373
## 38 0.5534 4.481
## 39 0.0000 2.000
## 40 0.5567 4.696
## 41 0.5281 4.804
## 42 0.5059 4.911
## 43 0.5632 5.019
## 44 0.6082 5.127
## 45 0.6117 5.234
## 46 0.6118 5.342
## 47 0.7091 5.449
## 48 0.6536 5.557
## 49 0.6879 5.665
## 50 0.7473 5.772
## 51 0.6398 5.880
## 52 0.6656 5.987
## 53 0.7807 6.095
## 54 0.7104 6.203
## 55 0.7590 6.310
## 56 0.8158 6.418
## 57 0.8311 6.525
## 58 0.8838 6.633
## 59 0.8982 6.741
## 60 0.9079 6.848
## 61 0.8691 6.956
## 62 0.9507 7.063
## 63 0.9618 7.171
## 64 0.9335 7.278
## 65 1.0599 7.386
## 66 1.0701 7.494
## 67 1.0763 7.601
## 68 1.1007 7.709
## 69 1.1024 7.816
## 70 1.1881 7.924
## 71 1.2358 8.032
## 72 1.2300 8.139
## 73 1.3408 8.247
## 74 1.3043 8.354
## 75 1.3125 8.462
## 76 1.4688 8.570
## 77 1.4655 8.677
## 78 1.5241 8.785
## 79 1.5496 8.892
## 80 1.5748 9.000

DIAGRAMA DE DISPERSION

plot(x,y, 
     pch = 16, 
     col = "blue", main ="Gráfica Nº 1: Diagrama de dispersión del contenido de zinc 
     y la ley de oro",
     xlab =" Contenido de zinc (%) ",
     ylab = " Gramos de oro (g/t) ")

CONJETURA DEL MODELO

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

#Cálculo de parámetros
xcuad<-x^2
xcub<-x^3
xcta<-x^4

regresion_polinomica<- lm(y~x+xcuad+xcub+xcta)
regresion_polinomica 
## 
## Call:
## lm(formula = y ~ x + xcuad + xcub + xcta)
## 
## Coefficients:
## (Intercept)            x        xcuad         xcub         xcta  
##       2.457      -17.741       66.311      -61.241       17.835
summary(regresion_polinomica)
## 
## Call:
## lm(formula = y ~ x + xcuad + xcub + xcta)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1.2673 -0.4158 -0.0484  0.4221  1.4496 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   2.4570     0.2422  10.146 1.02e-15 ***
## x           -17.7408     2.1152  -8.387 2.19e-12 ***
## xcuad        66.3111     6.1565  10.771  < 2e-16 ***
## xcub        -61.2408     6.3370  -9.664 8.21e-15 ***
## xcta         17.8353     2.0864   8.548 1.08e-12 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.566 on 75 degrees of freedom
## Multiple R-squared:  0.9524, Adjusted R-squared:  0.9498 
## F-statistic: 374.9 on 4 and 75 DF,  p-value: < 2.2e-16
beta0<-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,y, 
     pch = 16,
     col = "blue",
     main ="Gráfica Nº 2: Comparación de la realidad con el 
     modelo polinomico del contenido de zinc 
     y la ley de oro",
     xlab =" Contenido de zinc (%) ",
     ylab = " ley de oro (g/t) "
     )

#Generar la curva
curve(a+b*x+c*x^2+d*x^3+e*x^4, from = min(x), to = max(x), add = TRUE, col="red",lwd = 2)

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, 4),
  " + ", round(b, 4), "X",
  " + ", round(c, 4), "X^2",
  " + ", round(d, 4), "X^3",
  " + ", round(e, 4), "X^4\n\n",
  "Donde: X = zinc (%)  |  Y = oro (g/t)"
)

text(1, 1, labels = eq, cex = 1.2, col = "blue", font = 2)

TEST DE APROBACIONES Y RESTRICCIONES

#TEST DE PEARSON
r<-cor(y,x+xcuad+xcub+xcta)
r*100
## [1] 79.63727

RESTRICCIONES

El modelo solo es confiable dentro del rango observado de zinc (%)

CÁLCULO DE PRONÓSTICOS

¿Cuál sería la ley de oro esperada si el contenido de zinc es del 1%?

#CÁLCULO
x0 <- 1

oro_esp <- a + b*x0 + c*x0^2 + d*x0^3 + e*x0^4
oro_esp
## (Intercept) 
##    7.621729
plot(1, type = "n", axes = FALSE, xlab = "", ylab = "")
text(1, 1,
     labels = paste0("¿Cuál sería la ley de oro esperada\n",
                     "si el contenido de zinc es del 1 %?\n\n",
                     "R = ", round(oro_esp, 4), " g/t"),
     cex = 1.6,
     col = "blue",
     font = 6)

CONCLUSIÓN

Entre el contenido de zinc (%) y la ley de oro (g/t) se observa una relación tipo polinómial de cuarto grado, representada por el modelo f(x) = 2.457 - 17.7408X + 66.3111X^2 - 61.2408X^3 + 17.8353X^4, donde “x” corresponde al contenido de zinc (%) y y “y” a los gramos de oro por tonelada (g/t). El modelo solo es confiable dentro del rango observado de zinc (%).

Ejemplo: Cuando el contenido de zinc es del 1 %, el modelo predice una ley de oro aproximada de 7.6217 g/t.