Lista 1 - Controle Estatístico da qualidade
Arthur Machado; Willams Batista; Victor Viana
17/09/2019
Exercícios
Para os exercícios seguintes, usando o R e a função qcc:
• Construa gráficos de controle \(\bar x\) e \(\mathcal{S}\) (e/ou \(\bar x\) e \(\mathcal{R}\)) utilizando os dados da fase 1. Verifique se é razoável admitir que as amostras retratam um processo operando sob controle;
• Avalie a suposição de normalidade para os dados utilizados na determinação dos limites de controle;
• Acrescente aos gráficos os resultados da fase 2, quando disponíveis;
• Apresente suas conclusões na forma de um breve relatório.
Pacotes utilizados
library(qcc)
library(nortest)
library(readr)
library(readxl)Questão 4
Desvios das espessuras de moldes metálicos em relação a espessura nominal (determinada no projeto), verificados em 30 amostras de tamanho \(n = 6\). As primeiras \(m = 20\) amostras compõem a fase 1 do controle do processo, utilizadas na estimação dos parâmetros e determinação dos limites dos gráficos de controle. As demais amostras foram selecionadas para fins de monitoramento, compondo a segunda fase. Estamos salvando as quantidades importantes para alguns calculos e manipulando o banco de dados.
require(qcc)
c4 <- function(n) sqrt(2/(n - 1))*exp(lgamma(n/2)-lgamma((n-1)/2))
d2 <- qcc.options("exp.R.unscaled")
d3 <- qcc.options("se.R.unscaled")
dat <- read.table(file="dados_q4.txt", header=TRUE, sep= " ")
attach(dat)
s <- dat$s
r <- dat$r
esp <- cbind(x1,x2,x3,x4,x5,x6)Como podemos ver pelos gráficos abaixo de histograma e qqnorm que os dados aparentam seguir uma distribuição normal, apesar de desviar pela direita no gráfico do qqnorm. O boxplot geral conta com a presença de alguns possíveis outliers e o boxplot para cada variável temos que 50% das variáveis contém a presença de possíveis outliers. Pelos testes de normalidade podemos observar que quatro dos seis testes utilizados indicaram que não rejeitamos a hipótese que a distribuição é normal ao nível de 5% de significância, portanto seguiremos com essa conclusão e sem fazer alterações no banco de dados.
#---- Avaliando a normalidade
par(mfrow=c(2,2))
hist(c(esp), main="Histograma", col="grey")
boxplot(c(esp), main="Boxplot", col="grey")
qqnorm(c(esp), main="QQ-Plot")
qqline(c(esp), lty = 2, col = "red")
boxplot(esp, main="Boxplot", col="grey")
#--- Testes para normalidade
library(nortest)
t1 <- ks.test(esp, "pnorm", mean(esp), sd(esp)) # KS ## Warning in ks.test(esp, "pnorm", mean(esp), sd(esp)): ties should not be
## present for the Kolmogorov-Smirnov testt2 <- lillie.test(esp) # Lilliefors
t3 <- cvm.test(esp) # Cramér-von Mises
t4 <- shapiro.test(esp) # Shapiro-Wilk
t5 <- sf.test(esp) # Shapiro-Francia
t6 <- ad.test(esp) # Anderson-Darling
testes <- c(t1$method, t2$method, t3$method, t4$method, t5$method, t6$method)
estt <- as.numeric(c(t1$statistic, t2$statistic, t3$statistic, t4$statistic, t5$statistic, t6$statistic))
valorp <- c(t1$p.value, t2$p.value, t3$p.value, t4$p.value, t5$p.value, t6$p.value)
resultados <- cbind(estt, valorp)
rownames(resultados) <- testes
colnames(resultados) <- c("Estatística", "p")
print(resultados, digits = 4)## Estatística p
## One-sample Kolmogorov-Smirnov test 0.06061 0.5228898
## Lilliefors (Kolmogorov-Smirnov) normality test 0.06061 0.1094429
## Cramer-von Mises normality test 0.11965 0.0600470
## Shapiro-Wilk normality test 0.97166 0.0010016
## Shapiro-Francia normality test 0.96804 0.0006807
## Anderson-Darling normality test 0.80084 0.0374179Podemos ver pelos gráficos de controle de xbarra e R e do xbarra e S que houve uma pequena alteração nos limites superiores e inferiores relacionados a xbarra quando comparado feito com o ou com o , o que era esperado, dado que o é um melhor estimador para sigma. E quando comparamos os gráficos de e S observamos que a variação de é menor que a variação de , o que é uma boa caracteristica a se levar em consideração. Podemos ver também que não há nenhum indicativo de que o processo está fora de controle baseado nestes gráficos.
#Letra a, b e c
#---- Estimativas dos parâmetros
mu0 <- mean(media[1:20])
mu0_r <- mean(r[1:20])
mu0_s <- mean(s[1:20])
sig0_1 <- mu0_r/d2[6] # Baseado na amplitude
sig0_2 <- mu0_s/c4(6) # Baseado na variância amostral
#---- Limites Tentativos (FASE 1) x_bar e R
#----------------------------------------------
LIC_X = mu0 - 3*sig0_1/sqrt(6)
LC_X = mu0
LSC_X = mu0 + 3*sig0_1/sqrt(6)
LIC_X.b= mu0 - 2*sig0_1/sqrt(6)
LSC_X.b= mu0 + 2*sig0_1/sqrt(6)
LIC_X.a= mu0 - 1*sig0_1/sqrt(6)
LSC_X.a= mu0 + 1*sig0_1/sqrt(6)
LIC_R = mu0_r - 3*sig0_1*d3[6]
LC_R = mu0_r
LSC_R = mu0_r + 3*sig0_1*d3[6]
LIC_R.a = mu0_r - 1*sig0_1*d3[6]
LSC_R.a = mu0_r + 1*sig0_1*d3[6]
LIC_R.b = mu0_r - 2*sig0_1*d3[6]
LSC_R.b = mu0_r + 2*sig0_1*d3[6]
par(mfrow=c(1,2))
plot(media[1:20], type="b", ylim = c(-0.08, 0.12), xlab="Amostra",ylab="Média",main="Gráfico de Shewhart")
abline(h=LIC_X,col="red")
abline(h=LC_X, lty=2)
abline(h=LSC_X,col="red")
abline(h=LIC_X.a,col="violet")
abline(h=LSC_X.a,col="violet")
abline(h=LIC_X.b,col="orange")
abline(h=LSC_X.b,col="orange")
legend(0,0.12, c("LSC = 0.06324", "LC = -0.00264", "LIC = -0.06852","mu = -0.00264"),bty="n",cex=0.75)
plot(r[1:20], type="b", ylim = c(0, 0.45), xlab="Amostra",ylab="R",main="Gráfico de Shewhart")
abline(h=LIC_R,col="red")
abline(h=LC_R, lty=2)
abline(h=LSC_R,col="red")
abline(h=LIC_R.a,col="violet")
abline(h=LSC_R.a,col="violet")
abline(h=LIC_R.b,col="orange")
abline(h=LSC_R.b,col="orange")
legend(0,0.45, c("LSC = 0.27314","LC = 0.13630","LIC = -0.00054","Sigma = 0.05379"),bty="n",cex=0.75)
#---- Limites Tentativos (FASE 1) x_bar e s
#-----------------------------------------------
LIC_X = mu0 - 3*sig0_2/sqrt(6)
LC_X = mu0
LSC_X = mu0 + 3*sig0_2/sqrt(6)
LIC_X.b= mu0 - 2*sig0_2/sqrt(6)
LSC_X.b= mu0 + 2*sig0_2/sqrt(6)
LIC_X.a= mu0 - 1*sig0_2/sqrt(6)
LSC_X.a= mu0 + 1*sig0_2/sqrt(6)
LIC_S = mu0_s - 3*sig0_2*sqrt(1-c4(6)^2)
LC_S = mu0_s
LSC_S = mu0_s + 3*sig0_2*sqrt(1-c4(6)^2)
LIC_S.a = mu0_s - 1*sig0_2*sqrt(1-c4(6)^2)
LSC_S.a = mu0_s + 1*sig0_2*sqrt(1-c4(6)^2)
LIC_S.b = mu0_s - 2*sig0_2*sqrt(1-c4(6)^2)
LSC_S.b = mu0_s + 2*sig0_2*sqrt(1-c4(6)^2)
par(mfrow=c(1,2))
plot(media[1:20], type="b", ylim = c(-0.08, 0.12), xlab="Amostra",ylab="Média",main="Gráfico de Shewhart")
abline(h=LIC_X,col="red")
abline(h=LC_X, lty=2)
abline(h=LSC_X,col="red")
abline(h=LIC_X.a,col="violet")
abline(h=LSC_X.a,col="violet")
abline(h=LIC_X.b,col="orange")
abline(h=LSC_X.b,col="orange")
legend(0,0.12, c("LSC = 0.06183", "LC = -0.00264", "LIC = -0.06711","mu = -0.00264"),bty="n",cex=0.75)
plot(s[1:20], type="b", ylim = c(0, 0.2), xlab="Amostra",ylab="S",main="Gráfico de Shewhart")
abline(h=LIC_S,col="red")
abline(h=LC_S, lty=2)
abline(h=LSC_S,col="red")
abline(h=LIC_S.a,col="violet")
abline(h=LSC_S.a,col="violet")
abline(h=LIC_S.b,col="orange")
abline(h=LSC_S.b,col="orange")
legend(0,0.2, c("LSC = 0.09866","LC = 0.05009","LIC = 0.00152","Sigma = 0.05264"),bty="n",cex=0.75)
Para a fase 2 do processo podemos observar que o processo saiu do controle nas últimas observações o que pela regra sensibilizante do pacote qcc pode ter alertado previamente o usuário e depois disso o processo saiu de controle e foi detectado pelo gráfico. Teriamos que investigar o que houve neste intervalo de tempo para que tenha ocasionado isto e solucionar o problema. Este comportamento foi detectado previamente nos gráficos de controle da variância tanto pra quanto para e podia ser um alerta para o que aconteceria em xbarra. Podemos ver que as curvas de operação para o estimador são ligeiramente melhores, principalmente em grandes amostras, quando comparado com o estimador ; porém vemos que todos não conseguem detectar bem uma oscilação pequena no desvio padrão.
#Letra d, e
#---- Fase 2 xbar e R
par(mfrow=c(1,2))
plot(media, type="b", ylim = c(-0.08, 0.12), xlab="Amostra",ylab="Média",main="Gráfico de Shewhart")
abline(h=LIC_X,col="red")
abline(h=LC_X, lty=2)
abline(h=LSC_X,col="red")
abline(h=LIC_X.a,col="violet")
abline(h=LSC_X.a,col="violet")
abline(h=LIC_X.b,col="orange")
abline(h=LSC_X.b,col="orange")
abline(v=20.5,lty=2)
legend(0,0.12, c("LSC = 0.06324", "LC = -0.00264", "LIC = -0.06852","mu = -0.00264"),bty="n",cex=0.75)
plot(r, type="b", ylim = c(0, 0.45), xlab="Amostra",ylab="R",main="Gráfico de Shewhart")
abline(h=LIC_R,col="red")
abline(h=LC_R, lty=2)
abline(h=LSC_R,col="red")
abline(h=LIC_R.a,col="violet")
abline(h=LSC_R.a,col="violet")
abline(h=LIC_R.b,col="orange")
abline(h=LSC_R.b,col="orange")
legend(0,0.45, c("LSC = 0.27314","LC = 0.13630","LIC = -0.00054","Sigma = 0.05379"),bty="n",cex=0.75)
abline(v=20.5,lty=2)
qcc(esp[1:20,], type="xbar", newdata=esp[21:30,])
## List of 15
## $ call : language qcc(data = esp[1:20, ], type = "xbar", newdata = esp[21:30, ])
## $ type : chr "xbar"
## $ data.name : chr "esp[1:20, ]"
## $ data : num [1:20, 1:6] -0.032 -0.001 0.002 -0.016 0.017 -0.069 0.048 0.031 0.006 0.012 ...
## ..- attr(*, "dimnames")=List of 2
## $ statistics : Named num [1:20] 0.0143 0.0183 -0.0278 0.0112 -0.004 ...
## ..- attr(*, "names")= chr [1:20] "1" "2" "3" "4" ...
## $ sizes : int [1:20] 6 6 6 6 6 6 6 6 6 6 ...
## $ center : num -0.00264
## $ std.dev : num 0.0538
## $ newstats : Named num [1:10] -0.042 0.02233 -0.01033 -0.00483 0.0025 ...
## ..- attr(*, "names")= chr [1:10] "21" "22" "23" "24" ...
## $ newdata : num [1:10, 1:6] -0.078 -0.013 -0.111 -0.002 -0.033 0.019 0.083 -0.037 0.232 0.139 ...
## ..- attr(*, "dimnames")=List of 2
## $ newsizes : int [1:10] 6 6 6 6 6 6 6 6 6 6
## $ newdata.name: chr "esp[21:30, ]"
## $ nsigmas : num 3
## $ limits : num [1, 1:2] -0.0685 0.0632
## ..- attr(*, "dimnames")=List of 2
## $ violations :List of 2
## - attr(*, "class")= chr "qcc"qcc(esp[1:20,], type="R", newdata=esp[21:30,])
## List of 15
## $ call : language qcc(data = esp[1:20, ], type = "R", newdata = esp[21:30, ])
## $ type : chr "R"
## $ data.name : chr "esp[1:20, ]"
## $ data : num [1:20, 1:6] -0.032 -0.001 0.002 -0.016 0.017 -0.069 0.048 0.031 0.006 0.012 ...
## ..- attr(*, "dimnames")=List of 2
## $ statistics : Named num [1:20] 0.119 0.114 0.156 0.167 0.158 0.128 0.215 0.102 0.198 0.148 ...
## ..- attr(*, "names")= chr [1:20] "1" "2" "3" "4" ...
## $ sizes : int [1:20] 6 6 6 6 6 6 6 6 6 6 ...
## $ center : num 0.136
## $ std.dev : num 0.0538
## $ newstats : Named num [1:10] 0.087 0.168 0.152 0.157 0.23 0.215 0.227 0.215 0.413 0.11
## ..- attr(*, "names")= chr [1:10] "21" "22" "23" "24" ...
## $ newdata : num [1:10, 1:6] -0.078 -0.013 -0.111 -0.002 -0.033 0.019 0.083 -0.037 0.232 0.139 ...
## ..- attr(*, "dimnames")=List of 2
## $ newsizes : int [1:10] 6 6 6 6 6 6 6 6 6 6
## $ newdata.name: chr "esp[21:30, ]"
## $ nsigmas : num 3
## $ limits : num [1, 1:2] 0 0.273
## ..- attr(*, "dimnames")=List of 2
## $ violations :List of 2
## - attr(*, "class")= chr "qcc"#---- Fase 2 xbar e S
par(mfrow=c(1,2))
plot(media, type="b", ylim = c(-0.08, 0.12), xlab="Amostra",ylab="Média",main="Gráfico de Shewhart")
abline(h=LIC_X,col="red")
abline(h=LC_X, lty=2)
abline(h=LSC_X,col="red")
abline(h=LIC_X.a,col="violet")
abline(h=LSC_X.a,col="violet")
abline(h=LIC_X.b,col="orange")
abline(h=LSC_X.b,col="orange")
abline(v=20.5,lty=2)
legend(0,0.12, c("LSC = 0.06324", "LC = -0.00264", "LIC = -0.06852","mu = -0.00264"),bty="n",cex=0.75)
plot(s, type="b", ylim = c(0, 0.17), xlab="Amostra",ylab="S",main="Gráfico de Shewhart")
abline(h=LIC_S,col="red")
abline(h=LC_S, lty=2)
abline(h=LSC_S,col="red")
abline(h=LIC_S.a,col="violet")
abline(h=LSC_S.a,col="violet")
abline(h=LIC_S.b,col="orange")
abline(h=LSC_S.b,col="orange")
legend(0,0.17, c("LSC = 0.09866","LC = 0.05009","LIC = 0.00152","Sigma = 0.05264"),bty="n",cex=0.75)
abline(v=20.5,lty=2)
qcc(esp[1:20,], type="xbar", newdata=esp[21:30,],std.dev = "MVLUE-SD")
## List of 15
## $ call : language qcc(data = esp[1:20, ], type = "xbar", std.dev = "MVLUE-SD", newdata = esp[21:30, ])
## $ type : chr "xbar"
## $ data.name : chr "esp[1:20, ]"
## $ data : num [1:20, 1:6] -0.032 -0.001 0.002 -0.016 0.017 -0.069 0.048 0.031 0.006 0.012 ...
## ..- attr(*, "dimnames")=List of 2
## $ statistics : Named num [1:20] 0.0143 0.0183 -0.0278 0.0112 -0.004 ...
## ..- attr(*, "names")= chr [1:20] "1" "2" "3" "4" ...
## $ sizes : int [1:20] 6 6 6 6 6 6 6 6 6 6 ...
## $ center : num -0.00264
## $ std.dev : num 0.0526
## $ newstats : Named num [1:10] -0.042 0.02233 -0.01033 -0.00483 0.0025 ...
## ..- attr(*, "names")= chr [1:10] "21" "22" "23" "24" ...
## $ newdata : num [1:10, 1:6] -0.078 -0.013 -0.111 -0.002 -0.033 0.019 0.083 -0.037 0.232 0.139 ...
## ..- attr(*, "dimnames")=List of 2
## $ newsizes : int [1:10] 6 6 6 6 6 6 6 6 6 6
## $ newdata.name: chr "esp[21:30, ]"
## $ nsigmas : num 3
## $ limits : num [1, 1:2] -0.0671 0.0618
## ..- attr(*, "dimnames")=List of 2
## $ violations :List of 2
## - attr(*, "class")= chr "qcc"qcc(esp[1:20,], type="S", newdata=esp[21:30,])
## List of 15
## $ call : language qcc(data = esp[1:20, ], type = "S", newdata = esp[21:30, ])
## $ type : chr "S"
## $ data.name : chr "esp[1:20, ]"
## $ data : num [1:20, 1:6] -0.032 -0.001 0.002 -0.016 0.017 -0.069 0.048 0.031 0.006 0.012 ...
## ..- attr(*, "dimnames")=List of 2
## $ statistics : Named num [1:20] 0.0441 0.0374 0.0538 0.0612 0.0557 ...
## ..- attr(*, "names")= chr [1:20] "1" "2" "3" "4" ...
## $ sizes : int [1:20] 6 6 6 6 6 6 6 6 6 6 ...
## $ center : num 0.0501
## $ std.dev : num 0.0526
## $ newstats : Named num [1:10] 0.0301 0.0637 0.0568 0.0565 0.0818 ...
## ..- attr(*, "names")= chr [1:10] "21" "22" "23" "24" ...
## $ newdata : num [1:10, 1:6] -0.078 -0.013 -0.111 -0.002 -0.033 0.019 0.083 -0.037 0.232 0.139 ...
## ..- attr(*, "dimnames")=List of 2
## $ newsizes : int [1:10] 6 6 6 6 6 6 6 6 6 6
## $ newdata.name: chr "esp[21:30, ]"
## $ nsigmas : num 3
## $ limits : num [1, 1:2] 0.00152 0.09866
## ..- attr(*, "dimnames")=List of 2
## $ violations :List of 2
## - attr(*, "class")= chr "qcc"#---------------------------#
#-- Curevas de Operação --#
#---------------------------#
oc.curves.xbar(qcc(esp, type="xbar", nsigmas=3, plot=FALSE))
oc.curves.R(qcc(esp, type="R", nsigmas=3, plot=FALSE))
oc.curves.S(qcc(esp, type="S", nsigmas=3, plot=FALSE))
Questão 5
Uma camada de fio isolante é depositada sobre um substrato usando uma máquina. A característica da qualidade é a espessura da camada de fio (em Angstroms). Na página da disciplina estão disponíveis dados de \(m = 20\) amostras referentes à fase 1 e 10 amostras adicionais para monitoramento (todas com tamanho \(n = 4\)).
#Leitura dos bancos da dados
isoF1 <- read.csv2("IsolanteF1.csv")
attach(isoF1)## The following object is masked from dat:
##
## AmostraisoF1Wide <- qcc.groups(data = Espessura, sample = Amostra)Após ler o banco de dados, algumas suposições precisam ser verificadas, tal que, a análise do processo seja feita de forma coerente. Com isso, precisamos verificar a suposição de normalidade dos dados. Essa verificação pode ser feita tanto vizualmente atráves de gráficos ou por meio de testes estatísticos.
#Avaliando normalidade dos dados
# Gráficamente
par(mfrow=c(2,2))
hist(Espessura, main="Histograma", col="grey")
boxplot(Espessura, main="Boxplot", col="grey")
qqnorm(Espessura, main="QQ-Plot")
qqline(Espessura, lty = 2, col = "red")
plot(density(Espessura),main="Density-Plot")
Podemos observar pela tabela abaixo, que todos os testes, por unanimidade, apontaram características de normalidade da variável Espessura do fio isolante
t1 <- ks.test(Espessura, "pnorm", mean(Espessura), sd(Espessura)) # KS
t2 <- lillie.test(Espessura) # Lilliefors
t3 <- cvm.test(Espessura) # Cramér-von Mises
t4 <- shapiro.test(Espessura) # Shapiro-Wilk
t5 <- sf.test(Espessura) # Shapiro-Francia
t6 <- ad.test(Espessura) # Anderson-Darling
# Tabela de resultados
testes <- c(t1$method, t2$method, t3$method, t4$method, t5$method, t6$method)
estt <- as.numeric(c(t1$statistic, t2$statistic, t3$statistic, t4$statistic, t5$statistic, t6$statistic))
valorp <- c(t1$p.value, t2$p.value, t3$p.value, t4$p.value, t5$p.value, t6$p.value)
resultados <- cbind(estt, valorp)
rownames(resultados) <- testes
colnames(resultados) <- c("Estatística", "p")
print(resultados, digits = 4)## Estatística p
## One-sample Kolmogorov-Smirnov test 0.06368 0.9018
## Lilliefors (Kolmogorov-Smirnov) normality test 0.06368 0.5862
## Cramer-von Mises normality test 0.04572 0.5727
## Shapiro-Wilk normality test 0.99042 0.8208
## Shapiro-Francia normality test 0.98983 0.6937
## Anderson-Darling normality test 0.26915 0.6719Prosseguindo com a análise, utilizando os códigos abaixo atráves do pacote qcc, é obtido os pricipais gráficos de controle do processo.
#Gráfico Xbar
Espessura <- qcc.groups(Espessura, Amostra)
fase1_xbar <- qcc(Espessura, type="xbar", nsigmas=3, plot=TRUE)
Podemos observar pela figura acima, que ao longo das 20 amostras formadas, apenas uma saiu de controle, sendo a amostra de número 18, saindo da região de confiança.
#Gráfico R
fase1_r <- qcc(Espessura, type="R", nsigmas=3, plot=TRUE)
Como visto anterioremente, notamos que no gráfico de controle \(\bar x\) mostrou que o processo saiu de controle em determinada amostra. Já no gráfico \(\mathcal{R}\), ambas as 20 amostras permanecem nos limites de controle, porém, vale salientar que houve uma dispersão considerável, devido os valores de \(\mathcal{R}\) alterarem significativamente ao longo das amostras. Outra observação, que favorece a saída do controle do processo, é em alguns pontos que apresentam tendência nas medições de cada amostra, por exemplo da amostra 14 até a 17 houve uma tendência negativa, porém, esse motivo ainda não é suficiente
Outra alternativa semelhante ao gráfico anterior, é de observar o gráfico de controle \(\mathcal{S}\), no qual, teve-se a mesma conclusão que a figura anterior, não apresentando uma dispersão fora dos padrões de controle.
#Gráfico S
fase1_s <- qcc(Espessura, type="S", nsigmas=3, plot=TRUE)
Outra opção é de retirar a amostra de número 18, afim de estudar novamente o gráfico \(\bar x\), verificando se houve alguma observação fora de controle.
#Retirada da amostra de número 18
inc <- Espessura[-18,]
q1 <- qcc(inc, type="xbar", nsigmas=3, plot=TRUE)
Podemos observar que agora não houve nenhuma amostra fora de controle.
Para a solução desse problema, uma das coisas a ser fazer é de rever o modo de produção do produto em análise. Sendo assim, após a revisão de todos os processos de produção, é feito uma segunda parte do banco de dados, chamada de de fase 2, que é nada mais nada menos que a mesma variável em estudo só que após uma série de revisões impostas pelo profissional. O objetivo dessa fase 2, é de verificar se as mudanças impostas na linha de produção, foram realmente efetivas afim de deixar o processo sob controle.
#Leitura do banco da dados da fase2
isoF2 <- read.csv2("IsolanteF2.csv")
attach(isoF2)
Espessura2<-qcc.groups(isoF2$Espessura, Amostra)
#Gráfico de controle xbarra
q <- qcc(Espessura, type="xbar", newdata=Espessura2,nsigmas=3 ,plot=TRUE)
Pelo gráfico de controle \(\bar x\) podemos dizer que o processo na fase2, após a calibragem, houve uma melhora, sem nenhum ponto fora dos limites de controle 3\(\sigma\).
Questão 6
Peças fabricadas por processo de moldagem por injeção são submetidas a um ensaio de resistência à compressão. Vinte amostras de cinco partes cada são coletadas e as resistência à compressão (em psi) são registradas. Adicionalmente, quinze amostras são selecionadas na segunda fase, para monitoramento do processo.
#Leitura dos bancos da dados
BD_Compressao <- read_delim("BD - Compressao.txt",
"\t", escape_double = FALSE, trim_ws = TRUE)
attach(BD_Compressao)
BD_F1 <- qcc.groups(data = Forca, sample = Sample)Gráficamente, podemos observar que no boxplot apresenta a presença de outliers, ou seja, peças que tiveram uma alta e baixa resistência em relação à outras peças, sendo provavelmente peças fora dos limites de especificação. No histograma, podemos notar uma certa simetria e pelo gráfico da densidade também se assemelha à distribuição normal.
#Avaliando normalidade dos dados
# Gráficamente
par(mfrow=c(2,2))
hist(Forca, main="Histograma", col="grey")
boxplot(Forca, main="Boxplot", col="grey")
qqnorm(Forca, main="QQ-Plot")
qqline(Forca, lty = 2, col = "red")
plot(density(Forca),main="Density-Plot")
Podemos observar pela tabela abaixo, que nem todos os testes apontaram características de normalidade da variável resistência à compressão (Forca), no qual a um nível de \(\alpha = 0.05\) de significância, apenas os testes Shapiro-Francia e Anderson-Darling rejeitaram a hipótese de normalidade dos dados.
t1 <- ks.test(Forca, "pnorm", mean(Forca), sd(Forca)) # KS
t2 <- lillie.test(Forca) # Lilliefors
t3 <- cvm.test(Forca) # Cramér-von Mises
t4 <- shapiro.test(Forca) # Shapiro-Wilk
t5 <- sf.test(Forca) # Shapiro-Francia
t6 <- ad.test(Forca) # Anderson-Darling
# Tabela de resultados
testes <- c(t1$method, t2$method, t3$method, t4$method, t5$method, t6$method)
estt <- as.numeric(c(t1$statistic, t2$statistic, t3$statistic, t4$statistic, t5$statistic, t6$statistic))
valorp <- c(t1$p.value, t2$p.value, t3$p.value, t4$p.value, t5$p.value, t6$p.value)
resultados <- cbind(estt, valorp)
rownames(resultados) <- testes
colnames(resultados) <- c("Estatística", "p")
print(resultados, digits = 4)## Estatística p
## One-sample Kolmogorov-Smirnov test 0.08079 0.203473
## Lilliefors (Kolmogorov-Smirnov) normality test 0.08079 0.007295
## Cramer-von Mises normality test 0.19988 0.005315
## Shapiro-Wilk normality test 0.97781 0.006748
## Shapiro-Francia normality test 0.97483 0.003926
## Anderson-Darling normality test 1.22072 0.003421Prosseguindo com a análise, utilizando os códigos abaixo atráves do pacote qcc, é obtido os pricipais gráficos de controle do processo.
#Gráfico Xbar
resist <- qcc.groups(Forca, Sample)
fase1_xbar <- qcc(resist, type="xbar", nsigmas=3, plot=TRUE)
Podemos observar pela figura acima, que ao longo das 35 amostras, o processo apresenta-se sob controle, no qual nenhuma observação ficou fora do limites de especificação. Vale ressaltar que a partir da observação de número 22, o comportamento dos dados teve uma variada, alternando entre valores positivos e negativos, porém, nada a se preocupar.
#Gráfico R
fase1_r <- qcc(resist, type="R", nsigmas=3, plot=TRUE)
Em relação ao gráfico acima, podemos dizer que a dispersão do processo está fora de controle, no qual, as amostras de número 13 e 14 estão sob observação, indicando que, por regras sensibilizantes, essas observações estão sob alerta . No pior caso, as observações de número 27 e 33 sairam de controle.
Outra alternativa de inverstigar a dispersão, é usando o gráfico \(\mathcal{S}\), no qual ele tem como o mesmo objetivo do gráafico \(\mathcal{R}\)
#Gráfico S
fase1_s <- qcc(resist, type="S", nsigmas=3, plot=TRUE)
Questão 7
A uniformidade de uma pastilha de silício após reação química é determinada pela medição da espessura em várias posições, expressando a uniformidade como a amplitude das espessuras.
#PARTE 1
pastilhas <- read.csv2("BD-Pastilha1.csv")
media <- mean(pastilhas$Espessura)
desvio <- sd(pastilhas$Espessura)
LIC <- media - 3*desvio #LIC 3 sigma
LSC <- media + 3*desvio #LSC 3 sigma
LIC2 <- media - 2*desvio #LIC 2 sigma
LSC2 <- media + 2*desvio #LSC 2 sigma
LC <- media #LC
shapiro.test(pastilhas$Espessura) #Os dados possuem dist. normal
hist(pastilhas$Espessura)
plot(pastilhas$Espessura, type = "b", main = "Gráfico de controle: Espessura - Parte 1", ylim = c(30,70))
abline(h=36.24, lty=2, col = "blue")
abline(h=63.45, lty=2, col = "blue")
abline(h=40.79, lty=3, col = "red")
abline(h=58.91, lty=3, col = "red")
abline(h=49.85,lty=1)
#CONCLUSÃO: De acordo com as regras de sensibilidade, o gráfico de controle nos sugere que
#a situação está sob controle.
#PARTE 2
pastilhas2 <- read.csv2('BD-Pastilha2.csv')
bd2 <- merge(pastilhas,pastilhas2, all = TRUE) #Juntando os dois bancos
media2 <- mean(bd2$Espessura)
desvio2 <- sd(bd2$Espessura)
LIC_new <- media2 - 3*desvio2 # LIC 3 sigma
LSC_new <- media2 + 3*desvio2 #LSC 3 sigma
LIC2_new <- media2 - 2*desvio2 #LIC 2 sigma
LSC2_new <- media2 + 2*desvio2 #LSC 2 sigma
LC2 <- media2 #LC
shapiro.test(bd2$Espessura) #Os dados possuem dist. normal
hist(bd2$Espessura)
plot(bd2$Espessura, type = "b", main = "Gráfico de controle: Espessura - Parte 2", ylim = c(30,75))
abline(h=33.29, lty=2, col = "blue")
abline(h=71.48, lty=2, col = "blue")
abline(h=39.66, lty=3, col = "red")
abline(h=65.12, lty=3, col = "red")
abline(h=52.39,lty=1)
#CONCLUSÃO: De acordo com as regras de sensibilidade, aparentemente o 2º gráfico de controle nos sugere
#que a situação está sob controle, apesar de 2 pontos romperem a linha 2 sigma.Vale destacar
#que após o acréscimo de 10 pontos no gráfico, ocorreu um aumento na média do processo de 49.84
#para 52.06, caso esse perfil se mantenha, o processo ficar? fora de controle rapidamente.
#Outro ponto que é perceptível é de na parte final do gráfico ocorrer uma tendência de não
#aleatoriedade do processo.
#PARTE 3
pastilhas3 <- read.csv2('BD-Pastilha3.csv')
bd3 <- merge(bd2,pastilhas3, all = TRUE) #Juntando os dois bancos
media3 <- mean(bd3$Espessura)
desvio3 <- sd(bd3$Espessura)
LIC_new <- media3 - 3*desvio3 # LIC 3 sigma
LSC_new <- media3 + 3*desvio3 #LSC 3 sigma
LIC2_new <- media3 - 2*desvio3 #LIC 2 sigma
LSC2_new <- media3 + 2*desvio3 #LSC 2 sigma
LC3 <- media3 #LC
shapiro.test(bd3$Espessura) #Os dados não possuem dist. normal
bd3_new <- ((bd3$Espessura^(-1))-1)/-1 #Transformando numa normal
shapiro.test(bd3_new) #Agora os dados possuem dist. normal
media3 <- mean(bd3_new)
desvio3 <- sd(bd3_new)
LIC_new <- media3 - 3*desvio3 # LIC 3 sigma
LSC_new <- media3 + 3*desvio3 #LSC 3 sigma
LIC2_new <- media3 - 2*desvio3 #LIC 2 sigma
LSC2_new <- media3 + 2*desvio3 #LSC 2 sigma
LC3 <- media3 #LC
plot(bd3_new, type = "b", main = "Gráfico de controle: Espessura - Parte 3", ylim = c(0.97,0.99))
abline(h=0.974, lty=2, col = "blue")
abline(h=0.987, lty=2, col = "blue")
abline(h=0.976, lty=3, col = "red")
abline(h=0.985, lty=3, col = "red")
abline(h=0.98,lty=1)
#CONCLUSÃO: De acordo com as regras de sensibilidade, o gráfico está sob controle, porém,
#2 pontos ultrapassaram os limites para 2 sigma, sendo que eles se situam distantes um do outro.
#No final do processo, é perceptível uma tendência decrescente no processo o que pode acarretar
#futuramente em uma situação do processo fora de controle.Questão 8
Considere a construção de gráficos de controle para a resistência à tração de cabos de aço. A fase 1 foi planejada para 𝑚 = 15 amostras de tamanho 𝑛 = 6. No entanto, em cinco delas apenas 𝑛 = 5 cabos estavam disponíveis. Par a segunda fase, tendo em vista a dificuldade em atender o tamanho da amostra inicialmente planejado, optouse por fixar 𝑛 = 4. A variável analisada foi a carga de ruptura (em kg/mm2). As últimas 10 amostra correspondem à fase 2.
## Quantidades importantes
require(qcc)
require(nortest)
c4 <- function(n) sqrt(2/(n - 1))*exp(lgamma(n/2)-lgamma((n-1)/2))
d2 = qcc.options("exp.R.unscaled")# Lendo o banco de dados
dataset <- c(203,204,194,202,199,198,201,199,200,198,203,199,200,201,197,194,199,213,207,200,182,198,189,192,205)
Si <- c(8.5,7.5,10.89,12.06,12.34,9.09,16.88,8.87,13.48,11.23,5.1,7.89,7.61,4.85,5.5,14.57,16.34,10.07,15.31,14.75,4.51,13.63,15.71,10.54,12.09)
ni <- c(6,6,6,6,5,6,6,5,6,5,6,5,6,5,6,4,4,4,4,4,4,4,4,4,4)Checando a normalidade dos dados vemos que a distribuição dos dados aparenta ser simétrica e com presença de alguns outliers, porém a questão da normalidade apenas pelos gráficos não é tão explicita. Quando fizemos os testes de aderência a distribuição normal podemos perceber que metade dos testes feitos foram adequados a suposição de normalidade com p-valor relativamente favorável, então podemos assumir que a distribuição é normal.
par(mfrow=c(2,2))
hist(dataset, main="Histograma", col="grey")
boxplot(dataset, main="Boxplot", col="grey")
qqnorm(dataset, main="QQ-Plot")
qqline(dataset, lty = 2, col = "red")
plot(density(dataset),main="Density-Plot")
t1 <- ks.test(dataset, "pnorm", mean(dataset), sd(dataset)) # KS
t2 <- lillie.test(dataset) # Lilliefors
t3 <- cvm.test(dataset) # Cramér-von Mises
t4 <- shapiro.test(dataset) # Shapiro-Wilk
t5 <- sf.test(dataset) # Shapiro-Francia
t6 <- ad.test(dataset) # Anderson-Darling
# Tabela de resultados
testes <- c(t1$method, t2$method, t3$method, t4$method, t5$method, t6$method)
estt <- as.numeric(c(t1$statistic, t2$statistic, t3$statistic, t4$statistic, t5$statistic, t6$statistic))
valorp <- c(t1$p.value, t2$p.value, t3$p.value, t4$p.value, t5$p.value, t6$p.value)
resultados <- cbind(estt, valorp)
rownames(resultados) <- testes
colnames(resultados) <- c("Estatística", "p")
print(resultados, digits = 4)## Estatística p
## One-sample Kolmogorov-Smirnov test 0.1887 0.33534
## Lilliefors (Kolmogorov-Smirnov) normality test 0.1887 0.02195
## Cramer-von Mises normality test 0.1328 0.03719
## Shapiro-Wilk normality test 0.9370 0.12595
## Shapiro-Francia normality test 0.9168 0.04382
## Anderson-Darling normality test 0.7140 0.05450## Letra a)
xbar <- sum((dataset[1:15]*ni[1:15])/sum(ni[1:15])); xbar## [1] 199.9059sbar <- sqrt((sum((ni[1:15]-1)*(Si[1:15])^2))/(sum(ni[1:15])-15)); sbar## [1] 10.03655estimatesigma <- sbar/c4(6); estimatesigma## [1] 10.54777Vemos que a média estimada, com valores de n diferentes para cada amostra, do processo é de 199.9kg/mm^2 e também o desvio padrão estimado é de 10.55. Foi utilizado para ambos as estimações levando em consideração a variação do tamanho da amostra. O banco de dados contém 15 observações entre a primeira fase do processo e 10 observações para a segunda fase do processo.
## Letra b)
## Iremos utilizar os limites de controle 3sigma para este problema. Os limites de controle para xbarra é dado por:
LSCX <- xbar + (3/sqrt(ni[1:15]))*estimatesigma; LSCX## [1] 212.8242 212.8242 212.8242 212.8242 214.0572 212.8242 212.8242
## [8] 214.0572 212.8242 214.0572 212.8242 214.0572 212.8242 214.0572
## [15] 212.8242LICX <- xbar - (3/sqrt(ni[1:15]))*estimatesigma; LICX## [1] 186.9876 186.9876 186.9876 186.9876 185.7546 186.9876 186.9876
## [8] 185.7546 186.9876 185.7546 186.9876 185.7546 186.9876 185.7546
## [15] 186.9876## Os limites de controle para S é dado por:
LSCS <- sbar + (3/(sqrt(ni[1:15])))*estimatesigma; LSCX## [1] 212.8242 212.8242 212.8242 212.8242 214.0572 212.8242 212.8242
## [8] 214.0572 212.8242 214.0572 212.8242 214.0572 212.8242 214.0572
## [15] 212.8242LICS <- sbar - (3/(sqrt(ni[1:15])))*estimatesigma; LICX## [1] 186.9876 186.9876 186.9876 186.9876 185.7546 186.9876 186.9876
## [8] 185.7546 186.9876 185.7546 186.9876 185.7546 186.9876 185.7546
## [15] 186.9876Temos que os limites de superior e inferior de controle são dados por LSCX e LICX, respectivamente . Então temos os limites superiores dados por LSCS e os inferiores dados por LICS são menores que zero, portanto, temos que um gráfico de controle de s é limitado inferiormente por 0 e superiormente por LSCS, que é variado. Para os gráficos de controle temos que o processo está sob controle de acordo com os gráficos de controle visto abaixo para a média do processo e o desvio padrão. Ambos, o gráfico para x barra e para S, aparentam estar dispostos de forma aleatória nos gráficos.
## List of 11
## $ call : language qcc(data = resistencia, type = "xbar", nsigmas = 3, plot = TRUE)
## $ type : chr "xbar"
## $ data.name : chr "resistencia"
## $ data : num [1:15, 1:6] 194 200 200 197 203 186 210 206 201 202 ...
## ..- attr(*, "dimnames")=List of 2
## $ statistics: Named num [1:15] 203 204 194 202 199 ...
## ..- attr(*, "names")= chr [1:15] "1" "2" "3" "4" ...
## $ sizes : Named int [1:15] 6 6 6 6 5 6 6 5 6 5 ...
## ..- attr(*, "names")= chr [1:15] "1" "2" "3" "4" ...
## $ center : num 200
## $ std.dev : num 10.3
## $ nsigmas : num 3
## $ limits : num [1:15, 1:2] 187 187 187 187 186 ...
## ..- attr(*, "dimnames")=List of 2
## $ violations:List of 2
## - attr(*, "class")= chr "qcc"
## List of 11
## $ call : language qcc(data = resistencia, type = "S", nsigmas = 3, plot = TRUE)
## $ type : chr "S"
## $ data.name : chr "resistencia"
## $ data : num [1:15, 1:6] 194 200 200 197 203 186 210 206 201 202 ...
## ..- attr(*, "dimnames")=List of 2
## $ statistics: Named num [1:15] 8.5 7.5 10.9 12.1 12.3 ...
## ..- attr(*, "names")= chr [1:15] "1" "2" "3" "4" ...
## $ sizes : Named int [1:15] 6 6 6 6 5 6 6 5 6 5 ...
## ..- attr(*, "names")= chr [1:15] "1" "2" "3" "4" ...
## $ center : num 9.48
## $ std.dev : num 9.97
## $ nsigmas : num 3
## $ limits : num [1:15, 1:2] 0.276 0.276 0.276 0.276 0 ...
## ..- attr(*, "dimnames")=List of 2
## $ violations:List of 2
## - attr(*, "class")= chr "qcc"Para os dados subsequentes vemos que apenas uma observação está fora dos limites estatísticos de controle para o gráfico do x barra e que, no momento, era ideal procurar saber o que houve no processo para que tenha acontecido isto, porém, podemos ver que as próximas 4 amostras o processo voltou a se estabelecer em controle. O que pode ter ocorrido ao meu ver são duas coisas: A primeira é que foi conseguido detectar o problema e resolver, por isto o processo voltou ao controle; ou então, este ponto é um alarme falso gerado pela aleatoriedade natural do processo. O gráfico de controle para o gráfico S está normal.
resistencia <- qcc.groups(data = V1[1:(15*6)], sample = V2[1:(15*6)] )
resistencianew <- qcc.groups(data = V1[(15*6+1):length(V1)], sample = V2[(15*6+1):length(V1)])
qcc(resistencia, type = "xbar", nsigmas = 3, plot = TRUE, newdata = resistencianew)
## List of 15
## $ call : language qcc(data = resistencia, type = "xbar", newdata = resistencianew, nsigmas = 3, plot = TRUE)
## $ type : chr "xbar"
## $ data.name : chr "resistencia"
## $ data : num [1:15, 1:6] 194 200 200 197 203 186 210 206 201 202 ...
## ..- attr(*, "dimnames")=List of 2
## $ statistics : Named num [1:15] 203 204 194 202 199 ...
## ..- attr(*, "names")= chr [1:15] "1" "2" "3" "4" ...
## $ sizes : Named int [1:15] 6 6 6 6 5 6 6 5 6 5 ...
## ..- attr(*, "names")= chr [1:15] "1" "2" "3" "4" ...
## $ center : num 200
## $ std.dev : num 10.3
## $ newstats : Named num [1:10] 194 199 213 207 200 ...
## ..- attr(*, "names")= chr [1:10] "16" "17" "18" "19" ...
## $ newdata : num [1:10, 1:6] 198 177 227 197 188 177 196 167 199 190 ...
## ..- attr(*, "dimnames")=List of 2
## $ newsizes : Named int [1:10] 4 4 4 4 4 4 4 4 4 4
## ..- attr(*, "names")= chr [1:10] "16" "17" "18" "19" ...
## $ newdata.name: chr "resistencianew"
## $ nsigmas : num 3
## $ limits : num [1:25, 1:2] 187 187 187 187 186 ...
## ..- attr(*, "dimnames")=List of 2
## $ violations :List of 2
## - attr(*, "class")= chr "qcc"qcc(resistencia, type = "S", nsigmas = 3, plot = TRUE, newdata = resistencianew)
## List of 15
## $ call : language qcc(data = resistencia, type = "S", newdata = resistencianew, nsigmas = 3, plot = TRUE)
## $ type : chr "S"
## $ data.name : chr "resistencia"
## $ data : num [1:15, 1:6] 194 200 200 197 203 186 210 206 201 202 ...
## ..- attr(*, "dimnames")=List of 2
## $ statistics : Named num [1:15] 8.5 7.5 10.9 12.1 12.3 ...
## ..- attr(*, "names")= chr [1:15] "1" "2" "3" "4" ...
## $ sizes : Named int [1:15] 6 6 6 6 5 6 6 5 6 5 ...
## ..- attr(*, "names")= chr [1:15] "1" "2" "3" "4" ...
## $ center : num 9.48
## $ std.dev : num 9.97
## $ newstats : Named num [1:10] 14.6 16.3 10.1 15.3 14.8 ...
## ..- attr(*, "names")= chr [1:10] "16" "17" "18" "19" ...
## $ newdata : num [1:10, 1:6] 198 177 227 197 188 177 196 167 199 190 ...
## ..- attr(*, "dimnames")=List of 2
## $ newsizes : Named int [1:10] 4 4 4 4 4 4 4 4 4 4
## ..- attr(*, "names")= chr [1:10] "16" "17" "18" "19" ...
## $ newdata.name: chr "resistencianew"
## $ nsigmas : num 3
## $ limits : num [1:25, 1:2] 0.276 0.276 0.276 0.276 0 ...
## ..- attr(*, "dimnames")=List of 2
## $ violations :List of 2
## - attr(*, "class")= chr "qcc"Lista 2
Questão 1
O número de interruptores não conformes em amostras de tamanho 150 é mostrado na Tabela 1. Construa um gráfico de controle para a fração não conforme para esses dados. O processo parece estar sob controle estatístico? Se não, suponha que causas atribuíveis possam ser encontradas para todos os pontos fora de controle e calcule os limites de controle revisados.
prop <- c(0.053,0.007,0.02,0,0.013,0.027,0,0.007,0.067,0.04,0.04,0,0.027,0,0.02,0.007,0.1,0.013,0.02,0)
p <- mean(prop) #Estimador para fração não conforme desconhecida p
n = 150
LIC <- p - 3*sqrt((p*(1-p))/n)
LSC <- p + 3*sqrt((p*(1-p))/n)
LIC2 <- p - 2*sqrt((p*(1-p))/n)
LSC2 <- p + 2*sqrt((p*(1-p))/n)
LC <- p
shapiro.test(prop) #Os dados possuem dist. normal=.##
## Shapiro-Wilk normality test
##
## data: prop
## W = 0.82377, p-value = 0.001998plot(prop, type = "b", main = "Gráfico de controle", ylim = c(-0.05,0.15))
abline(h=-0.013, lty=2, col = "blue")
abline(h=0.059, lty=2, col = "blue")
abline(h=-0.001, lty=2, col = "red")
abline(h=0.048, lty=2, col = "red")
abline(h=0.023,lty=1) 
O processo não está sob controle estatístico devido ao fato de 2 pontos romperem o LSC. Porém, pelas regras de sensibilidade, não há índicios claros do motivo para que o gráfico esteja fora de controle.
Algumas possíveis causas, podem ter ocasionado essa situação: • 1. Novo operador foi submetido para produção dos interruptores naquela hora. • 2. Erro no processo de inspeção. • 3. Novo material utilizado para fabricação naquele momento. • 4. Um número considerável de observações com número de não conformes iguais a 0.
Uma abordagem técnica a se fazer é retirar os 2 pontos fora de controle e fazer um novo gráfico, afim de observar se os pontos retirados influenciam no processo.
bd <- c(0.053,0.007,0.02,0,0.013,0.027,0,0.007,0.04,0.04,0,0.027,0,0.02,0.007,0.013,0.02,0)
p <- mean(bd) #Estimador para fração não conforme desconhecida p.
n = 150
LIC <- p - 3*sqrt((p*(1-p))/n)
LSC <- p + 3*sqrt((p*(1-p))/n)
LIC2 <- p - 2*sqrt((p*(1-p))/n)
LSC2 <- p + 2*sqrt((p*(1-p))/n)
LC <- p
shapiro.test(bd) #Os dados possuem dist. normal.##
## Shapiro-Wilk normality test
##
## data: bd
## W = 0.88817, p-value = 0.0359plot(bd, type = "b", main = "Gráfico de controle: com a retirada de 2 pontos", ylim = c(-0.05,0.1))
abline(h=-0.014, lty=2, col = "blue")
abline(h=0.047, lty=2, col = "blue")
abline(h=-0.004, lty=2, col = "red")
abline(h=0.037, lty=2, col = "red")
abline(h=0.016,lty=1) 
Apesar do 1º ponto estar fora do LSC, não foi constatado graficamente nenhum indício de que o gráfico estava fora de controle.
Questão 4
Uma fábrica de papel usa um gráfico de controle para monitorar imperfeições nos rolos de papel acabados. O resultado da produção é inspecionado durante 20 dias, e os dados resultantes são mostrados na Tabela 2. Use esses dados para estabelecer um gráfico de controle para não conformidades por rolo de papel. O processo parece estar sob controle estatístico? Qual a linha central e quais limites de controle você recomendaria para controlar a produção corrente?
A ideia inicial é de fazer um gráfico pra apenas o número de imperfeições nos rolos de papel. Com isso, podemos introduzir o gráfico C.
c<-c(12,14,20,18,15,12,11,15,12,10,18,14,9,10,14,13,16,18,20,17)
cbarra<-mean(c)
LSC <- cbarra + 3*(sqrt(cbarra))
LC<-mean(c)
LIC <- cbarra - 3*(sqrt(cbarra))
plot(c, type = "b", main = "Gráfico de controle C para o número de imperfeições",ylim=c(1,30),ylab="Gráfico C", xlab="Amostra")
abline(h=LSC, lty=2, col = "blue")
abline(h=LIC, lty=2, col = "blue")
abline(h=LC,lty=1) 
Com isso, olhando apenas para o número de imperfeições, podemos dizer que o processo aparenta estar sob controle, porém, como é pedido um gráfico de controle para não conformidades por , então podemos utilizar o gráfico , que representa a taxa média de imperfeições por rolo de papel. Como estamos trabalhando com tamanhos de amostra variado, então o mais indicado é o gráfico U com os limites ajustados para tamanhos de amostra diferentes.
c<-c(12,14,20,18,15,12,11,15,12,10,18,14,9,10,14,13,16,18,20,17)
n<-c(18,18,24,22,22,22,20,20,20,20,18,18,18,20,20,20,24,24,22,21)
U<-c/n
Ubarra<- sum(c)/sum(n)
LSC<- Ubarra + 3*sqrt(Ubarra/n)
LIC<- Ubarra - 3*sqrt(Ubarra/n)
plot(U, type = "b", main = "Gráfico de controle U para o número de imperfeições por rolo de papel",ylab="Gráfico U", xlab="Amostra",ylim=c(0,1.5))
lines(LSC, lty=2, col = "blue")
lines(LIC, lty=2, col = "blue")
abline(h=Ubarra,lty=1) 
Observando o gráfico acima, podemos afirmar que nenhuma peça ficou fora dos limites de controle.
Outra alternativa, de vez de utilizarmos o limites com tamanhos de amostra \(n\) desiguais, podemos pegar o tamanho de amostra médio.