2021/10/31 (更新日: 2023/11/30)

2回抜取方式のOC曲線(二項分布とポアソン分布)をプログラムで描こう

抜取検査

「2回抜取検査のOC曲線を作り方がわからない」、「二項分布、ポアソン分布のOC曲線が描けない」など困っていませんか？

こういう疑問に答えます。

本記事のテーマ

OC曲線(二項分布、ポアソン分布の2回抜取検査)を描こう

抜取検査はすべてOC曲線をベースに考える

本記事ではExcel VBAを使ってOC曲線を描き、抜取検査の理論を追究できる準備をします。

なお、１回抜取検査のOC曲線を描くプログラムは、関連記事で紹介しています。

OC曲線(二項分布、ポアソン分布)を描こう
抜取検査はすべて、OC曲線をベースに考えます。OC曲線をすぐ描けるようプログラムを用意しました。二項分布、ポアソン分布両方のOC曲線を実際に描いて感触を確かめましょう。

➀2回抜取検査OC曲線を描こう(二項分布)
②2回抜取検査OC曲線を描こう(ポアソン分布)

2回抜取検査を自動で描くプログラムを解説するのは本記事だけです。

➀2回抜取検査OC曲線を描こう(二項分布)

二項分布のOC曲線をExcelで描く

下図のように,Excelファイル(.xlsm)を用意し、
①シート”二項”に
②データ間隔[%]と③(n1,ac1,re1,n2,ac2,re2)の値を入れてください。
④VBAで④のように自動計算します。

ロット合格率L(p)は、
L(p)= \(\sum_{r=0}^{ac1} {}_{n1} C_r p^r (1-p)^{n1-r}\)
+ \(\sum_{r=ac1+1}^{re1-1}\){\( {}_{n1} C_r p^r (1-p)^{n1-r}\)

× \(\sum_{s=0}^{ac2-r} {}_{n2} C_s p^s (1-p)^{n2-s}\)}
Excelではx=pとして計算します。

2回抜取検査のロット合格率L(p)の式の導出は関連記事にあります。

2回抜取方式(二項分布)のOC曲線が描ける
抜取検査を2回する場合の確率の計算やOC曲線は描けますか？抜取検査を1回から2回に分けるメリットは何かわかりますか？本記事では、2回抜取検査におけるロット合格率の求め方、OC曲線の描き方、2回に検査を分けるメリットを解説します。多回抜取検査について知りたい方は必見です。

VBAプログラム例

1. Sub oc2kai_1()
2.
3. Dim n1(1 To 1000) As Long, ac1(1 To 1000) As Long, re1(1 To 1000) As Long
4. Dim n2(1 To 1000) As Long, ac2(1 To 1000) As Long, re2(1 To 1000) As Long
5. Dim SH As String, ncol As Long, ab As Double, nrow As Long
6. Dim tt(1 To 1000) As Double, ta(1 To 1000) As Double
7.
8. SH = “二項”　　’シート名
9. ncol = Worksheets(SH).Cells(1, Columns.Count).End(xlToLeft).Column – 5 ‘最大列数
10.
11. ab = Worksheets(SH).Cells(2, 1) ‘間隔
12.
13. nrow = Int(100 / ab) + 1 ‘計算行数
14. ‘初期化
15. Range(Worksheets(SH).Cells(10, 6), Worksheets(SH).Cells(9 + nrow, 5 + ncol)).ClearContents
16. Range(Worksheets(SH).Cells(11, 5), Worksheets(SH).Cells(10 + nrow, 5 + ncol)).ClearContents
17.
18. Worksheets(SH).Cells(11, 5) = 0.001
19.
20. For i1 = 1 To ncol ‘抜取検査対象を入力
21. Worksheets(SH).Cells(10, 5 + i1) = “y” & i1
22. n1(i1) = Worksheets(SH).Cells(1, 5 + i1)
23. ac1(i1) = Worksheets(SH).Cells(2, 5 + i1)
24. re1(i1) = Worksheets(SH).Cells(3, 5 + i1)
25. n2(i1) = Worksheets(SH).Cells(4, 5 + i1)
26. ac2(i1) = Worksheets(SH).Cells(5, 5 + i1)
27. re2(i1) = Worksheets(SH).Cells(6, 5 + i1)
28. Next i1
29.
30. For i1 = 1 To nrow
31. If i1 > 1 Then
32. ta(i1) = ta(i1 – 1) + ab
33. tt(i1) = ta(i1) / 100
34. Worksheets(SH).Cells(i1 + 10, 5) = ta(i1)
35. End If
36. Next i1
37.
38. ‘nrow = 5
39.
40. ‘OC曲線(2回抜取)
41. For i1 = 1 To nrow
42. For j1 = 1 To ncol
43. For k1 = 0 To ac1(j1) ‘①1回で合格する場合
44. Worksheets(SH).Cells(i1 + 10, 5 + j1) = Worksheets(SH).Cells(i1 + 10, 5 + j1) _
45. + WorksheetFunction.Combin(n1(j1), k1) * tt(i1) ^ k1 * (1 – tt(i1)) ^ (n1(j1) – k1)
46. Next k1
47.
48. For k2 = ac1(j1) + 1 To re1(j1) – 1 ‘②2回で合格する場合
49. aa = 0 ‘初期化　aa:2回目の場合の確率の和
50. For l1 = 0 To ac2(j1) – k2
51. aa = aa + WorksheetFunction.Combin(n2(j1), l1) * tt(i1) ^ l1 * (1 – tt(i1)) ^ (n2(j1) – l1)
52. Next l1
53.
54. Worksheets(SH).Cells(i1 + 10, 5 + j1) = Worksheets(SH).Cells(i1 + 10, 5 + j1) _
55. + WorksheetFunction.Combin(n1(j1), k2) * tt(i1) ^ k2 * (1 – tt(i1)) ^ (n1(j1) – k2) * aa
56. Next k2
57.
58. Next j1
59. Next i1
60.
61. End Sub

