ANÁLISIS ESTADÍSTICO

CARGA DE DATOS Y LIBRERÍAS

CARGA DE DATOS

#Carga de datos
datos <- read.csv("C:\\Users\\joeja\\Desktop\\Proyecto Estadística\\Depositos_sulfuro.csv", 
                  header = TRUE, 
                  sep = ",", 
                  dec = ".")

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 = 1, 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

El modelo potencial requiere que la variable independiente sea estrictamente positiva (x>0), debido a que la transformación logarítmica utilizada en la estimación de parámetros no está definida para valores nulos o negativos. Adicionalmente, la aplicación del modelo se limita al rango observado del tonelaje, ya que extrapolaciones fuera del dominio analizado pueden generar predicciones físicamente irreales.

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