Análisis de Depósitos Masivos de Sulfuro Volcánicos (Variable Año de Inicio)
Grupo 2
2025-12-15
Carga de Datos y Librerías
1. CARGA DE LIBRERIAS
# cargar librerías
library(dplyr)##
## Adjuntando el paquete: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(ggplot2)
library(gt)
library(knitr)
library(e1071)##
## Adjuntando el paquete: 'e1071'## The following object is masked from 'package:ggplot2':
##
## element1.2. CARGA DE DATOS
#cargar datos
datos <- read.csv("C:\\Users\\joeja\\Desktop\\Proyecto Estadística\\Depositos_sulfuro.csv",
header = TRUE,
sep = ";",
dec = ".")
# Extraer y dejar solo datos válidos
start <- as.numeric(datos$startdate)## Warning: NAs introducidos por coerciónstart <- na.omit(start)Tabla de distribucion de frecuencia
2. TABLAS DE DISTRIBUCIÓN DE FRECUENCIA
Debido a que existen numerosos registros del año de inicio, se decidió agruparlos en intervalos, convirtiendo la variable en continua.
#Agrupar la variable en intervalos
clasificacion <- character(length(start))
for(i in seq_along(start)){
if(start[i] >= -2500 & start[i] < -2000){
clasificacion[i] <- "-2500 a -2000"
} else if(start[i] >= -2000 & start[i] < -1500){
clasificacion[i] <- "-2000 a -1500"
} else if(start[i] >= -1500 & start[i] < -1000){
clasificacion[i] <- "-1500 a -1000"
} else if(start[i] >= -1000 & start[i] < -500){
clasificacion[i] <- "-1000 a -500"
} else if(start[i] >= -500 & start[i] < 0){
clasificacion[i] <- "-500 a 0"
} else if(start[i] >= 0 & start[i] < 500){
clasificacion[i] <- "0 a 500"
} else if(start[i] >= 500 & start[i] < 1000){
clasificacion[i] <- "500 a 1000"
} else if(start[i] >= 1000 & start[i] < 1500){
clasificacion[i] <- "1000 a 1500"
} else if(start[i] >= 1500 & start[i] <= 2000){
clasificacion[i] <- "1500 a 2000"
} else if(start[i] > 2000 & start[i] <= 2200){
clasificacion[i] <- "2000 a 2200"
} else {
clasificacion[i] <- NA
}
}
# Quitar posibles NA de la clasificación
clasificacion <- na.omit(clasificacion)
#Orden adecuado
orden <- c(
"-2500 a -2000",
"-2000 a -1500",
"-1500 a -1000",
"-1000 a -500",
"-500 a 0",
"0 a 500",
"500 a 1000",
"1000 a 1500",
"1500 a 2000",
"2000 a 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 -2500 a -2000 1 0.19 1 0.19 518 100
## 2 -2000 a -1500 2 0.39 3 0.58 517 99.81
## 3 -1500 a -1000 1 0.19 4 0.77 515 99.42
## 4 -1000 a -500 11 2.12 15 2.89 514 99.23
## 5 -500 a 0 0 0.00 15 2.89 503 97.11
## 6 0 a 500 0 0.00 15 2.89 503 97.11
## 7 500 a 1000 0 0.00 15 2.89 503 97.11
## 8 1000 a 1500 1 0.19 16 3.08 503 97.11
## 9 1500 a 2000 497 95.95 513 99.03 502 96.92
## 10 2000 a 2200 5 0.97 518 100 5 0.97
## 11 TOTAL 518 100.00 - - - -2.1. Tabla Nº1-Distribución de Porcentaje en Peso de Zinc en el mineral de los Depósitos masivos de sulfuros volcanicos
# TABLA GT
Tablastart <- tabla_final %>%
gt() %>%
tab_header(
title = md("*Tabla Nº. 1*"),
subtitle = md("**Distribución de los años de inicio 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"
)
)
Tablastart| Tabla Nº. 1 | ||||||
| Distribución de los años de inicio de los depósitos masivos de sulfuros volcánicos | ||||||
| Intervalo | ni | hi | Ni_Asc | Hi_Asc | Ni_Desc | Hi_Desc |
|---|---|---|---|---|---|---|
| -2500 a -2000 | 1 | 0.19 | 1 | 0.19 | 518 | 100 |
| -2000 a -1500 | 2 | 0.39 | 3 | 0.58 | 517 | 99.81 |
| -1500 a -1000 | 1 | 0.19 | 4 | 0.77 | 515 | 99.42 |
| -1000 a -500 | 11 | 2.12 | 15 | 2.89 | 514 | 99.23 |
| -500 a 0 | 0 | 0.00 | 15 | 2.89 | 503 | 97.11 |
| 0 a 500 | 0 | 0.00 | 15 | 2.89 | 503 | 97.11 |
| 500 a 1000 | 0 | 0.00 | 15 | 2.89 | 503 | 97.11 |
| 1000 a 1500 | 1 | 0.19 | 16 | 3.08 | 503 | 97.11 |
| 1500 a 2000 | 497 | 95.95 | 513 | 99.03 | 502 | 96.92 |
| 2000 a 2200 | 5 | 0.97 | 518 | 100 | 5 | 0.97 |
| TOTAL | 518 | 100.00 | - | - | - | - |
| Autor: Grupo 2 | ||||||
Gráficas de distribución de frecuencias
4. Histograma de frecuencia Absoluta (local/global)
#Histograma de frecuencia absoluta local
hist(
start,
main = "Gráfica Nº1: Distribución de frecuencia absoluta local del año
de inicio de los depósitos masivos de sulfuros volcánicos",
col = "gray",
ylab = "Cantidad",
xlab = "Año de inicio",
cex.axis = 1,
cex.lab = 1,
cex.main =1
)
# Histograma de frecuencia absoluta global
hist(
start,
main = "Gráfica Nº2: Distribución de frecuencia absoluta global del año
de inicio de los depósitos masivos de sulfuros volcánicos",
col = "gray",
xlab = "Año de inicio",
ylab = "Cantidad",
ylim = c(0, 500),
cex.axis = 1,
cex.lab = 1,
cex.main = 1
)
4.1. Histograma de frecuencia relativa (local/global)
#Histograma de frecuencia relativa local
etiquetas_x <- c(-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: Distribucion de frecuencia relativa local del año
de inicio de los depósitos masivos de sulfuros volcánicos ",
col="gray",
space=0,
las=1,
xlab="Año de inicio",
ylab="Porcentaje",
names.arg = etiquetas_x,
cex.names = 0.6)
#Histograma de frecuencia relativa global
# 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: Distribucion de frecuencia relativa global del año
de inicio de los depósitos masivos de sulfuros volcánicos ",
col = "gray",
las = 1,
xlab = "Año de inicio",
ylab = "Porcentaje",
names.arg = etiquetas_x,
ylim = c(0,100),
cex.names = 0.6)
4.2. Ojivas combinadas
Ojivas combinadas Ni
x_intervalos <- c(-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 inicio\n(Ni)",
xlab = "Año de inicio",
ylab = "Frecuencia acumulada",
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 inicio\n(Hi)",
xlab = "Año de inicio",
ylab = "Porcentaje acumulado",
las = 2,
ylim = c(0, 100)
)
lines(x = x_intervalos,
y = Hi_Desc,
type = "o",
col = "black")
4.3 Diagrama de caja
#DIAGRAMA DE CAJA
boxplot(start,
horizontal = TRUE,
col = "blue",
main = "Gráfica Nº7: Distribución de frecuencia del año de inicio
de depósitos masivos de sulfuros volcánicos",
xlab = "Año de inicio")
Indicadores estadísticos y outliers
5. Indicadores
Ver cuartiles
#cuartiles
summary(start) ## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -2500 1901 1937 1836 1966 2006Posicion
#MEDIA ARITMETICA
x<-mean(start)
x## [1] 1836.494#MEDIANA ARITMETICA
ri<-min(start)
rs<-max(start)
Me<-median(start)
Me## [1] 1937Dispersion
#DESVIACIÓN ESTÁNDAR
sd<-sd(start)
sd## [1] 520.2646#COEFICIENTE DE VARIACIÓN
CV <- ((sd / x) * 100)
CV## [1] 28.32923Forma
#COEFICIENTE DE ASIMETRÍA
As<-skewness(start)
As## [1] -5.776518#COEFICIENTE DE CURTOSIS
K<-kurtosis(start)
K## [1] 33.714425.1. Tabla de Indicadores Estadísticos
#TABLA DE INDICADORES ESTADISTICOS
Variable<-c("Año de inicio")
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 inicio de los depositos masivos de sulfuros volcanicos")| Variable | minimo | máximo | x | Me | sd | Cv (%) | As | K |
|---|---|---|---|---|---|---|---|---|
| Año de inicio | -2500 | 2006 | 1836.49 | 1937 | 520.26 | 28.33 | -5.78 | 33.71 |
5.2. Tabla Outliers
#TABLA DE OUTLIERS
outliers<-boxplot.stats(start)$out
# Contar los valores atípicos
num_outliers <- length(outliers)
num_outliers## [1] 42minoutliers<-min(outliers)
minoutliers## [1] -2500maxoutliers<-max(outliers)
maxoutliers## [1] 1800TablaOutliers<-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 inicio de los depositos masivos de sulfuros
volcanicos).")| Outliers | Mínimo | Máximo |
|---|---|---|
| 42 | -2500 | 1800 |
Conclusión
6. Conclusiones
La variable año de inicio presenta valores que fluctúan entre –2500 y 2006, con una concentración en torno a la mediana de 1937 La desviación estándar de 520.26 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 inicios 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.