Traitement des données

Télécharger les données :

donnees<-read.csv2("https://sjaubert.github.io/SPCR/diameter.csv",header = T)

Examinons si tout s’est bien passé (le format des données récupérées cause souvent des surprises !) :

is.numeric(donnees$diameter)
## [1] TRUE

Par souci de simplicité, appelons diameter_butee notre vecteur de données :

diameter_butee<-donnees$diameter

Petit aperçu de ces 30 premiers relevés (6X5)

hist(diameter_butee,breaks = 30)

Entrons manuellement les 4 échantillons suivants :

dd<-c(11.91,11.95,11.9,11.94,11.93,11.95,11.92,11.95,11.93,11.94,11.95,11.93,11.95,11.95,11.95,11.98,11.94,11.97,11.95,11.95)

Puis on concatène les données :

diameter<-c(diameter_butee,dd)

Notre première carte de contrôle

Chargeons la librairie qcc

library(qcc) #chargement de la librairie QCC

Regroupons nos données en 10 échantillons de 5 valeurs :

mydata<-qcc.groups(diameter,rep(1:10,each=5))
mydata
##     [,1]  [,2]  [,3]  [,4]  [,5]
## 1  11.87 11.86 11.84 11.88 11.87
## 2  11.87 11.85 11.86 11.84 11.89
## 3  11.91 11.90 11.86 11.88 11.87
## 4  11.89 11.91 11.89 11.88 11.92
## 5  11.91 11.92 11.93 11.89 11.90
## 6  11.85 11.91 11.92 11.93 11.90
## 7  11.91 11.95 11.90 11.94 11.93
## 8  11.95 11.92 11.95 11.93 11.94
## 9  11.95 11.93 11.95 11.95 11.95
## 10 11.98 11.94 11.97 11.95 11.95

Pour des infos supplémentaires sur le package QCC : https://cran.r-project.org/web/packages/qcc/vignettes/qcc_a_quick_tour.html

Faisons notre première carte de contrôle celle des Xbar :

q1<-qcc(data = mydata,type = "xbar")

On constate 6 points hors contrôle au début et à la fin… le processus en dérive constante il faut en trouver la cause sans doute spéciale.

Calculs des principaux résultats obtenus

Calcul de la moyenne de chaque échantillon puis la moyenne des moyennes :

(x_bar<-apply(mydata,1,mean))
##      1      2      3      4      5      6      7      8      9     10 
## 11.864 11.862 11.884 11.898 11.910 11.902 11.926 11.938 11.946 11.958
(x_barbar<-mean(x_bar))
## [1] 11.9088

Calcul de la moyenne des étendues :

x_min<-apply(mydata,1,min)
x_max<-apply(mydata,1,max)

La moyenne des étendues est :

(R_bar<-mean(x_max-x_min))
## [1] 0.044

Afin d’estimer l’écart-type en fonction de la moyenne des étendues, on utilisera la fonction d2

\(\hat{\sigma}=\frac{\bar{R}}{d2}\)

d2=function(n){2*integrate(function(x){n*x*dnorm(x)*pnorm(x)^(n-1)},-Inf,Inf)$val}

Voir ici pour les explications : https://sjaubert.github.io/SPCR/Estimation.pdf

Les calculs nous permettent de retrouver les LCL et UCL obtenus précédemment :

(LCL<-x_barbar-3*R_bar/(sqrt(5)*d2(5)))
## [1] 11.88342
(UCL<-x_barbar+3*R_bar/(sqrt(5)*d2(5)))
## [1] 11.93418

Etude en deux phases

Nous pouvons considérer que dans un premier temps le calibrage se fasse sur les 6 premiers échantillons, puis nous intégrons dans un deuxième temps les 4 autres échantillons

q2<-qcc(data = mydata[1:6,],type = "xbar",newdata = mydata[7:10,])

Nous recentrons nos données, nous voyons ainsi que nous aurions pu être alerté beaucoup plus tôt, dès le 7ème échantillon, de cette dérive vers le haut.

La carte R

q2<-qcc(data = mydata,type="R")

La dispersion semble assez bien maitrisée, pas de différences significatives si on traite en deux phases :

q2<-qcc(data = mydata[1:6,],type="R",newdata = mydata[7:10,])

Etude de normalité

Vérifions si les données sont distribuées normalement

qqnorm(diameter);qqline(diameter,col="red",lwd=2)

Un test pour appuyer cette évaluation visuelle est toujours préférable :

shapiro.test(diameter)
## 
##  Shapiro-Wilk normality test
## 
## data:  diameter
## W = 0.96175, p-value = 0.1053

Avec un p-value > 10% il est raisonnable d’accepter l’hypothèse de normalité ou tout du moins nous ne la rejettons pas…

Etude la capabilité

process.capability(q1,spec.limits = c(11.85,12),breaks = 10)

## 
## Process Capability Analysis
## 
## Call:
## process.capability(object = q1, spec.limits = c(11.85, 12), breaks = 10)
## 
## Number of obs = 50           Target = 11.93
##        Center = 11.91           LSL = 11.85
##        StdDev = 0.01892         USL = 12
## 
## Capability indices:
## 
##       Value    2.5%  97.5%
## Cp    1.322  1.0606  1.582
## Cp_l  1.036  0.8473  1.225
## Cp_u  1.607  1.3290  1.885
## Cp_k  1.036  0.8111  1.261
## Cpm   1.004  0.7700  1.237
## 
## Exp<LSL 0.094%    Obs<LSL 4%
## Exp>USL 0%    Obs>USL 0%

Avec un \(C_{p}=1.32\) le processus est acceptable le \(C_{pk}=1.04\) est par contre trop limite, un décentrage se fait sentir.

Pour l’écart-type :

(sigma<-R_bar/d2(5))
## [1] 0.01891717

Pour une carte S (peu d’intérêt ici car par nature très semblable à une carte R):

q2<-qcc(data = mydata,type="S")