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 potencial
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 potencial
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 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.3300summary(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-05beta0<-regresion_Potencial$coefficients[1]
beta1<-regresion_Potencial$coefficients[2]
b<-beta1
b## x1
## 1.329973a<-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.67856APRUEBA 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.2198plot(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