Año de Descubrimiento
Grupo No.3
2025-06-13
setwd("~/UCE/III/estadistica")
# Carga de Datos
datos <- read.csv("Conjunto_Datos_Minerales.csv", header = TRUE, sep = ";", dec = ".")
# Variable de interés
DiscAnio <- na.omit(datos$disc_yr)
# Paso 1: Preparación de datos
TDFDiscAnio <- table(DiscAnio)
TablaDiscAnio <- as.data.frame(TDFDiscAnio)
# Paso 2: Frecuencia relativa (porcentaje)
hi <- (TablaDiscAnio$Freq / sum(TablaDiscAnio$Freq)) * 100
TablaDiscAnio <- data.frame(TablaDiscAnio, hi = round(hi, 2))
# Paso 3: Frecuencia acumulada ascendente y descendente
Niasc <- cumsum(TablaDiscAnio$Freq)
Hiasc <- cumsum(TablaDiscAnio$hi)
Nidsc <- rev(cumsum(rev(TablaDiscAnio$Freq)))
Hidsc <- rev(cumsum(rev(TablaDiscAnio$hi)))
# Paso 4: Tabla final
TablaDiscAnioFinal <- data.frame(
Año = TablaDiscAnio$DiscAnio,
Frecuencia = TablaDiscAnio$Freq,
Porcentaje = TablaDiscAnio$hi,
Niasc,
Hiasc = round(Hiasc, 2),
Nidsc,
Hidsc = round(Hidsc, 2)
)
# Paso 5: Gráficos de barras (sin agrupar)
barplot(TablaDiscAnioFinal$Frecuencia,
main = "Gráfico No.1: Distribución de cantidad del año de descubrimiento",
xlab = "Año", ylab = "Cantidad",
col = "orange",
names.arg = TablaDiscAnioFinal$Año,
las = 2,
cex.names = 0.5,
cex.axis = 0.5)
barplot(TablaDiscAnioFinal$Frecuencia,
main = "Gráfico No.2: Distribución de cantidad del año de descubrimiento",
xlab = "Año", ylab = "Cantidad",
col = "red",
names.arg = TablaDiscAnioFinal$Año,
ylim = c(0, length(DiscAnio)),
las = 2,
cex.names = 0.5,
cex.axis = 0.5)
barplot(TablaDiscAnioFinal$Porcentaje,
main = "Gráfico No.3: Distribución de porcentaje del año de descubrimiento",
xlab = "Año", ylab = "Porcentaje",
col = "skyblue",
names.arg = TablaDiscAnioFinal$Año,
las = 2,
cex.names = 0.5,
cex.axis = 0.5)
barplot(TablaDiscAnioFinal$Porcentaje,
main = "Gráfico No.4: Distribución de porcentaje del año de descubrimiento",
xlab = "Año", ylab = "Porcentaje",
col = "blue",
names.arg = TablaDiscAnioFinal$Año,
ylim = c(0, 100),
las = 2,
cex.names = 0.5,
cex.axis = 0.5)
# Ojivas
x <- as.numeric(as.character(TablaDiscAnioFinal$Año))
plot(x, TablaDiscAnioFinal$Niasc, type = "p", main = "Gráfico No.5: Ojiva ascendente - Año descubrimiento",
xlab = "Año", ylab = "Frecuencia acumulada", col = "blue")
plot(x, TablaDiscAnioFinal$Nidsc, type = "p", main = "Gráfico No.6: Ojiva descendente - Año descubrimiento",
xlab = "Año", ylab = "Frecuencia acumulada", col = "blue")
plot(x, TablaDiscAnioFinal$Hiasc, type = "p", main = "Gráfico No.7: Ojiva ascendente % - Año descubrimiento",
xlab = "Año", ylab = "% acumulado", col = "blue")
plot(x, TablaDiscAnioFinal$Hidsc, type = "p", main = "Gráfico No.8: Ojiva descendente % - Año descubrimiento",
xlab = "Año", ylab = "% acumulado", col = "blue")
plot(x, TablaDiscAnioFinal$Niasc, type = "p",
main = "Gráfico No.9: Ojivas Ni: ascendente vs descendente",
xlab = "Año", ylab = "Frecuencia acumulada", col = "green")
lines(x, TablaDiscAnioFinal$Nidsc, type = "p", col = "blue")
plot(x, TablaDiscAnioFinal$Hiasc, type = "p",
main = "Gráfico No.10: Ojivas Hi (%): ascendente vs descendente",
xlab = "Año", ylab = "% acumulado", col = "green")
lines(x, TablaDiscAnioFinal$Hidsc, type = "p", col = "blue")
# ---------------- AGRUPACIÓN CADA 250 AÑOS ---------------------
# Crear intervalos de 250 años
minA <- floor(min(DiscAnio, na.rm = TRUE) / 250) * 250
maxA <- ceiling(max(DiscAnio, na.rm = TRUE) / 250) * 250
breaks <- seq(minA, maxA, by = 250)
# Etiquetas legibles para los intervalos
etiquetas_legibles <- paste0(head(breaks, -1), " a ", tail(breaks, -1))
# Agrupar los datos
DiscAnioIntervalos <- cut(DiscAnio,
breaks = breaks,
labels = etiquetas_legibles,
include.lowest = TRUE,
right = FALSE)
TDFIntervalos <- table(DiscAnioIntervalos)
TablaIntervalos <- as.data.frame(TDFIntervalos)
# Calcular frecuencia relativa (%)
hi <- (TablaIntervalos$Freq / sum(TablaIntervalos$Freq)) * 100
TablaIntervalos <- data.frame(TablaIntervalos, hi = round(hi, 2))
# Acumulados
Niasc <- cumsum(TablaIntervalos$Freq)
Hiasc <- cumsum(TablaIntervalos$hi)
Nidsc <- rev(cumsum(rev(TablaIntervalos$Freq)))
Hidsc <- rev(cumsum(rev(TablaIntervalos$hi)))
# Extraer límites y calcular punto medio
lim_inf <- head(breaks, -1)
lim_sup <- tail(breaks, -1)
punto_medio <- (lim_inf + lim_sup) / 2
# Crear tabla final agrupada
TablaAgrupada <- data.frame(
Limite_Inferior = lim_inf,
Limite_Superior = lim_sup,
Mc = punto_medio,
ni = TablaIntervalos$Freq,
hi = round(TablaIntervalos$hi, 2),
Niasc,
Hiasc = round(Hiasc, 2),
Nidsc,
Hidsc = round(Hidsc, 2)
)
# Ver tabla
print(TablaAgrupada)## Limite_Inferior Limite_Superior Mc ni hi Niasc Hiasc Nidsc Hidsc
## 1 -1250 -1000 -1125 1 0.00 1 0.00 20824 99.99
## 2 -1000 -750 -875 0 0.00 1 0.00 20823 99.99
## 3 -750 -500 -625 0 0.00 1 0.00 20823 99.99
## 4 -500 -250 -375 0 0.00 1 0.00 20823 99.99
## 5 -250 0 -125 0 0.00 1 0.00 20823 99.99
## 6 0 250 125 2 0.01 3 0.01 20823 99.99
## 7 250 500 375 0 0.00 3 0.01 20821 99.98
## 8 500 750 625 1 0.00 4 0.01 20821 99.98
## 9 750 1000 875 3 0.01 7 0.02 20820 99.98
## 10 1000 1250 1125 20 0.10 27 0.12 20817 99.97
## 11 1250 1500 1375 15 0.07 42 0.19 20797 99.87
## 12 1500 1750 1625 322 1.55 364 1.74 20782 99.80
## 13 1750 2000 1875 20455 98.23 20819 99.97 20460 98.25
## 14 2000 2250 2125 5 0.02 20824 99.99 5 0.02# Histograma
hist(DiscAnio,
breaks = breaks,
right = FALSE,
main = "Gráfico No.11: Histograma: Año de descubrimiento (agrupado cada 250 años)",
xlab = "Año",
ylab = "Frecuencia",
col = "orange",
border = "white")
# Ojivas agrupadas
x <- TablaAgrupada$Mc
plot(x, TablaAgrupada$Niasc, type = "b", main = "Gráfico No.12: Ojiva Ascendente (Agrupada)",
xlab = "Año (punto medio)", ylab = "Frecuencia acumulada", col = "blue")
plot(x, TablaAgrupada$Nidsc, type = "b", main = "Gráfico No.13: Ojiva Descendente (Agrupada)",
xlab = "Año (punto medio)", ylab = "Frecuencia acumulada", col = "blue")
plot(x, TablaAgrupada$Hiasc, type = "b", main = "Gráfico No.14: Ojiva Ascendente % (Agrupada)",
xlab = "Año (punto medio)", ylab = "% acumulado", col = "blue")
plot(x, TablaAgrupada$Hidsc, type = "b", main = "Gráfico No.15: Ojiva Descendente % (Agrupada)",
xlab = "Año (punto medio)", ylab = "% acumulado", col = "blue")
plot(x, TablaAgrupada$Niasc, type = "b", main = "Gráfico No.16: Ojivas Ni: Asc. y Desc. (Agrupada)",
xlab = "Año (punto medio)", ylab = "Frecuencia acumulada", col = "green")
lines(x, TablaAgrupada$Nidsc, type = "b", col = "blue")
plot(x, TablaAgrupada$Hiasc, type = "b", main = "Gráfico No.17: Ojivas Hi %: Asc. y Desc. (Agrupada)",
xlab = "Año (punto medio)", ylab = "% acumulado", col = "green")
lines(x, TablaAgrupada$Hidsc, type = "b", col = "blue")
# Boxplot
boxplot(DiscAnio, horizontal = TRUE, col = "red",
main = "Gráfico No.18: Distribución del año de descubrimiento")
# ---------------- MEDIDAS ESTADÍSTICAS ------------------------
library(moments)
minimo <- min(DiscAnio)
maximo <- max(DiscAnio)
rango <- maximo - minimo
media <- mean(DiscAnio)
mediana <- median(DiscAnio)
cuartiles <- quantile(DiscAnio, probs = c(0.25, 0.5, 0.75))
varianza <- var(DiscAnio)
desviacion <- sd(DiscAnio)
coef_var <- desviacion / media * 100
asimetria <- skewness(DiscAnio)
curtosis <- kurtosis(DiscAnio)
valores <- c(minimo, maximo, rango, media, mediana,
cuartiles[1], cuartiles[3],
varianza, desviacion, coef_var,
asimetria, curtosis)
nombres <- c("Mínimo", "Máximo", "Rango", "Media", "Mediana", "Q1", "Q3",
"Varianza", "Desv. estándar", "Coef. de variación (%)",
"Asimetría", "Curtosis")
tabla_horizontal <- as.data.frame(t(valores))
colnames(tabla_horizontal) <- nombres
# Mostrar tabla de medidas estadísticas
print(tabla_horizontal)## Mínimo Máximo Rango Media Mediana Q1 Q3 Varianza Desv. estándar
## 1 -1100 2002 3102 1910.128 1917 1885 1950 4645.803 68.16013
## Coef. de variación (%) Asimetría Curtosis
## 1 3.568354 -9.892243 270.7379# ---------------- DETECCIÓN DE OUTLIERS ------------------------
IQR_val <- cuartiles[3] - cuartiles[1]
limite_inferior <- cuartiles[1] - 1.5 * IQR_val
limite_superior <- cuartiles[3] + 1.5 * IQR_val
outliers <- DiscAnio[DiscAnio < limite_inferior | DiscAnio > limite_superior]
num_outliers <- length(outliers)
min_outlier <- if (num_outliers > 0) min(outliers) else NA
max_outlier <- if (num_outliers > 0) max(outliers) else NA
Tabla_outliers <- data.frame(
"Cantidad de outliers" = num_outliers,
"Valor mínimo de outliers" = min_outlier,
"Valor máximo de outliers" = max_outlier
)
# Mostrar tabla de outliers
print(Tabla_outliers)## Cantidad.de.outliers Valor.mínimo.de.outliers Valor.máximo.de.outliers
## 1 456 -1100 1787Conclusión
La variable año de descubrimiento, medida en años, presenta valores que oscilan entre -1100 y 2002, lo que sugiere la inclusión de yacimientos reportados desde épocas antiguas. La media es 1910.12 y la mediana es 1917, lo que revela una ligera asimetría negativa (asimetría = -9.89) pero muy pronunciada, indicando la presencia de valores extremos bajos (años antiguos) que arrastran la media hacia atrás. La desviación estándar de 68.16 años indica una dispersión significativa respecto al promedio, mientras que el coeficiente de variación del 3.56% refleja una variabilidad baja relativa a la media, por la escala de los valores.
La curtosis extremadamente alta (270.73) revela una distribución leptocúrtica, es decir, con una alta concentración de valores alrededor de la mediana, pero también con presencia marcada de valores atípicos. Los cuartiles muestran que la mayor parte de los datos se encuentran entre el primer cuartil (Q1 = 1885) y el tercer cuartil (Q3 = 1950), lo cual evidencia que el grueso de los descubrimientos minerales ocurrió durante el siglo XIX y la primera mitad del siglo XX, en correspondencia con procesos de industrialización, colonización y expansión geológica.
Este comportamiento es clave para comprender la historia de la minería mundial, ya que refleja cómo la exploración minera se ha intensificado durante periodos específicos. Asimismo, la detección de valores extremadamente antiguos puede representar registros históricos de gran relevancia o datos que requieren revisión, y ofrece una oportunidad para analizar patrones históricos de uso y conocimiento de recursos minerales en diferentes civilizaciones.