(*:Mathematica Version: 3.0 or 4.0 *) (*:Package Version: 1.0 *) (*:Name: QualityControl`VariableChart`*) (*:Context: QualityControl`VariableChart`*) (*:Title: Basic Varible Control Charts *) (*:Author: Guillermo Sanchez *) (*:History: Version 1.0 by Guillermo Sanchez while he was a Wolfram Research visiting scholar, August 1999 *) (*:Copyright: Copyright 1999, Guillermo Sanchez and Wolfram Research Inc. *) (*:Reference: Usage messages only. *) (*:Summary: This package computes the following Control Charts: XbarS, XIndividual, Cusum, EWMA and T2Multivariable *) (*:Keywords: Control Charts, Shewhart, Cusum, EWMA, Multivariable *) (*:Requirements: MultiDescriptiveStatistics and MultipleListPlot. *) (*:Warning: None. *) (*:Sources: Introduction to Statistical Quality Control by Douglas C.Montgomery (1996). Third Edition. John Willey and Sons, Inc.*) BeginPackage["QualityControl`VariableChart`"] MeanX::usage = "MeanX[list] gives the mean for X of the entries in list." MeanS::usage = "MeanX[list] gives the mean for S of the entries in list." XbarS::usage = "XbarS[list] gives {{CL for X, UCL for X, LCL for X},{CL for S, UCL for S, LCL for S}} using the entries in list." XbarSReportSh::usage = "XbarSReportSh[list] give the short report for a XbarS chart, no standard given." XbarSReport::usage = "XbarSReport[list] give the full report for a XbarS chart, no standard given." XbarSChart::usage = "XbarSChart[list] plot the XbarChart of the entries in list ,no standard given." XbarSReportShSG::usage = "XbarSReportShSG[list,mu,sig] give the short report for a XbarS chart, standard given." XbarSReportSG::usage = "XbarSReportSG[list,mu,sig] give the full report for a XbarS chart, standard given." XbarSChartSG::usage = "XbarSChartSG[list,mu,sig] plot the XbarChart of the entries in list, standard given." XforI::usage = "XforI[list] gives {{CL for X, UCL for X, LCL for X},{CL for S, UCL for S, LCL for S}} using the entries in list." XforIReportSh::usage = "XbarSReportSh[list] give the short report for a XforI chart, no standard given." XforIReport::usage = "XforIReport[list] give the full report for a XforI chart, no standard given." XforIChart::usage = "XforIChart[list] plot the X an MR Charts of the entries in list, no standard given." XforIReportShSG::usage = "XforIReportShSG[mu,sig] give the short report for a XforI chart, standard given." XforIReportSG::usage = "XforISReportSG[list,mu,sig] give the full report for a XforI chart, standard given." XforIChartSG::usage = "XforIChartSG[list,mu,sig] plot the X and MR Charts of the entries in list, standard given." c::usage ="c[list,mu,sig] give Ck, C+, N+,C-,N- of the entries in list." CusumReport::usage = "Cusum[list,mu,sig] give k, Xk, Ck, C+, N+,C-,N- of the entries in list." CusumChart::usage= "CusumChart[list,mu,sig] plots the tabular cusum Chart of the entries in list." EWMA::usage =" EWMA[list,lamb,sig,L] give UCL, LCL and zk of the entries in list." EWMAReport::usage = "EWMAReport[list,lamb,sig,L] give k, Xk, UCL, LCL and zk of the entries in list." EWMAChart::usage = "EWMAChart[list,lamb,sig,L] plots the EWMA chart of the entries in list." T2::usage =" T2[list, alfa] give T2k values of the entries in list." T2Report::usage = "T2Report [list, alfa] give T2k values for a list of p variables, m samples and n size of each sample. The dimension of list must be {p,m,n}." T2Chart::usage = "T2Chart[list, alfa] plots T2k values and UCL for a list of p variables, m samples and n size of each sample. The dimension of list must be {p,m,n}." Unprotect[MeanX, MeanS, XbarS, XbarSReportSh, XbarSReport,XbarSChart, XbarSSG, XbarSReportShSG, XbarSReportSG, XbarSChartSG,XforI, XforIReportSh, XforIReport, XforIChart, XforISG,XforIReportSG, XforIReportShSG,XforIChartSG, c,CusumReport,CusumChart,EWMA, EWMAReport,EWMAChart,T2,T2Report,T2Chart]; Begin["`Private`"] Needs["Statistics`MultiDescriptiveStatistics`"] Needs["Graphics`MultipleListPlot`"] (* Xbar S chart*) MeanX[list_] := Mean[Transpose[list]] MeanS[list_] := StandardDeviation[Transpose[list]] (* XbarS standard no given*) XbarS[list_List] := Module[{m, c4, A3, B3, B4, CLforX, CLforS}, m = Length[Transpose[list]]; c4 = (Sqrt[2/(m - 1)]*Gamma[m/2])/Gamma[(m - 1)/2]; A3 = 3/(c4*Sqrt[m]); B3 = 1 - 3/c4*Sqrt[1 - c4^2]; B4 = 1 + 3/c4*Sqrt[1 - c4^2]; {{CLforX = Mean[MeanX[list]], CLforX - A3*CLforS, CLforX + A3*CLforS}, {CLforS = Mean[MeanS[list]], Max[0, B3*CLforS], B4*CLforS}}] XbarSReportSh[list_List] := TableForm[Join[{{"", "X", "S"}}, Transpose[Join[{{"CL", "LCL", "UCL"}}, XbarS[list]]]]] XbarSReport[list_List] := TableForm[Join[{{"Subgroup", "Xmean", "S"}}, Transpose[{Table[i, {i, 1, Length[list]}], MeanX[list], MeanS[list]}], Transpose[Join[{{"CL", "LCL", "UCL"}}, XbarS[list]]]]] XbarSChart[list_] := Module[{minX, maxX, minS, maxS, rX, rS}, minX = Min[XbarS[list][[1]], MeanX[list]]; maxX = Max[XbarS[list][[1]], MeanX[list]]; minS = Min[XbarS[list][[2]], MeanS[list]]; maxS = Max[XbarS[list][[2]], MeanS[list]]; rX = maxX - minX; rS = maxS - minS; ListPlot[MeanX[list], PlotLabel -> "\!\(X\&_\) values for XbarS Control chart,\nInitial Study", PlotJoined -> True, GridLines -> {None, XbarS[list][[1]]}, Frame -> {True, True, False, False}, FrameLabel -> {"subgroup", "\!\(X\&_\)"}, PlotRange -> {minX - rX/5, maxX + rX/5}]; ListPlot[MeanS[list], PlotLabel -> "s values for XbarS Control chart,\nInitial Study", PlotJoined -> True, GridLines -> {None, XbarS[list][[2]]}, Frame -> {True, True, False, False}, FrameLabel -> {"subgroup", "s"}, PlotRange -> {minS - rS/5, maxS + rS/5}]; XbarSReportSh[list]] (* XbarS standard given*) XbarSSG[list_List,mu_, sig_] := N[Module[{m, c4, A, B5, B6, CLforX, CLforS}, m = Length[Transpose[list]]; c4 = (Sqrt[2/(m - 1)]*Gamma[m/2])/Gamma[(m - 1)/2]; A = 3/Sqrt[m]; B5 = c4 - 3*Sqrt[1 - c4^2]; B6 = c4 + 3*Sqrt[1 - c4^2]; {{CLforX = mu, mu + A*CLforS, mu - A*CLforS}, {CLforS = c4*sig, Max[0, B5*CLforS], B6*CLforS}}]] XbarSReportShSG[list_List,mu_, sig_] := TableForm[Join[{{"", "X", "S"}}, Transpose[Join[{{"CL", "LCL", "UCL"}}, XbarSSG[list,mu, sig]]]]] XbarSReportSG[list_List,mu_, sig_] := TableForm[Join[{{"Subgroup", "Xmean", "S"}}, Transpose[{Table[i, {i, 1, Length[list]}], MeanX[list], MeanS[list]}], Transpose[Join[{{"CL","LCL", "UCL"}}, XbarSSG[list,mu, sig]]]]] XbarSChartSG[list_List,mu_, sig_] := Module[{minX, maxX, minS, maxS, rX, rS}, minX = Min[XbarSSG[mu, sig, list][[1]], MeanX[list]]; maxX = Max[XbarSSG[mu, sig, list][[1]], MeanX[list]]; minS = Min[XbarSSG[mu, sig, list][[2]], MeanS[list]]; maxS = Max[XbarSSG[mu, sig, list][[2]], MeanS[list]]; rX = maxX - minX; rS = maxS - minS; ListPlot[MeanX[list], PlotLabel -> "\!\(X\&_\) values for XbarS Control chart,\nInitial Study", PlotJoined -> True, GridLines -> {None, XbarSSG[list,mu, sig][[1]]}, Frame -> {True, True, False, False}, FrameLabel -> {"subgroup", "\!\(X\&_\)"}, PlotRange -> {minX - rX/5, maxX + rX/5}]; ListPlot[MeanS[list], PlotLabel -> "s values for XbarS Control chart,\nInitial Study", PlotJoined -> True, GridLines -> {None, XbarSSG[list,mu, sig][[2]]}, Frame -> {True, True, False, False}, FrameLabel -> {"subgroup", "s"}, PlotRange -> {minS - rS/5, maxS + rS/5}]; XbarSReportShSG[list,mu, sig]] (*Chart for Individuals, XforI*) (*XforI Standard no given*) XforI[list_List] := Module[{MR, CLforX}, MR = Abs[Drop[list, 1] - Drop[list, -1]]; CLforX = Mean[list]; {{CLforX , CLforX + 2.65957*Mean[MR], CLforX - 2.65957*Mean[MR]}, {Mean[MR], 0, 3.267*Mean[MR]}}] XforIReportSh[list_List] := TableForm[ Join[{{"", "X", "MR"}}, Transpose[ Join[{{"CL", "LCL", "UCL"}}, XforI[list]]]]] XforIReport[list_List] := TableForm[ Join[{{"Subgroup", "X", "MR"}}, Transpose[{Table[i, {i, 1, Length[list]}], list, Prepend[Abs[Drop[list, 1] - Drop[list, -1]], 0]}], Transpose[Join[{{"CL", "LCL", "UCL"}}, XforI[list]]]]] XforIChart[list_List] := Module[{MR, minX, maxX, minS, maxS, rX, rS}, MR = Abs[Drop[list, 1] - Drop[list, -1]]; minX = Min[XforI[list][[1]], Min[list]]; maxX = Max[XforI[list][[1]], Max[list]]; minS = Min[XforI[list][[2]], Mean[MR]]; maxS = Max[XforI[list][[2]], Mean[MR]]; rX = maxX - minX; rS = maxS - minS; ListPlot[list, PlotLabel -> "X values for individuals Control chart,\nInitial Study", PlotJoined -> True, GridLines -> {None, XforI[list][[1]]}, Frame -> {True, True, False, False}, FrameLabel -> {"subgroup", "X"}, PlotRange -> {minX - rX/5, maxX + rX/5}]; ListPlot[MR, PlotLabel -> "Moving Range for individual Control chart,\nInitial Study", PlotJoined -> True, GridLines -> {None, XforI[list][[2]]}, Frame -> {True, True, False, False}, FrameLabel -> {"subgroup", "MR"}, PlotRange -> {minS - rS/5, maxS + rS/5}]; XforIReportSh[list]] (*XforI Standard Given*) XforISG[mu_, sig_] := {{mu, mu + 3*sig, mu - 3*sig}, {1.128*sig, 0, 3.686*sig}} XforIReportShSG[mu_, sig_] := TableForm[Join[{{"", "X", "MR"}}, Transpose[ Join[{{"CL", "LCL", "UCL"}}, XforISG[mu, sig]]]]] XforIReportSG[list_List,mu_, sig_] := TableForm[Join[{{"Subgroup", "X", "MR"}}, Transpose[{Table[i, {i, 1, Length[list]}], list, Prepend[Abs[Drop[list, 1] - Drop[list, -1]], 0]}], Transpose[Join[{{"CL", "LCL", "UCL"}}, XforISG[mu, sig]]]]] XforIChartSG[list_List,mu_, sig_] := Module[{MR, minX, maxX, minS, maxS, rX, rS}, MR = Abs[Drop[list, 1] - Drop[list, -1]]; minX = Min[XforISG[mu, sig][[1]], Min[list]]; maxX = Max[XforISG[mu, sig][[1]], Max[list]]; minS = Min[XforISG[mu, sig][[2]], Mean[MR]]; maxS = Max[XforISG[mu, sig][[2]], Mean[MR]]; rX = maxX - minX; rS = maxS - minS; ListPlot[list, PlotLabel -> "X values for individuals Control chart,\nInitial Study", PlotJoined -> True, GridLines -> {None, XforISG[mu, sig][[1]]}, Frame -> {True, True, False, False}, FrameLabel -> {"subgroup", "X"}, PlotRange -> {minX - rX/5, maxX + rX/5}]; ListPlot[MR, PlotLabel -> "Moving Range for individual Control chart,\nInitial Study", PlotJoined -> True, GridLines -> {None, XforISG[mu, sig][[2]]}, Frame -> {True, True, False, False}, FrameLabel -> {"subgroup", "MR"}, PlotRange -> {minS - rS/5, maxS + rS/5}]; XforIReportShSG[mu, sig]] (* Cusum Chart*) c[list_List,mu_, sig_] := Module[{c, cplus, nplus, cminus, nminus}, c = Drop[FoldList[Plus, 0, list - mu], 1]; cplus = Drop[FoldList[Max[0, #2 + #1] & , 0, list - (mu + sig/2)], 1]; nplus = Drop[FoldList[If[#2 > 0, #1 + 1, 0] & , 0, cplus], 1]; cminus = Drop[FoldList[Max[0, #2 + #1] & , 0, mu - sig/2 - list], 1]; nminus = Drop[FoldList[If[#2 > 0, #1 + 1, 0] & , 0, cminus], 1]; {c, cplus, nplus, cminus, nminus}] CusumReport[list_List,mu_, sig_] := Join[Prepend[ Transpose[ Join[{Table[i, {i, 1, Length[list]}]}, {list}, c[list,mu, sig]]], {"k", "Xk", "Ck", "C+", "N+", "C-", "N-"}]] // TableForm CusumChart[list_List,mu_,sig_, H_]:= Module[{a, ci, cminus,cplus}, a = c[list,mu, sig]; ci = a[[1]]; cminus = a[[4]]; cplus = a[[2]]; ListPlot[cplus - cminus, PlotJoined -> True, GridLines -> {None, {H*sig, -H*sig}}, PlotRange -> {Min[-(H + 1)*sig, -cminus], Max[(H + 1)*sig, cplus]}, PlotLabel -> "Cusum Control chart", Frame -> {True, True, False, False}, FrameLabel -> {"subgroup", "<- \!\(\(C\^-\)\) \!\(\(C\^+\)\) -> "}]; ListPlot[ci, PlotJoined -> True, PlotLabel -> "\!\(C\_k\) values", Frame -> {True, True, False, False}, FrameLabel -> {"subgroup", "\!\(C\_k\)"}]] (*EWMA Chart*) EWMA[list_List, mu_, lamb_, sig_, L_] := Module[{a}, a = L*sig*Sqrt[lamb/(2 - lamb)*(1 - (1 - lamb)^(2*i))]; Join[Transpose[Table[{mu + a, mu - a}, {i, 1, Length[list]}]], {Drop[FoldList[#2 + (1 - lamb)*#1 & , mu, lamb*list], 1]}]] EWMAReport[list_List, mu_, lamb_, sig_, L_] := TableForm[{{"k", "UCL", "LCL", "Zk"}, Join[{Table[i, {i, 1, 30}]}, EWMA[list,mu, lamb, sig, L]]}] EWMAChart[list_List, mu_, lamb_, sig_, L_] := Module[{a, ra}, a = EWMA[list,mu, lamb, sig, L]; ra = (Max[a] - Min[a])/10; MultipleListPlot[a, PlotJoined -> True, PlotStyle -> {Dashing[{0}], Dashing[{0}], Dashing[{0}]}, SymbolShape -> {PlotSymbol[Box, 0], PlotSymbol[Box, 0], PlotSymbol[Box]}, PlotRange -> {Min[a] - ra, Max[a] + ra}, PlotLabel -> "EWMA Control chart", Frame -> {True, True, False, False}, FrameLabel -> {"subgroup", "EWMA"}, GridLines -> {None, {mu}}]] (*T2 Multivariable Chart*) T2[list_List, alfa_] := Module[{meanList, A, inverseS, p, n, m}, meanList = (Mean[Transpose[#1]] & ) /@ list; A = Transpose[meanList - Mean /@ meanList]; inverseS = Inverse[(Mean[Transpose[#1]] & ) /@ Table[MapThread[Covariance, list[[{i, j}]]], {i, 1, Length[list]}, {j, 1, Length[list]}]]; {p, n, m} = Dimensions[list]; {m*Table[Extract[A, i] . inverseS . Extract[A, i], {i, 1, n}], (p*(m - 1)*(n - 1))/(m*n - m - p + 1)* Quantile[FRatioDistribution[p, m*n - m - p + 1], 1 - alfa]}] T2Report[list_List, alfa_] := Module[{a}, a = T2[list, alfa]; {"{k,\!\(T\_k\%2\)}" -> Transpose[ {Table[i, {i, 1, Length[a[[1]]]}], a[[1]]}], "UCL" -> a[[2]], "LCL" -> 0}] T2Chart[list_List, alfa_] := Module[{a}, a = T2[list, alfa]; ListPlot[a[[1]], PlotJoined -> True, GridLines -> {None, {a[[2]]}}, PlotLabel -> "T2 Hotelling Control Chart", Frame -> {True, True, False, False}, FrameLabel -> {"subgroup", "T2"}, PlotRange -> {0, Max[a] + Max[a]/10}]; {"UCL" -> a[[2]]}] End[ ] SetAttributes[MeanX, ReadProtected]; SetAttributes[MeanS, ReadProtected]; SetAttributes[XbarS, ReadProtected]; SetAttributes[XbarSReportSh, ReadProtected]; SetAttributes[XbarSReport, ReadProtected]; SetAttributes[XbarSChart, ReadProtected]; SetAttributes[XbarSSG, ReadProtected]; SetAttributes[XbarSReportShSG, ReadProtected]; SetAttributes[XbarSReportSG, ReadProtected]; SetAttributes[XbarSChartSG, ReadProtected]; SetAttributes[XforI, ReadProtected]; SetAttributes[XforIReportSh, ReadProtected]; SetAttributes[XforIReport, ReadProtected]; SetAttributes[XforIChart, ReadProtected]; SetAttributes[XforISG, ReadProtected]; SetAttributes[XforIReportSG, ReadProtected]; SetAttributes[XforIReportShSG, ReadProtected]; SetAttributes[XforIChartSG, ReadProtected]; SetAttributes[c, ReadProtected]; SetAttributes[CusumReport, ReadProtected]; SetAttributes[CusumChart, ReadProtected]; SetAttributes[EWMA, ReadProtected]; SetAttributes[EWMAReport, ReadProtected]; SetAttributes[EWMAChart, ReadProtected]; SetAttributes[T2, ReadProtected]; SetAttributes[T2Report, ReadProtected]; SetAttributes[T2Chart, ReadProtected]; Protect[MeanX, MeanS,XbarS, XbarSReportSh, XbarSReport,XbarSChart, XbarSSG, XbarSReportShSG, XbarSReportSG, XbarSChartSG,XforI, XforIReportSh, XforIReport, XforIChart, XforISG, XforIReportSG, XforIReportShSG,XforIChartSG,c,CusumReport,CusumChart, EWMA, EWMAReport,EWMAChart,T2,T2Report,T2Chart]; EndPackage[ ]