# CARGA DE DATOS
library(readxl)
datos <- read_excel("D:/dataset_variables_discretas_mineria.xlsx")
# Extraer y dejar solo datos válidos
disc <- as.numeric(datos$`Frecuencia de muestras por depósito`)
disc <- na.omit(disc)
# CARGA DE LIBRERIAS
#Carga de librerias
library(gt)
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(knitr)
library(e1071)
# Agrupar la variable en intervalos mediante la Regla de Sturges
n_intervalos <- nclass.Sturges(disc)
clasificacion <- cut(disc, breaks = n_intervalos, right = FALSE, include.lowest = TRUE)
# Quitar posibles NA de la clasificación
clasificacion <- na.omit(clasificacion)
# Orden adecuado extraído automáticamente de los niveles de Sturges
orden <- levels(clasificacion)
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] 100
tail(tabla_final$Hi_Asc,1)
## [1] 100
head(tabla_final$Hi_Desc,1)
## [1] 100
# Calcular sumatorias simples
suma_ni <- sum(tabla_final$ni)
suma_hi <- sum(tabla_final$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 [2.87,13.4) 15 0.60 15 0.6 2500 100
## 2 [13.4,23.8) 104 4.16 119 4.76 2485 99.4
## 3 [23.8,34.2) 294 11.76 413 16.52 2381 95.24
## 4 [34.2,44.5) 362 14.48 775 31 2087 83.48
## 5 [44.5,54.9) 338 13.52 1113 44.52 1725 69
## 6 [54.9,65.3) 175 7.00 1288 51.52 1387 55.48
## 7 [65.3,75.7) 282 11.28 1570 62.8 1212 48.48
## 8 [75.7,86.1) 168 6.72 1738 69.52 930 37.2
## 9 [86.1,96.5) 272 10.88 2010 80.4 762 30.48
## 10 [96.5,107) 0 0.00 2010 80.4 490 19.6
## 11 [107,117) 227 9.08 2237 89.48 490 19.6
## 12 [117,128) 125 5.00 2362 94.48 263 10.52
## 13 [128,138] 138 5.52 2500 100 138 5.52
## 14 TOTAL 2500 100.00 - - - -
# TABLA GT
TablaDisc <- tabla_final %>%
gt() %>%
tab_header(
title = md("*Tabla Nº. 1*"),
subtitle = md("**Tabla de distribución de la frecuencia de muestras por depósito en los yacimientos mineros (Sturges)**")
) %>%
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 la frecuencia de muestras por depósito en los yacimientos mineros (Sturges) |
| Intervalo |
ni |
hi |
Ni_Asc |
Hi_Asc |
Ni_Desc |
Hi_Desc |
| [2.87,13.4) |
15 |
0.60 |
15 |
0.6 |
2500 |
100 |
| [13.4,23.8) |
104 |
4.16 |
119 |
4.76 |
2485 |
99.4 |
| [23.8,34.2) |
294 |
11.76 |
413 |
16.52 |
2381 |
95.24 |
| [34.2,44.5) |
362 |
14.48 |
775 |
31 |
2087 |
83.48 |
| [44.5,54.9) |
338 |
13.52 |
1113 |
44.52 |
1725 |
69 |
| [54.9,65.3) |
175 |
7.00 |
1288 |
51.52 |
1387 |
55.48 |
| [65.3,75.7) |
282 |
11.28 |
1570 |
62.8 |
1212 |
48.48 |
| [75.7,86.1) |
168 |
6.72 |
1738 |
69.52 |
930 |
37.2 |
| [86.1,96.5) |
272 |
10.88 |
2010 |
80.4 |
762 |
30.48 |
| [96.5,107) |
0 |
0.00 |
2010 |
80.4 |
490 |
19.6 |
| [107,117) |
227 |
9.08 |
2237 |
89.48 |
490 |
19.6 |
| [117,128) |
125 |
5.00 |
2362 |
94.48 |
263 |
10.52 |
| [128,138] |
138 |
5.52 |
2500 |
100 |
138 |
5.52 |
| TOTAL |
2500 |
100.00 |
- |
- |
- |
- |
| Autor: Grupo 2 |
# Histograma de cantidad
hist(disc,
main="Grafica Nº1: Distribución de cantidad de la frecuencia de muestras por depósito",
col="gray",
ylab="Cantidad",
xlab = "Frecuencia de muestras por depósito",
breaks = n_intervalos,
cex.names = 0.6)
## Warning in plot.window(xlim, ylim, log, ...): "cex.names" is not a graphical
## parameter
## Warning in title(main = main, sub = sub, xlab = xlab, ylab = ylab, ...):
## "cex.names" is not a graphical parameter
## Warning in axis(1, ...): "cex.names" is not a graphical parameter
## Warning in axis(2, at = yt, ...): "cex.names" is not a graphical parameter
# Histograma de cantidad
hist(disc,
main="Grafica Nº2: Distribución de cantidad de la frecuencia de muestras por depósito",
col="gray",
xlab="Frecuencia de muestras por depósito",
ylab="Cantidad",
breaks = n_intervalos,
cex.names = 0.6,
ylim=c(0,800))
## Warning in plot.window(xlim, ylim, log, ...): "cex.names" is not a graphical
## parameter
## Warning in title(main = main, sub = sub, xlab = xlab, ylab = ylab, ...):
## "cex.names" is not a graphical parameter
## Warning in axis(1, ...): "cex.names" is not a graphical parameter
## Warning in axis(2, at = yt, ...): "cex.names" is not a graphical parameter
# Histograma de cantidad en porcentaje
# Las etiquetas X se adaptan dinámicamente al número de intervalos calculados
etiquetas_x <- seq_len(n_intervalos)
hi_plot <- tabla_final$hi[tabla_final$Intervalo != "TOTAL"]
barplot(hi_plot,
main = "Grafica Nº3: Distribución porcentual de la frecuencia de muestras por depósito",
col="gray",
space=0,
las=1,
xlab="Intervalos (Calculados por Sturges)",
ylab="Porcentaje",
names.arg = orden, # Muestra los intervalos reales dinámicos en el eje X
cex.names = 0.5)
# 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 porcentual de la frecuencia de muestras por depósito",
col = "gray",
las = 1,
xlab = "Intervalos (Calculados por Sturges)",
ylab = "Porcentaje",
names.arg = orden, # Muestra los intervalos reales dinámicos en el eje X
ylim = c(0,100),
cex.names = 0.5)
# Ojivas combinadas Ni
x_intervalos <- seq_len(n_intervalos)
plot(x = x_intervalos,
y = Ni_Asc,
type = "o",
col = "blue",
main = "Grafica Nº5: Ojiva combinada de la frecuencia de muestras por depósito\n(Ni)",
xlab = "Intervalos secuenciales",
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 de la frecuencia de muestras por depósito\n(Hi)",
xlab = "Intervalos secuenciales",
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 la frecuencia de muestras por depósito",
xlab = "Frecuencia de muestras por depósito")
# Ver los cuartiles
summary(disc)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 3.00 41.00 59.00 68.44 90.00 138.00
# Indicadores Estadisticos
# POSICION
#MEDIA ARITMETICA
x<-mean(disc)
x
## [1] 68.44
#MEDIANA ARITMETICA
ri<-min(disc)
rs<-max(disc)
Me<-median(disc)
Me
## [1] 59
# DISPERSION
#DESVIACIÓN ESTÁNDAR
sd<-sd(disc)
sd
## [1] 34.15405
#COEFICIENTE DE VARIACIÓN
CV <- ((sd / x) * 100)
CV
## [1] 49.90364
# FORMA
#COEFICIENTE DE ASIMETRÍA
As<-skewness(disc)
As
## [1] 0.487428
#COEFICIENTE DE CURTOSIS
K<-kurtosis(disc)
K
## [1] -0.8267864
# TABLA DE INDICADORES ESTADISTICOS
Variable<-c("Frecuencia de muestras por depósito")
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ísticos de la variable frecuencia de muestras por depósito"
)
Tabla N°3. Indicadores estadísticos de la variable frecuencia
de muestras por depósito
| Frecuencia de muestras por depósito |
3 |
138 |
68.44 |
59 |
34.15 |
49.9 |
0.49 |
-0.83 |
# OUTLIERS
outliers <- boxplot.stats(disc)$out
num_outliers <- length(outliers)
minoutliers<-min(outliers)
## Warning in min(outliers): no non-missing arguments to min; returning Inf
## [1] Inf
maxoutliers<-max(outliers)
## Warning in max(outliers): no non-missing arguments to max; returning -Inf
## [1] -Inf
TablaOutliers<-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 frecuencia de muestras por depósito"
)
Tabla N°4: Outliers de la variable frecuencia de muestras por
depósito
| 0 |
Inf |
-Inf |