【3D(8方向・リセット有り)・修正版】パチンコ玉に細工がしてある場合。
1 プログラムの修正
以前の記事にメモしたプログラムが不正確だったので修正してみた。・【3D(8方向)】パチンコ玉に細工がしてある場合。:https://tanakah17191928.blogspot.com/2024/11/3d_72.html
とりあえず修正したプログラムをメモ。
後日、また暇なときに実行してみて、結果に大きな違いが見られたらグラフを貼付しようと思う。
2 【3D(8方向・リセット有り)・修正版】パチンコ玉に細工がしてある場合。
Option Explicit
Sub game()
Dim i As Long, j As Long
Dim p_x As Integer, p_y As Integer, c As Integer, k_x As Integer, k_y As Integer, k_xy As Integer, k_yx As Integer
Dim r As Boolean, l As Boolean, f As Boolean, b As Boolean, rf As Boolean, lb As Boolean, rb As Boolean, lf As Boolean
For i = 1 To 1000
p_x = 0
p_y = 0
k_x = 0
k_y = 0
k_xy = 0
k_yx = 0
r = True
l = True
f = True
b = True
rf = True
lb = True
rb = True
lf = True
For j = 1 To 50
c = 0
Randomize
c = Int(1000 * Rnd + 1)
If c <= (125 + k_x) Then
p_x = p_x + 1
If k_x < 125 Then
k_x = k_x + 100
If k_x > 125 Then
k_x = 125
End If
End If
If r = False Then
k_x = 0
End If
k_y = 0
k_xy = 0
k_yx = 0
r = True
l = False
f = False
b = False
rf = False
lb = False
rb = False
lf = False
ElseIf (125 + k_x) < c And c <= 250 Then
p_x = p_x - 1
If k_x > -125 Then
k_x = k_x - 100
If k_x < -125 Then
k_x = -125
End If
End If
If l = False Then
k_x = 0
End If
k_y = 0
k_xy = 0
k_yx = 0
r = False
l = True
f = False
b = False
rf = False
lb = False
rb = False
lf = False
ElseIf 250 < c And c <= (375 + k_y) Then
p_y = p_y + 1
If k_y < 125 Then
k_y = k_y + 100
If k_y > 125 Then
k_y = 125
End If
End If
If f = False Then
k_y = 0
End If
k_x = 0
k_xy = 0
k_yx = 0
r = False
l = False
f = True
b = False
rf = False
lb = False
rb = False
lf = False
ElseIf (375 + k_y) < c And c <= 500 Then
p_y = p_y - 1
If k_y > -125 Then
k_y = k_y - 100
If k_y < -125 Then
k_y = -125
End If
End If
If b = False Then
k_y = 0
End If
k_x = 0
k_xy = 0
k_yx = 0
r = False
l = False
f = False
b = True
rf = False
lb = False
rb = False
lf = False
ElseIf 500 < c And c <= (625 + k_xy) Then
p_x = p_x + 1
p_y = p_y + 1
If k_xy < 125 Then
k_xy = k_xy + 100
If k_xy > 125 Then
k_xy = 125
End If
End If
If rf = False Then
k_xy = 0
End If
k_x = 0
k_y = 0
k_yx = 0
r = False
l = False
f = False
b = False
rf = True
lb = False
rb = False
lf = False
j = j + 1
ElseIf (625 + k_xy) < c And c <= 750 Then
p_x = p_x - 1
p_y = p_y - 1
If k_xy > -125 Then
k_xy = k_xy - 100
If k_xy < -125 Then
k_xy = -125
End If
End If
If lb = False Then
k_xy = 0
End If
k_x = 0
k_y = 0
k_yx = 0
r = False
l = False
f = False
b = False
rf = False
lb = True
rb = False
lf = False
j = j + 1
ElseIf 750 < c And c <= (875 + k_yx) Then
p_x = p_x + 1
p_y = p_y - 1
If k_yx < 125 Then
k_yx = k_yx + 100
If k_yx > 125 Then
k_yx = 125
End If
End If
If rb = False Then
k_yx = 0
End If
k_x = 0
k_y = 0
k_xy = 0
r = False
l = False
f = False
b = False
rf = False
lb = False
rb = True
lf = False
j = j + 1
Else
p_x = p_x - 1
p_y = p_y + 1
If k_yx > -125 Then
k_yx = k_yx - 100
If k_yx < -125 Then
k_yx = -125
End If
End If
If lf = False Then
k_yx = 0
End If
k_x = 0
k_y = 0
k_xy = 0
r = False
l = False
f = False
b = False
rf = False
lb = False
rb = False
lf = True
j = j + 1
End If
Next j
Cells(i, 1) = p_x
Cells(i, 2) = p_y
Next i
End Sub
(1)確率が1%増加する場合
(2)確率が2%増加する場合
(3)確率が5%増加する場合
(4)確率が10%増加する場合
・パチンコ玉と釘の確率・統計(まとめ記事)に戻る。



