Análisis de Depósitos Masivos de Sulfuro Volcánicos (Variable Año de descubrimiento)
Grupo 2
2025-12-13
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 FRECUENCIA
TABLA DE DISTRIBUCION DE FRECUENCIA
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] >= -300 & disc[i] < 200){
clasificacion[i] <- "[-300 , 200)"
} else if(disc[i] >= 200 & disc[i] < 700){
clasificacion[i] <- "[200 , 700)"
} else if(disc[i] >= 700 & disc[i] < 1200){
clasificacion[i] <- "[700 , 1200)"
} else if(disc[i] >= 1200 & disc[i] < 1700){
clasificacion[i] <- "[1200 , 1700)"
} else if(disc[i] >= 1700 & disc[i] < 2200){
clasificacion[i] <- "[1700 , 2200)"
} else {
clasificacion[i] <- NA # fuera de rango
}
}
# Quitar posibles NA de la clasificación
clasificacion <- na.omit(clasificacion)
# 3) Fijar el orden CORRECTO de los intervalos
orden <- c("[-300 , 200)",
"[200 , 700)",
"[700 , 1200)",
"[1200 , 1700)",
"[1700 , 2200)")
clasificacion <- factor(clasificacion, levels = orden)
# 4) Frecuencias simples
ni <- table(clasificacion)
total <- sum(ni)
hi <- as.numeric(ni) / total * 100
# 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 = round(hi, 3),
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 = suma_hi,
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 [-300 , 200) 5 0.625 5 0.625 800 100
## 2 [200 , 700) 14 1.750 19 2.375 795 99.375
## 3 [700 , 1200) 3 0.375 22 2.75 781 97.625
## 4 [1200 , 1700) 17 2.125 39 4.875 778 97.25
## 5 [1700 , 2200) 761 95.125 800 100 761 95.125
## 6 TOTAL 800 100.000 - - - -TABLA DE DISTRIBUCIÓN DE FRECUENCIA POR STURGES FINAL
# TABLA GT
TablaDisc <- tabla_final %>%
gt() %>%
tab_header(
title = md("*Tabla Nº. 1*"),
subtitle = md("**Tabla de distribución de frecuencias simples y acumuladas
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" # Se resalta TOTAL
)
)
TablaDisc| Tabla Nº. 1 | ||||||
| Tabla de distribución de frecuencias simples y acumuladas 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 |
|---|---|---|---|---|---|---|
| [-300 , 200) | 5 | 0.625 | 5 | 0.625 | 800 | 100 |
| [200 , 700) | 14 | 1.750 | 19 | 2.375 | 795 | 99.375 |
| [700 , 1200) | 3 | 0.375 | 22 | 2.75 | 781 | 97.625 |
| [1200 , 1700) | 17 | 2.125 | 39 | 4.875 | 778 | 97.25 |
| [1700 , 2200) | 761 | 95.125 | 800 | 100 | 761 | 95.125 |
| TOTAL | 800 | 100.000 | - | - | - | - |
| Autor: Grupo 2 | ||||||
GRÁFICAS DE DISTRIBUCIÓN DE FRECUENCIA
Histograma de frecuencia absoluta local
hist(disc, main="Grafica Nº1: Distrribucion de frecuencia del año de descubrimiento
de los depositos masivos de sulfuros volcanicos (Local)",
col="gray",
ylab="Cantidad",
xlab = "Año de descubrimiento",
cex.names = 0.6)
Histograma de frecuencia absoluta global
hist(disc, main="Grafica Nº2: Distribucion de frecuencia del año de descubrimiento
de los depositos masivos de sulfuros volcanicos (Global)",
col="gray",
xlab="Año de descubrimiento",
ylab="Cantidad",
cex.names = 0.6,
ylim=c(0,800))
Histograma de frecuencia relativa local
hi_plot <- tabla_final$hi[tabla_final$Intervalo != "TOTAL"]
intervalos_plot <- tabla_final$Intervalo[tabla_final$Intervalo != "TOTAL"]
barplot(hi_plot,
space = 0,
main = "Grafica Nº3: Distribucion de frecuencia relativa del año de
descubrimiento de los depósitos masivos de sulfuros volcánicos (local)",
col="gray",
las=2,
xlab="Año de descubrimiento",
ylab="Porcentaje",
names.arg = intervalos_plot,
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"]
intervalos_plot <- tabla_final$Intervalo[tabla_final$Intervalo != "TOTAL"]
barplot(hi_plot,
space = 0,
main="Grafica Nº4: Distribucion de frecuencia relativa del año de
descubrimiento de los depósitos masivos de sulfuros volcánicos (Global)",
col = "gray",
las = 2,
xlab = "Año de descubrimiento",
ylab = "Porcentaje",
names.arg = intervalos_plot,
ylim = c(0,100),
cex.names = 0.6)
Ojivas combinadas Ni
#OJIVAS COMBINADAS NI
# Filtrar sin TOTAL
intervalos <- tabla_final$Intervalo[tabla_final$Intervalo!="TOTAL"]
Ni_asc <- tabla_final$Ni_Asc[tabla_final$Intervalo!="TOTAL"]
Ni_desc <- tabla_final$Ni_Desc[tabla_final$Intervalo!="TOTAL"]
plot(x = 1:length(intervalos),
y = Ni_asc,
type = "o",
col = "blue",
main = "Grafica Nº5: Ojiva combinada de años de descubrimiento de los
depositos masivos de sulfuros volcanicos (Ni)",
xlab = "Año de descubrimiento",
ylab = "Frecuencia",
xaxt="n"
)
axis(side = 1,
at = 1:length(intervalos),
labels = intervalos,
las = 2,
cex.axis = 0.6)
lines(x = 1:length(intervalos),
y = Ni_desc,
col = "red",
type = "o")
Ojivas combinadas Hi
# Filtrar sin TOTAL
Hi_desc <- tabla_final$Hi_Desc[tabla_final$Intervalo!="TOTAL"]
Hi_asc <- tabla_final$Hi_Asc [tabla_final$Intervalo!="TOTAL"]
intervalos <- tabla_final$Intervalo[tabla_final$Intervalo!="TOTAL"]
# CONVERTIR A NUMÉRICOS
Hi_desc <- as.numeric(Hi_desc)
Hi_asc <- as.numeric(Hi_asc)
########### PLOT ###########
plot(x = 1:length(intervalos),
y = Hi_desc,
type = "p",
col = "black",
xlab = "Año de descubrimiento",
ylab = "Porcentaje ",
main = "Grafica Nº6: Ojiva combinada de años de descubrimiento de los
depositos masivos de sulfuros volcanicos (Hi)",
xaxt = "n",
ylim = c(min(c(Hi_desc,Hi_asc))-1, max(c(Hi_desc,Hi_asc))+1)
)
axis(side = 1,
at = 1:length(intervalos),
labels = intervalos,
las = 2,
cex.axis = 0.6)
lines(x = 1:length(intervalos),
y = Hi_desc,
col = "black")
points(x = 1:length(intervalos),
y = Hi_asc,
col = "blue",
pch = 19)
lines(x = 1:length(intervalos),
y = Hi_asc,
col = "blue")
DIAGRAMA DE CAJA
boxplot(disc,
horizontal = TRUE,
col = "blue",
main = "Gráfica Nº7: Distribución de frecuencia 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 valores concentrados en torno a 1947, y una desviación estándar de 639.82, lo que evidencia que se trata de un conjunto altamente heterogéneo, influenciado por la presencia de valores atípicos muy antiguos. Dichos outliers se ubican principalmente en la parte izquierda de la distribución, correspondientes a registros históricos extremos. La acumulación de valores se concentra de manera marcada en la parte alta de la variable, lo que indica que la mayoría de los descubrimientos se realizó en épocas recientes. Por todo lo anterior, el comportamiento de la variable se considera medianamente beneficioso, ya que la concentración de descubrimientos en periodos modernos permite contar con información más confiable y mejor documentada, a pesar de la presencia de registros históricos aislados.