Análisis Multivariable de Depósitos Masivos de Sulfuro Volcánicos
Grupo 2
2026-02-05
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, ]
TPV## area toneladas
## 3 35 592
## 5 8 142
## 15 3 633
## 17 72 8314
## 18 518 241
## 21 1 2
## 38 1 33
## 60 1 36
## 62 699 6
## 64 299 1
## 65 1 2
## 66 5 18
## 67 15 11
## 68 5 7
## 69 2 83
## 70 11 68
## 72 199 9
## 74 4 513
## 76 3 143
## 82 2 62
## 83 11 15
## 84 2 91
## 89 697 17
## 93 8 38
## 95 8 7
## 99 3 975
## 100 2 91
## 108 7 68
## 118 1 52
## 120 4 8
## 122 1 5044
## 138 4 3
## 150 19 647
## 151 3 2
## 152 19 1424
## 158 38 158
## 170 25 18
## 173 499 226
## 174 1 227
## 178 43 4042
## 189 95 1218
## 193 42 51
## 194 2 454
## 195 24 788
## 199 499 3343
## 202 17 45
## 207 4 125
## 216 32 6
## 223 3 3
## 224 2 13
## 232 33 1986
## 234 1 201
## 235 4 7
## 236 5 4
## 237 8 21
## 240 4 45
## 252 346 4
## 253 359 12
## 261 16 295
## 262 377 25
## 266 54 50
## 267 299 268
## 270 499 37
## 275 11 31
## 277 8 717
## 280 4 1167
## 284 5 18
## 297 2 4
## 302 13 80
## 307 1 21
## 308 35 11
## 309 1 264
## 310 2 181
## 312 35 15
## 321 7 23
## 329 5 366
## 340 249 88
## 362 2 154
## 365 179 194
## 366 7 75
## 370 1 1
## 382 249 32
## 383 39 828
## 385 15 21
## 386 2 20
## 395 12 188
## 401 2 26
## 403 14 10
## 409 1 14
## 410 699 1931
## 413 3 124
## 426 2 173
## 430 2 388
## 434 1 251
## 440 499 27
## 442 499 871
## 444 499 32
## 445 499 265
## 449 2 1
## 451 3 19
## 454 3 4
## 461 13 30
## 469 75 379
## 480 24 799
## 481 9 24
## 483 3 475
## 618 10 15
## 687 15 74
## 891 3 23
## 895 59 66
## 901 2 30
## 903 43 1036
## 917 74 84
## 920 57 226
## 944 6 96
## 968 8 1026
## 991 106 42
## 997 1 5
## 1039 47 42#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,
]
TPV_limpio## area toneladas
## 3 35 592
## 5 8 142
## 21 1 2
## 38 1 33
## 60 1 36
## 65 1 2
## 66 5 18
## 67 15 11
## 68 5 7
## 69 2 83
## 70 11 68
## 74 4 513
## 76 3 143
## 82 2 62
## 83 11 15
## 84 2 91
## 93 8 38
## 95 8 7
## 100 2 91
## 108 7 68
## 118 1 52
## 120 4 8
## 138 4 3
## 151 3 2
## 158 38 158
## 170 25 18
## 174 1 227
## 193 42 51
## 194 2 454
## 202 17 45
## 207 4 125
## 216 32 6
## 223 3 3
## 224 2 13
## 234 1 201
## 235 4 7
## 236 5 4
## 237 8 21
## 240 4 45
## 261 16 295
## 266 54 50
## 275 11 31
## 284 5 18
## 297 2 4
## 302 13 80
## 307 1 21
## 308 35 11
## 309 1 264
## 310 2 181
## 312 35 15
## 321 7 23
## 329 5 366
## 362 2 154
## 366 7 75
## 370 1 1
## 385 15 21
## 386 2 20
## 395 12 188
## 401 2 26
## 403 14 10
## 409 1 14
## 413 3 124
## 426 2 173
## 430 2 388
## 434 1 251
## 449 2 1
## 451 3 19
## 454 3 4
## 461 13 30
## 469 75 379
## 481 9 24
## 483 3 475
## 618 10 15
## 687 15 74
## 891 3 23
## 895 59 66
## 901 2 30
## 917 74 84
## 920 57 226
## 944 6 96
## 997 1 5
## 1039 47 42# Corresponder para una x una sola y
tabla_sup_1 <- aggregate(toneladas~ area,
data = TPV_limpio,
FUN = max)
tabla_sup_1## area toneladas
## 1 1 264
## 2 2 454
## 3 3 475
## 4 4 513
## 5 5 366
## 6 6 96
## 7 7 75
## 8 8 142
## 9 9 24
## 10 10 15
## 11 11 68
## 12 12 188
## 13 13 80
## 14 14 10
## 15 15 74
## 16 16 295
## 17 17 45
## 18 25 18
## 19 32 6
## 20 35 592
## 21 38 158
## 22 42 51
## 23 47 42
## 24 54 50
## 25 57 226
## 26 59 66
## 27 74 84
## 28 75 379tabla_media_1 <- aggregate(toneladas ~ area,
data = TPV_limpio,
FUN = mean)
tabla_media_1## area toneladas
## 1 1 85.30769
## 2 2 118.06667
## 3 3 99.12500
## 4 4 116.83333
## 5 5 82.60000
## 6 6 96.00000
## 7 7 55.33333
## 8 8 52.00000
## 9 9 24.00000
## 10 10 15.00000
## 11 11 38.00000
## 12 12 188.00000
## 13 13 55.00000
## 14 14 10.00000
## 15 15 35.33333
## 16 16 295.00000
## 17 17 45.00000
## 18 25 18.00000
## 19 32 6.00000
## 20 35 206.00000
## 21 38 158.00000
## 22 42 51.00000
## 23 47 42.00000
## 24 54 50.00000
## 25 57 226.00000
## 26 59 66.00000
## 27 74 84.00000
## 28 75 379.00000tabla_inf_1 <- aggregate(toneladas ~ area,
data = TPV_limpio,
FUN = min)
tabla_inf_1## area toneladas
## 1 1 1
## 2 2 1
## 3 3 2
## 4 4 3
## 5 5 4
## 6 6 96
## 7 7 23
## 8 8 7
## 9 9 24
## 10 10 15
## 11 11 15
## 12 12 188
## 13 13 30
## 14 14 10
## 15 15 11
## 16 16 295
## 17 17 45
## 18 25 18
## 19 32 6
## 20 35 11
## 21 38 158
## 22 42 51
## 23 47 42
## 24 54 50
## 25 57 226
## 26 59 66
## 27 74 84
## 28 75 379#TABLA DE PARES DE VALORES PARA UN TRAMO
TPV_FILTRADO <- TPV_limpio[TPV_limpio$area < 20 & TPV_limpio$toneladas < 80, ]
TPV_FILTRADO## area toneladas
## 21 1 2
## 38 1 33
## 60 1 36
## 65 1 2
## 66 5 18
## 67 15 11
## 68 5 7
## 70 11 68
## 82 2 62
## 83 11 15
## 93 8 38
## 95 8 7
## 108 7 68
## 118 1 52
## 120 4 8
## 138 4 3
## 151 3 2
## 202 17 45
## 223 3 3
## 224 2 13
## 235 4 7
## 236 5 4
## 237 8 21
## 240 4 45
## 275 11 31
## 284 5 18
## 297 2 4
## 307 1 21
## 321 7 23
## 366 7 75
## 370 1 1
## 385 15 21
## 386 2 20
## 401 2 26
## 403 14 10
## 409 1 14
## 449 2 1
## 451 3 19
## 454 3 4
## 461 13 30
## 481 9 24
## 618 10 15
## 687 15 74
## 891 3 23
## 901 2 30
## 997 1 5#Corresponder para una x una sola y
tabla_sup <- aggregate(toneladas ~ area, data = TPV_FILTRADO, FUN = max)
tabla_sup## area toneladas
## 1 1 52
## 2 2 62
## 3 3 23
## 4 4 45
## 5 5 18
## 6 7 75
## 7 8 38
## 8 9 24
## 9 10 15
## 10 11 68
## 11 13 30
## 12 14 10
## 13 15 74
## 14 17 45tabla_media <- aggregate(toneladas ~ area, data = TPV_FILTRADO, FUN = mean)
tabla_media## area toneladas
## 1 1 18.44444
## 2 2 22.28571
## 3 3 10.20000
## 4 4 15.75000
## 5 5 11.75000
## 6 7 55.33333
## 7 8 22.00000
## 8 9 24.00000
## 9 10 15.00000
## 10 11 38.00000
## 11 13 30.00000
## 12 14 10.00000
## 13 15 35.33333
## 14 17 45.00000tabla_inf <- aggregate(toneladas ~ area, data = TPV_FILTRADO, FUN = min)
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#TABLA DE PARES DE VALORES
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 45DIAGRAMA DE DISPERSIÓN
#Diagrama de dispersíon con outliers
plot(TPV$area,TPV$toneladas,
pch = 16,
col = "blue",
main = "Grafica N°1 : Diagrama de dispersión entre el área y el tonelaje
de los depositos de sulfuros masivos volcanicos",
xlab = "Área del deposito (km²)",
ylab = "Toneladas (Mt)")
#Diagrama de dispersíon sin outliers
plot(TPV_limpio$area,TPV_limpio$toneladas,
pch = 16,
col = "blue",
main = "Grafica N°2 : 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)")
#Diagramas de dispersión con una xorrespondiendo una x a una sola y
# Valores inferiores
plot(tabla_inf_1 $area,
tabla_inf_1 $toneladas,
pch = 16,
col = "blue",
main = "Grafica N°3 : 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)")
#valores Promedios
plot(tabla_media_1 $area,
tabla_media_1 $toneladas,
pch = 16,
col = "blue",
main = "Grafica N°4 : 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)")
#Valores superiores
plot(tabla_sup_1 $area,
tabla_sup_1 $toneladas,
pch = 16,
col = "blue",
main = "Grafica N°5 : 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)")
#Diagrama de dispersión para un tramo
plot(tabla_sup$area,
tabla_sup$toneladas,
pch = 16,
col = "blue",
main = "Grafica N°6 :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)")
plot(tabla_media$area,
tabla_media$toneladas,
pch = 16,
col = "blue",
main = "Grafica N°7 :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)")
plot(tabla_inf$area,
tabla_inf$toneladas,
pch = 16,
col = "blue",
main = "Grafica N°8 :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 exponencial
Diagrama de dispersión
#Diagrama de dispersión
plot(tabla_inf$area,
tabla_inf$toneladas,
pch = 16,
col = "blue",
main = "Grafica N°9 : Comparación de la realidad con el modelo exponencial
entre el área y el tonelaje de los depositos masivos de sulfuros
volcánicos",
xlab = "Área del deposito (km²)",
ylab = "Toneladas (Mt)")
x<-tabla_inf$area #Variable independiente
y<-tabla_inf$toneladas #Variable dependiente
# Parámetros exponenciales
y1<- log(y)
#Cálculo de coefientes
regresion_exponencial<- lm(y1~x)
regresion_exponencial ##
## Call:
## lm(formula = y1 ~ x)
##
## Coefficients:
## (Intercept) x
## 0.3154 0.2046summary(regresion_exponencial)##
## Call:
## lm(formula = y1 ~ x)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.9864 -0.4490 0.0035 0.2956 1.3880
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.31540 0.37430 0.843 0.415910
## x 0.20459 0.03813 5.365 0.000169 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.7005 on 12 degrees of freedom
## Multiple R-squared: 0.7058, Adjusted R-squared: 0.6813
## F-statistic: 28.79 on 1 and 12 DF, p-value: 0.0001693beta0<-regresion_exponencial$coefficients[1]
beta1<-regresion_exponencial$coefficients[2]
b<-beta1
b## x
## 0.2045911a<-exp(beta0)
a## (Intercept)
## 1.370809#Generar la curva
curve(a*exp(b*x), from = 0.0, to = 30, 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 exponencial \n Y = ae^bx \n Y = 1.37e^(0.205x)",
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(x,y1)
r*100## [1] 84.01172APRUEBA 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 <- a*exp(b*12)
T_Esp## (Intercept)
## 15.96652plot(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= 16.04 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 relacion exponencial donde el modelo f(x)=1.37e^(0.205x) 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 16.04 Mt