グラフの結果例を挙げます。

➀2回抜取検査OC曲線を描こう(ポアソン分布)

ポアソン分布のOC曲線をExcelで描く

ロット合格率L(p)は、
L(p)= \(\sum_{r=0}^{ ac1} exp(-λ_1)\frac{λ_1^r}{r!}\)
+ \(\sum_{r=ac1+1}^{re1-1}\){\( exp(-λ_1)\frac{λ_1^r}{r!}\)

× \(\sum_{s=0}^{ac2-r} exp(-λ_2)\frac{λ_2^r}{r!}\)}
Excelではx=pとして計算します。

2回抜取検査のロット合格率L(p)の式の導出は関連記事にあります。

2回抜取方式(ポアソン分布)のOC曲線が描ける
抜取検査を2回する場合の確率の計算やOC曲線は描けますか？抜取検査を1回から2回に分けるメリットは何かわかりますか？本記事では、2回抜取検査におけるロット合格率の求め方、OC曲線の描き方、2回に検査を分けるメリットを解説します。多回抜取検査について知りたい方は必見です。

VBAプログラム例

1. Sub oc2kai_2()
2.
3. Dim n1(1 To 1000) As Long, ac1(1 To 1000) As Long, re1(1 To 1000) As Long
4. Dim n2(1 To 1000) As Long, ac2(1 To 1000) As Long, re2(1 To 1000) As Long
5. Dim SH As String, ncol As Long, ab As Double, nrow As Long
6. Dim tt(1 To 1000) As Double, ta(1 To 1000) As Double
7.
8. SH = “ポアソン”
9. ncol = Worksheets(SH).Cells(1, Columns.Count).End(xlToLeft).Column – 5
10.
11. ab = Worksheets(SH).Cells(2, 1)
12.
13. nrow = Int(100 / ab) + 1
14. ‘初期化0
15. Range(Worksheets(SH).Cells(11, 3), Worksheets(SH).Cells(10 + nrow, 5)).ClearContents
16. Range(Worksheets(SH).Cells(10, 6), Worksheets(SH).Cells(10 + nrow, 6 + ncol)).ClearContents
17.
18. Worksheets(SH).Cells(11, 5) = 0 ‘x=0を代入
19.
20. For i1 = 1 To ncol　’n1,ac1,re1,n2,ac2,re2を代入
21. Worksheets(SH).Cells(10, 5 + i1) = “y” & i1
22. n1(i1) = Worksheets(SH).Cells(1, 5 + i1)
23. ac1(i1) = Worksheets(SH).Cells(2, 5 + i1)
24. re1(i1) = Worksheets(SH).Cells(3, 5 + i1)
25. n2(i1) = Worksheets(SH).Cells(4, 5 + i1)
26. ac2(i1) = Worksheets(SH).Cells(5, 5 + i1)
27. re2(i1) = Worksheets(SH).Cells(6, 5 + i1)
28. Next i1
29.
30. For i1 = 1 To nrow
31. If i1 > 1 Then
32. ta(i1) = ta(i1 – 1) + ab
33. tt(i1) = ta(i1) / 100
34. Worksheets(SH).Cells(i1 + 10, 5) = ta(i1)
35. End If
36. Next i1
37.
38. Dim ramda1 As Double, ramda2 As Double, fact1 As Double, fact2 As Double
39. ‘OC曲線(2回抜取)
40. For i1 = 1 To nrow
41. For j1 = 1 To ncol
42. ‘λ=Nx/100で導出
43. ramda1 = _
44. Worksheets(SH).Cells(1, 5 + j1) * Worksheets(SH).Cells(i1 + 10, 5) / 100
45. ramda2 = _
46. Worksheets(SH).Cells(4, 5 + j1) * Worksheets(SH).Cells(i1 + 10, 5) / 100
47.
48. fact1 = 1: fact2 = 1
49.
50. For k1 = 0 To ac1(j1) ‘①1回で合格する場合
51. If k1 > 0 Then
52. fact1 = fact1 * k1 ‘階乗！を計算
53. End If
54.
55. Worksheets(SH).Cells(i1 + 10, 5 + j1) = _
56. Worksheets(SH).Cells(i1 + 10, 5 + j1) + Exp(-ramda1) * ramda1 ^ k1 / fact1
57. Next k1
58.
59. For k2 = ac1(j1) + 1 To re1(j1) – 1 ‘②2回で合格する場合
60. fact1 = fact1 * k2
61.
62. aa = 0 ‘初期化　aa:2回目の場合の確率の和
63. For m1 = 0 To ac2(j1) – k2
64. If m1 > 0 Then
65. fact2 = fact2 * m1 ‘階乗！を計算
66. End If
67.
68. aa = aa + Exp(-ramda2) * ramda2 ^ m1 / fact2
69. Next m1
70.
71. Worksheets(SH).Cells(i1 + 10, 5 + j1) = Worksheets(SH).Cells(i1 + 10, 5 + j1) _
72. + (Exp(-ramda1) * ramda1 ^ k1 / fact1) * aa
73.
74. Next k2
75.
76. Next j1
77. Next i1
78.
79. End Sub

グラフの結果例を挙げます。

まとめ

2回抜取検査のOC曲線をプログラムで描けるよう解説しました。実際描いてみてください。

➀2回抜取検査OC曲線を描こう(二項分布)
②2回抜取検査OC曲線を描こう(ポアソン分布)

抜取検査