ANÁLISIS ESTADÍSTICO

CARGA DE DATOS Y LIBRERÍAS

CARGA DE DATOS

#Carga de datos
setwd("~/UNI/ESTADISTICA")
datos  <- read.csv("Depositos_Sulfuro.csv", sep = ";", dec = ".", header = TRUE)

CARGA DE LIBRERIAS

#Carga de librerias
library(dplyr)
library(knitr)
library(gt)

TABLA PARES DE VALORES

# Extraer y definir variables

area  <- as.numeric(datos$ore_area) #Variable independiente
toneladas <-as.numeric(datos$oreton) #variable dependiente

#TABLA DE PARES DE VALORES
TPV <- data.frame( area,toneladas)

#LIMPIAR LOS VALORES NA,0 Y VALORES NEGATIVOS
TPV <- na.omit(TPV)
TPV <- TPV[TPV$area > 0 & TPV$toneladas > 0, ]


#ELIMINAR OUTLIERS

# OUTLIERS ÁREA

Q1_area  <- quantile(TPV$area, 0.25)
Q3_area  <- quantile(TPV$area, 0.75)
IQR_area <- Q3_area- Q1_area

lim_inf_area <- Q1_area - 1.5 * IQR_area
lim_sup_area <- Q3_area + 1.5 * IQR_area


# OUTLIERS TONELADAS

Q1_ton  <- quantile(TPV$toneladas, 0.25)
Q3_ton  <- quantile(TPV$toneladas, 0.75)
IQR_ton <- Q3_ton - Q1_ton

lim_inf_ton <- Q1_ton - 1.5 * IQR_ton
lim_sup_ton <- Q3_ton + 1.5 * IQR_ton


#TABLA SIN OUTLIERS

TPV_limpio <- TPV[
  TPV$area  >= lim_inf_area  & TPV$area <= lim_sup_area &
    TPV$toneladas >= lim_inf_ton & TPV$toneladas <= lim_sup_ton,
]


# Corresponder para una x una sola y

tabla_sup_1 <- aggregate(toneladas~ area,
                       data = TPV_limpio,
                       FUN = max)

tabla_media_1 <- aggregate(toneladas ~ area,
                         data = TPV_limpio,
                         FUN = mean)

tabla_inf_1 <- aggregate(toneladas ~ area,
                       data = TPV_limpio,
                       FUN = min)



#TABLA DE PARES DE VALORES PARA UN TRAMO

TPV_FILTRADO <- TPV_limpio[TPV_limpio$area < 20 & TPV_limpio$toneladas < 80, ]


#Corresponder para una x una sola y

tabla_sup <- aggregate(toneladas ~ area, data = TPV_FILTRADO, FUN = max)
tabla_media <- aggregate(toneladas ~ area, data = TPV_FILTRADO, FUN = mean)
tabla_inf <- aggregate(toneladas ~ area, data = TPV_FILTRADO, FUN = min)


#TABLA DE PARES DE VALORES PARA EL TRAMO DE ÁREAS MENORES A 20 CORRESPONDIENDO UNA UNICA Y A CADA X

tabla_inf
##    area toneladas
## 1     1         1
## 2     2         1
## 3     3         2
## 4     4         3
## 5     5         4
## 6     7        23
## 7     8         7
## 8     9        24
## 9    10        15
## 10   11        15
## 11   13        30
## 12   14        10
## 13   15        11
## 14   17        45

DIAGRAMA DE DISPERSIÓN

#Obtener las variables de la tabla

x<-tabla_inf$area #Variable independiente
y<-tabla_inf$toneladas #Variable Dependiente

#Diagrama de dispersion para un tramo
plot(x,y,
     pch = 16,
     col = "blue",
     main = "Grafica N°1 :Diagrama de disperción entre el área y el tonelaje
     de los depositos de sulfuros masivos volcanicos",
     xlab = "Área del deposito (km²)",
     ylab = "Toneladas (Mt)")

CONJETURA DEL MODELO

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

Diagrama de dispersión 

#Diagrama de dispersión

plot(x,
     y,
     pch = 16,
     col = "blue",
     main = "Grafica N°2 : Comparación de la realidad con el modelo potencial
     entre el área y el tonelaje de los depositos masivos de sulfuros 
     volcánicos",
     xlab = "Área del deposito (km²)",
     ylab = "Toneladas (Mt)")


# Parámetros potenciales

x1<- log(x)
y1<- log(y)
regresion_Potencial<- lm(y1~x1)
regresion_Potencial  
## 
## Call:
## lm(formula = y1 ~ x1)
## 
## Coefficients:
## (Intercept)           x1  
##     -0.4588       1.3300
summary(regresion_Potencial)
## 
## Call:
## lm(formula = y1 ~ x1)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -0.7485 -0.3479 -0.1543  0.4563  1.0063 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  -0.4588     0.3892  -1.179    0.261    
## x1            1.3300     0.1894   7.021 1.39e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.5714 on 12 degrees of freedom
## Multiple R-squared:  0.8042, Adjusted R-squared:  0.7879 
## F-statistic: 49.29 on 1 and 12 DF,  p-value: 1.393e-05
beta0<-regresion_Potencial$coefficients[1]
beta1<-regresion_Potencial$coefficients[2]

b<-beta1
b
##       x1 
## 1.329973
a<-exp(beta0)
a
## (Intercept) 
##   0.6320249
#Generar la curva
curve(a*x^b, from = 0, to = 20, add = TRUE)

#Formamos la ecuación
plot(1, type = "n", axes = FALSE, xlab = "", ylab = "") # Crear un gráfico vacío
text(x = 1, y = 1,
     labels = " Ecuación Potencial \n Y = ax^b \n Y = 0.632x^1.33",
     cex = 2, # Tamaño del texto (ajustable)
     col = "blue", # Color del texto
     font =6) #tipo

TEST DE APROBACIÓN Y RESTRICCIONES

TEST DE PEARSON

#TEST DE PEARSON
r<-cor(x1,y1)
r*100
## [1] 89.67856

APRUEBA EL TEST PEARSON

RESTRICCIONES

Sí existen restricciones, ya que el modelo solo es valido dentro del rango (1≤x≤20)

CÁLCULO DE PRONOSTICOS

¿Cuantas toneladas se esperaria si el área del deposito de 12 km ²? 

#Cálculo de Pronosticos
T_Esp <- 0.632*12^1.33 
T_Esp
## [1] 17.2198
plot(1, type = "n", axes = FALSE, xlab = "", ylab = "") # Crear un gráfico vacío
text(x = 1, y = 1,
     labels = "¿Cual seria las toneladas si se tiene 
     un área del deposito de 12 km²?
     \n R= 17.22 Mt ",
     cex = 2, # Tamaño del texto (ajustable)
     col = "blue", # Color del texto
     font = 6)

CONCLUSIÓN

Entre el área y el tonelaje existe una relación potencial donde el modelo f(x)=0.632x^1.33 siendo “x” área del deposito y “y” el tonelaje.

Sí existen restricciones, ya que el modelo solo es valido dentro del rango (1≤x≤20).

Ejemplo: Cuando el area es 12 km² se espera un tonelaje de 17.22 Mt