Análisis de Depósitos Masivos de Sulfuro Volcánicos (Variable Año de descubrimiento)
Grupo 2
2025-12-20
ANÁLISIS ESTADÍSTICO
CARGA DE DATOS Y LIBRERÍAS
CARGA DE DATOS
setwd("~/UNI/ESTADISTICA")
datos <- read.csv("Depositos_Sulfuro.csv", header = TRUE, sep = ";", dec = ".")
# Extraer y dejar solo datos válidos
disc <- as.numeric(datos$discdate)
disc <- na.omit(disc) CARGA DE LIBRERIAS
#Carga de librerias
library(gt)
library(dplyr)
library(knitr)
library(e1071)TABLA DE DISTRIBUCIÓN DE CANTIDAD
TABLA DE DISTRIBUCION DE CANTIDAD
Debido a que existen numerosos registros del año de descubrimiento, se decidió agruparlos en intervalos, convirtiendo la variable en continua.
#Agrupar la variable en intervalos
clasificacion <- character(length(disc))
for(i in seq_along(disc)){
if(disc[i] >= -3000 & disc[i] < -2500){
clasificacion[i] <- "[-3000 , -2500)"
} else if(disc[i] >= -2500 & disc[i] < -2000){
clasificacion[i] <- "[-2500 , -2000)"
} else if(disc[i] >= -2000 & disc[i] < -1500){
clasificacion[i] <- "[-2000 , -1500)"
} else if(disc[i] >= -1500 & disc[i] < -1000){
clasificacion[i] <- "[-1500 , -1000)"
} else if(disc[i] >= -1000 & disc[i] < -500){
clasificacion[i] <- "[-1000 , -500)"
} else if(disc[i] >= -500 & disc[i] < 0){
clasificacion[i] <- "[-500 , 0)"
} else if(disc[i] >= 0 & disc[i] < 500){
clasificacion[i] <- "[0 , 500)"
} else if(disc[i] >= 500 & disc[i] < 1000){
clasificacion[i] <- "[500 , 1000)"
} else if(disc[i] >= 1000 & disc[i] < 1500){
clasificacion[i] <- "[1000 , 1500)"
} else if(disc[i] >= 1500 & disc[i] < 2000){
clasificacion[i] <- "[1500 , 2000)"
} else if(disc[i] >= 2000 & disc[i] <= 2200){
clasificacion[i] <- "[2000 , 2200]"
} else {
clasificacion[i] <- NA
}
}
# Quitar posibles NA de la clasificación
clasificacion <- na.omit(clasificacion)
#Orden adecuado
orden <- c("[-3000 , -2500)",
"[-2500 , -2000)",
"[-2000 , -1500)",
"[-1500 , -1000)",
"[-1000 , -500)",
"[-500 , 0)",
"[0 , 500)",
"[500 , 1000)",
"[1000 , 1500)",
"[1500 , 2000)",
"[2000 , 2200]")
clasificacion <- factor(clasificacion, levels = orden)
# 4) Frecuencias simples
ni <- table(clasificacion)
total <- sum(ni)
hi <- round (as.numeric(ni) / total * 100,2)
# 5) Acumuladas ascendente
Ni_Asc <- cumsum(ni)
Hi_Asc <- cumsum(hi)
# 6) Acumuladas descendente
Ni_Desc <- rev(cumsum(rev(ni)))
Hi_Desc <- rev(cumsum(rev(hi)))
# 7) Tabla final
tabla_final <- data.frame(
Intervalo = orden,
ni = as.numeric(ni),
hi = hi,
Ni_Asc = as.numeric(Ni_Asc),
Hi_Asc = round(Hi_Asc, 3),
Ni_Desc = as.numeric(Ni_Desc),
Hi_Desc = round(Hi_Desc, 3)
)
# Verificar que las proporciones sumen 100
sum(tabla_final$hi) ## [1] 100tail(tabla_final$Hi_Asc,1) ## [1] 100head(tabla_final$Hi_Desc,1) ## [1] 100# Calcular sumatorias simples
suma_ni <- sum(tabla_final$ni)
suma_hi <- sum(tabla_final$hi)Fila total de las sumas de ni y hi
# Crear fila total
fila_total <- data.frame(
Intervalo = "TOTAL",
ni = suma_ni,
hi = round((suma_hi),2),
Ni_Asc = "-",
Hi_Asc = "-",
Ni_Desc = "-",
Hi_Desc = "-"
)
# Unir a la tabla
tabla_final <- rbind(tabla_final, fila_total)
tabla_final## Intervalo ni hi Ni_Asc Hi_Asc Ni_Desc Hi_Desc
## 1 [-3000 , -2500) 4 0.49 4 0.49 823 100
## 2 [-2500 , -2000) 1 0.12 5 0.61 819 99.51
## 3 [-2000 , -1500) 3 0.36 8 0.97 818 99.39
## 4 [-1500 , -1000) 3 0.36 11 1.33 815 99.03
## 5 [-1000 , -500) 12 1.46 23 2.79 812 98.67
## 6 [-500 , 0) 2 0.24 25 3.03 800 97.21
## 7 [0 , 500) 17 2.07 42 5.1 798 96.97
## 8 [500 , 1000) 0 0.00 42 5.1 781 94.9
## 9 [1000 , 1500) 5 0.61 47 5.71 781 94.9
## 10 [1500 , 2000) 768 93.32 815 99.03 776 94.29
## 11 [2000 , 2200] 8 0.97 823 100 8 0.97
## 12 TOTAL 823 100.00 - - - -TABLA DE DISTRIBUCIÓN DE CANTIDAD FINAL
# TABLA GT
TablaDisc <- tabla_final %>%
gt() %>%
tab_header(
title = md("*Tabla Nº. 1*"),
subtitle = md("**Tabla de distribución de cantidad de los años
de descubrimiento de los depósitos masivos de
sulfuros volcánicos**")
) %>%
tab_source_note(
source_note = md("__Autor: Grupo 2__")
) %>%
tab_options(
table.border.top.color = "black",
table.border.bottom.color = "black",
table.border.top.style = "solid",
table.border.bottom.style = "solid",
column_labels.border.top.color = "black",
column_labels.border.bottom.color = "black",
column_labels.border.bottom.width = px(2),
row.striping.include_table_body = TRUE,
heading.border.bottom.color = "black",
heading.border.bottom.width = px(2),
table_body.hlines.color = "gray",
table_body.border.bottom.color = "black"
) %>%
tab_style(
style = cell_text(weight = "bold"),
locations = cells_body(
rows = Intervalo == "TOTAL"
)
)
TablaDisc| Tabla Nº. 1 | ||||||
| Tabla de distribución de cantidad de los años de descubrimiento de los depósitos masivos de sulfuros volcánicos | ||||||
| Intervalo | ni | hi | Ni_Asc | Hi_Asc | Ni_Desc | Hi_Desc |
|---|---|---|---|---|---|---|
| [-3000 , -2500) | 4 | 0.49 | 4 | 0.49 | 823 | 100 |
| [-2500 , -2000) | 1 | 0.12 | 5 | 0.61 | 819 | 99.51 |
| [-2000 , -1500) | 3 | 0.36 | 8 | 0.97 | 818 | 99.39 |
| [-1500 , -1000) | 3 | 0.36 | 11 | 1.33 | 815 | 99.03 |
| [-1000 , -500) | 12 | 1.46 | 23 | 2.79 | 812 | 98.67 |
| [-500 , 0) | 2 | 0.24 | 25 | 3.03 | 800 | 97.21 |
| [0 , 500) | 17 | 2.07 | 42 | 5.1 | 798 | 96.97 |
| [500 , 1000) | 0 | 0.00 | 42 | 5.1 | 781 | 94.9 |
| [1000 , 1500) | 5 | 0.61 | 47 | 5.71 | 781 | 94.9 |
| [1500 , 2000) | 768 | 93.32 | 815 | 99.03 | 776 | 94.29 |
| [2000 , 2200] | 8 | 0.97 | 823 | 100 | 8 | 0.97 |
| TOTAL | 823 | 100.00 | - | - | - | - |
| Autor: Grupo 2 | ||||||
GRÁFICAS DE DISTRIBUCIÓN DE CANTIDAD
Histograma de cantidad
hist(disc, main="Grafica Nº1: Distribución de cantidad del año de
descubrimiento de los depositos masivos de sulfuros volcanicos ",
col="gray",
ylab="Cantidad",
xlab = "Año de descubrimiento",
cex.names = 0.6)
Histograma de cantidad
hist(disc, main="Grafica Nº2: Distribución de cantidad del año de
descubrimiento de los depositos masivos de sulfuros volcanicos ",
col="gray",
xlab="Año de descubrimiento",
ylab="Cantidad",
cex.names = 0.6,
ylim=c(0,800))
Histograma de cantidad en porcentaje
etiquetas_x <- c(-3000, -2500, -2000, -1500, -1000, -500,
0, 500, 1000, 1500, 2000)
hi_plot <- tabla_final$hi[tabla_final$Intervalo != "TOTAL"]
barplot(hi_plot,
main = "Grafica Nº3: Distribución de cantidad en porcentaje del
año de descubrimiento de los depositos masivos de sulfuros
volcanicos ",
col="gray",
space=0,
las=1,
xlab="Año de descubrimiento",
ylab="Porcentaje",
names.arg = etiquetas_x,
cex.names = 0.6)
Histograma de cantidad en porcentaje
# Filtrar los datos SIN la fila TOTAL
hi_plot <- tabla_final$hi[tabla_final$Intervalo != "TOTAL"]
barplot(hi_plot,
space = 0,
main="Grafica Nº4: Distribución de cantidad en porcentaje del
año de descubrimiento de los depositos masivos de sulfuros
volcanicos ",
col = "gray",
las = 1,
xlab = "Año de descubrimiento",
ylab = "Porcentaje",
names.arg = etiquetas_x,
ylim = c(0,100),
cex.names = 0.6)
Ojivas combinadas Ni
x_intervalos <- c(-3000, -2500, -2000, -1500, -1000, -500,
0, 500, 1000, 1500, 2000)
plot(x = x_intervalos,
y = Ni_Asc,
type = "o",
col = "blue",
main = "Grafica Nº5: Ojiva combinada del año de descubrimiento\n(Ni)",
xlab = "Año de descubrimiento",
ylab = "Cantidad acumulada (Ni)",
las = 2
)
lines(x = x_intervalos,
y = Ni_Desc,
type = "o",
col = "red")
Ojivas combinadas Hi
plot(x = x_intervalos,
y = Hi_Asc,
type = "o",
col = "blue",
main = "Grafica Nº6: Ojiva combinada del año de descubrimiento\n(Hi)",
xlab = "Año de descubrimiento",
ylab = "Porcentaje acumulado (Hi)",
las = 2,
ylim = c(0, 100)
)
lines(x = x_intervalos,
y = Hi_Desc,
type = "o",
col = "black")
DIAGRAMA DE CAJA
boxplot(disc,
horizontal = TRUE,
col = "blue",
main = "Gráfica Nº7: Distribución de cantidad del año de descubrimiento
de depósitos masivos de sulfuros volcánicos",
xlab = "Año de descubrimiento")
INDICADORES ESTADISTICOS Y OUTLIERS
Ver los cuartiles
summary(disc)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -3000 1896 1947 1785 1965 2004Indicadores Estadisticos
POSICION
#MEDIA ARITMETICA
x<-mean(disc)
x## [1] 1785.355#MEDIANA ARITMETICA
ri<-min(disc)
rs<-max(disc)
Me<-median(disc)
Me## [1] 1947DISPERSION
#DESVIACIÓN ESTÁNDAR
sd<-sd(disc)
sd## [1] 639.8237#COEFICIENTE DE VARIACIÓN
CV <- ((sd / x) * 100)
CV## [1] 35.83734FORMA
#COEFICIENTE DE ASIMETRÍA
As<-skewness(disc)
As## [1] -4.949028#COEFICIENTE DE CURTOSIS
K<-kurtosis(disc)
K## [1] 26.18935TABLA DE INDICADORES ESTADISTICOS
Variable<-c("Año de descubrimiento")
TablaIndicadores<-data.frame(Variable,ri,rs,round(x,2),Me,round(sd,2), round(CV,2), round(As,2),round(K,2))
colnames(TablaIndicadores)<-c("Variable","minimo","máximo","x","Me","sd","Cv (%)","As","K")
kable(TablaIndicadores, format = "markdown", caption = "Tabla N°3. Indicadores estadíticos de la variable año de descubrimiento de los depositos masivos de sulfuros volcanicos")| Variable | minimo | máximo | x | Me | sd | Cv (%) | As | K |
|---|---|---|---|---|---|---|---|---|
| Año de descubrimiento | -3000 | 2004 | 1785.35 | 1947 | 639.82 | 35.84 | -4.95 | 26.19 |
TABLA DE OUTLIERS
outliers<-boxplot.stats(disc)$out
# Contar los valores atípicos
num_outliers <- length(outliers)
num_outliers## [1] 87minoutliers<-min(outliers)
minoutliers## [1] -3000maxoutliers<-max(outliers)
maxoutliers## [1] 1793TablaOutliers<-data.frame(num_outliers,minoutliers,maxoutliers)
colnames(TablaOutliers)<-c("Outliers","Mínimo","Máximo")
kable(TablaOutliers, format = "markdown", caption = "Tabla N°4: Outliers
de la variable año de descubrimiento de los depositos masivos de sulfuros
volcanicos).")| Outliers | Mínimo | Máximo |
|---|---|---|
| 87 | -3000 | 1793 |
CONCLUSIÓN
CONCLUSÍON
La variable año de descubrimiento presenta valores que fluctúan entre –3000 y 2004, con una concentración en torno a la mediana de 1947. La desviación estándar de 639.82 indica que se trata de un conjunto heterogéneo, influenciado por la presencia de valores atípicos muy antiguos ubicados en el extremo izquierdo de la distribución. La acumulación de valores se encuentra en la parte alta de la variable, lo que evidencia que la mayoría de los descubrimientos se realizaron en periodos recientes. Por todo lo anterior mencionado, el comportamiento de la variable es medianamente beneficioso, debido a que los registros modernos cuentan con información geológica más confiable y mejor documentada.