Primeira parte Criação do dataset com os dados fornecidos, criação da função moda pois o R não possui função nativa para calcular a moda, após isos foi feito um resumo dos dados
lotes <- data.frame(
xi1 = c(7.100,7.100,7.120,7.115,7.090,7.110,7.105,7.100,7.065,7.125,
7.105,7.100,7.115,7.095,7.110,7.070,7.090,7.100,7.080,7.100,
7.095,7.105,7.100,7.100,7.120),
xi2 = c(7.095,7.100,7.105,7.120,7.095,7.100,7.095,7.115,7.090,7.130,
7.100,7.110,7.090,7.090,7.070,7.075,7.130,7.100,7.070,7.110,
7.105,7.070,7.100,7.105,7.115),
xi3 = c(7.100,7.095,7.100,7.115,7.110,7.105,7.100,7.095,7.110,7.095,
7.115,7.085,7.085,7.095,7.095,7.080,7.100,7.090,7.090,7.070,
7.095,7.110,7.105,7.105,7.110),
xi4 = c(7.105,7.105,7.120,7.115,7.120,7.100,7.105,7.105,7.105,7.100,
7.095,7.090,7.090,7.100,7.100,7.100,7.110,7.095,7.110,7.110,
7.095,7.110,7.110,7.110,7.130)
)
moda <- function(x) {
freq <- table(x)
max_freq <- max(freq)
if (max_freq == 1) return(NA)
as.numeric(names(freq)[freq == max_freq])
}
resumo <- data.frame(
Lote = names(lotes),
Media = sapply(lotes, mean),
Mediana = sapply(lotes, median),
Moda = sapply(lotes, function(x) paste(moda(x), collapse = "; ")),
Minimo = sapply(lotes, min),
Maximo = sapply(lotes, max),
Amplitude = sapply(lotes, function(x) max(x) - min(x)),
Variancia = sapply(lotes, var),
DesvioPad = sapply(lotes, sd),
CoefVar_pct = sapply(lotes, function(x) sd(x) / mean(x) * 100)
)
rownames(resumo) <- NULL
print(resumo, row.names = FALSE)## Lote Media Mediana Moda Minimo Maximo Amplitude Variancia DesvioPad
## xi1 7.1006 7.100 7.1 7.065 7.125 0.060 0.0002048333 0.014312000
## xi2 7.0994 7.100 7.1 7.070 7.130 0.060 0.0002756667 0.016603213
## xi3 7.0982 7.100 7.095 7.070 7.115 0.045 0.0001226667 0.011075498
## xi4 7.1054 7.105 7.11 7.090 7.130 0.040 0.0000915000 0.009565563
## CoefVar_pct
## 0.2015604
## 0.2338678
## 0.1560325
## 0.1346239Segunda parte Criação da tabela de frequência utilizando o metodo de sturges para a criação das classes
tabela_frequencia <- function(x, nome_lote) {
k <- ceiling(1 + 3.322 * log10(length(x)))
classes <- cut(x, breaks = k, include.lowest = TRUE, right = TRUE)
freq_abs <- table(classes)
freq_rel <- round(prop.table(freq_abs) * 100, 2)
freq_acum <- cumsum(freq_abs)
tab <- data.frame(
Classe = names(freq_abs),
Freq_Absoluta = as.integer(freq_abs),
Freq_Relativa = as.numeric(freq_rel),
Freq_Acumulada = as.integer(freq_acum)
)
cat("\n----- Tabela de frequencias:", nome_lote, "(k =", k, "classes) -----\n")
print(tab, row.names = FALSE)
tab
}
tabelas <- lapply(names(lotes), function(nome) tabela_frequencia(lotes[[nome]], nome))##
## ----- Tabela de frequencias: xi1 (k = 6 classes) -----
## Classe Freq_Absoluta Freq_Relativa Freq_Acumulada
## [7.065,7.075] 2 8 2
## (7.075,7.085] 1 4 3
## (7.085,7.095] 4 16 7
## (7.095,7.105] 11 44 18
## (7.105,7.115] 4 16 22
## (7.115,7.125] 3 12 25
##
## ----- Tabela de frequencias: xi2 (k = 6 classes) -----
## Classe Freq_Absoluta Freq_Relativa Freq_Acumulada
## [7.07,7.08] 4 16 4
## (7.08,7.09] 3 12 7
## (7.09,7.1] 8 32 15
## (7.1,7.11] 5 20 20
## (7.11,7.12] 3 12 23
## (7.12,7.13] 2 8 25
##
## ----- Tabela de frequencias: xi3 (k = 6 classes) -----
## Classe Freq_Absoluta Freq_Relativa Freq_Acumulada
## [7.07,7.078] 1 4 1
## (7.078,7.085] 3 12 4
## (7.085,7.093] 2 8 6
## (7.093,7.1] 10 40 16
## (7.1,7.107] 3 12 19
## (7.107,7.115] 6 24 25
##
## ----- Tabela de frequencias: xi4 (k = 6 classes) -----
## Classe Freq_Absoluta Freq_Relativa Freq_Acumulada
## [7.09,7.097] 5 20 5
## (7.097,7.103] 5 20 10
## (7.103,7.11] 5 20 15
## (7.11,7.117] 7 28 22
## (7.117,7.123] 2 8 24
## (7.123,7.13] 1 4 25names(tabelas) <- names(lotes)Diagrama de pareto Seção dedicada a criação do diagrama de pareto
diagrama_pareto <- function(tab, nome_lote, arquivo) {
tab_ord <- tab[order(-tab$Freq_Absoluta), ]
tab_ord$Perc_Acum <- cumsum(tab_ord$Freq_Absoluta) / sum(tab_ord$Freq_Absoluta) * 100
png(arquivo, width = 900, height = 650, res = 120)
par(mar = c(8, 4, 3, 4))
bp <- barplot(tab_ord$Freq_Absoluta,
names.arg = tab_ord$Classe,
las = 2,
col = "steelblue",
ylim = c(0, max(tab_ord$Freq_Absoluta) * 1.25),
ylab = "Frequencia absoluta",
main = paste("Diagrama de Pareto -", nome_lote))
par(new = TRUE)
plot(bp, tab_ord$Perc_Acum, type = "b", pch = 19, col = "firebrick",
axes = FALSE, xlab = "", ylab = "", ylim = c(0, 110))
axis(4, at = seq(0, 100, 20))
mtext("Percentual acumulado (%)", side = 4, line = 2.5)
abline(h = 80, col = "darkgray", lty = 2)
dev.off()
}
invisible(mapply(function(tab, nome) {
arquivo <- paste0("pareto_", nome, ".png")
diagrama_pareto(tab, nome, arquivo)
cat("Diagrama de Pareto salvo em:", arquivo, "\n")
}, tabelas, names(tabelas)))## Diagrama de Pareto salvo em: pareto_xi1.png## Diagrama de Pareto salvo em: pareto_xi2.png## Diagrama de Pareto salvo em: pareto_xi3.png## Diagrama de Pareto salvo em: pareto_xi4.png