第１８講　一般種法×末項確定法（魔方陣作成マクロVer.4）への挑戦

第１５話　最適値自動探索プログラムの実験結果による最適値とそれによる改良
12次については、現在実験中です。
試行回数の設定が５００００では結果が出なかったので、
１０００００に設定し直して実験しています。
実験結果が出るのに半日かかるので、それを待つしかありませんので、
12次については明日以降と言うことになります。
試行回数とは、プログラムコードの
If sk > 3000 Then Exit Sub
のskです。下の実験結果をご覧になればお分かりのように、６次までなら設定値は５０で済むことになります。
この設定値を大きくすると時間がかかりますので、次数に応じて設定値を変更する必要があります。

11次までの実験結果をお見せしましょう。

尚、９〜１１次においては実験を途中で打ち切ったので、for文は１００００までは試していません。
For c = 1 To 10000
　　　　h = 0
　　　　kz = 0
　　　　If n = 4 Then kk = 1
　　　　If n = 5 Then kk = 3
　　　　If n = 6 Then kk = 1
　　　　If n = 7 Then kk = 5
　　　　If n = 8 Then kk = 3
　　　　If n = 9 Then kk = 5
　　　　If n = 10 Then kk = 3
　　　　If n = 11 Then kk = 10
　　　　If n = 12 Then kk = 3
　　　　For d = 0 To kk
　　　　　　For e = 0 To kk
　　　　　　　　syokika
　　　　　　　　Randomize (c)
　　　　　　　　ms1 (0)
　　　　　　　　If cn = 1 Then h = 1
　　　　　　Next
　　　　Next
　　　　If h = 1 Then
　　　　　　Cells(6 + kz2, 1) = c
　　　　　　kz2 = kz2 + 1
　　　　End If
Next
１０次からは、for文のどこまで進行したか表示するようにプログラムを変更しましたが、
その値を見るのを忘れて次の実験に入ってしまいましたので、
いくつまでの実験結果は報告できません。11次は９０００ぐらいで打ち切りました。
１１次はほぼ最後まで実験しましたから、最小試行回数は１万回程度でしょうが、
９次と１０次に関しては、表の値より小さい可能性があります。
実験結果で驚きは、６次までの最小試行回数です。
４次に至っては、最適シード値と最適素な数による結果はなんと０です。
ということは、ストレートに４次魔方陣ができたということです。
試行回数０、適当に入れていったら行ったり来たりせず一発で答えが出てしまったわけです。
これはかなりの幸運といえます。

最適素な数1 と 最適素な数2 とは、下のコードの iii = (ii + ss * i) Mod n のssです。
何と素な関係にあるかと申しますと、ｎとです。
例えば、ｎ＝１０のときは、ｎと素な数は１，３，７，９です。
１０と素な数とは、１０と共通の約数が１である数です。
ssが素な数である場合 iii = (ii + ss * i) Mod n はすべての場合を網羅します。
ｎ＝１０，ｓｓ＝３，ｉｉ＝６でトレースしてみましょう。
ｉを０から９まで変えていくと、
ｉｉｉ＝（６＋３＊０） Ｍｏｄ １０＝６
ｉｉｉ＝（６＋３＊１） Ｍｏｄ １０＝９
ｉｉｉ＝（６＋３＊２） Ｍｏｄ １０＝２
ｉｉｉ＝（６＋３＊３） Ｍｏｄ １０＝５
ｉｉｉ＝（６＋３＊４） Ｍｏｄ １０＝８
ｉｉｉ＝（６＋３＊５） Ｍｏｄ １０＝１
ｉｉｉ＝（６＋３＊６） Ｍｏｄ １０＝４
ｉｉｉ＝（６＋３＊７） Ｍｏｄ １０＝７
ｉｉｉ＝（６＋３＊８） Ｍｏｄ １０＝０
ｉｉｉ＝（６＋３＊９） Ｍｏｄ １０＝３
６，９，２，５，８，１，４，７，０，３と０から９まで確かにすべて重複なしに網羅しています。
しかも、現れ方はかなりランダムのように見えます（実際は３飛びに規則的）。
皆さん、１０と素な関係にない４などでトレースしてみてください。
すると、重複なしに網羅していないことがわかります。
１０と素な数でない２，４，５，６，８はすべて重複なしに網羅するの条件を満たしません。

実験結果によるVer.4の改良コードをお見せします。
改良部分を紺で示しておきます。
Dim mah1(12, 12) As Byte, mah2(12, 12) As Byte, x(144) As Byte, y(144) As Byte, p1(144) As Byte, p2(144) As Byte, a(12, 12) As Integer
Dim th(12, 12) As Byte
Dim n As Byte, cn As Integer, gk As Integer, tm As Byte
Private Sub CommandButton1_Click()
　　Dim i, j As Integer
　　n = Cells(3, 8)
　　syokika
　　zhy
　　zhy1 (0)
　　'zhykakunin
　　syokika1
　　ms1 (0)
End Sub
Sub syokika()
　　Dim i As Byte
　　Dim j As Byte
　　For i = 0 To n - 1
　　　　p1(i) = 0
　　　　p2(i) = 0
　　　　For j = 0 To n - 1
　　　　　　th(i, j) = 0
　　　　Next
　　Next
　　tm = 0
　　sk = 0
　　cn = 0
　　gk = n
　　For i = 0 To n - 1
　　　　For j = 0 To n - 1
　　　　　　a(i, j) = -1
　　　　Next
　　Next
End Sub
Sub syokika1()
　　Dim i As Byte
　　Dim j As Byte
　　For i = 0 To n - 1
　　　　For j = 0 To n - 1
　　　　　　mah1(i, j) = 0
　　　　　　mah2(i, j) = 0
　　　　Next
　　Next
　　Rnd (-1)
　　If n = 4 Then Randomize (6763)
　　If n = 5 Then Randomize (6601)
　　If n = 6 Then Randomize (5084)
　　If n = 7 Then Randomize (9362)
　　If n = 8 Then Randomize (6337)
　　If n = 9 Then Randomize (5104)
　　If n = 10 Then Randomize (1763)
　　If n = 11 Then Randomize (436)
End Sub

Sub zhy()

　　Dim i As Byte
　　
　　For i = 0 To n - 1
　　　　a(i, i) = i
　　Next
　　For i = 0 To n - 1
　　　　If a(i, n - 1 - i) = -1 Then
　　　　　　a(i, n - 1 - i) = gk
　　　　　　gk = gk + 1
　　　　End If
　　Next
　　
End Sub
Sub zhy1(g As Byte)
　　Dim i As Byte
　　For i = g + 1 To n - 1
　　　　If a(g, i) = -1 Then
　　　　　　a(g, i) = gk
　　　　　　gk = gk + 1
　　　　End If
　　Next
　　zhy2 (g)
　　If tm = 1 Then Exit Sub
End Sub
Sub zhy2(g As Byte)
　　Dim i As Byte
　　Dim j As Byte
　　For i = g + 1 To n - 1
　　　　If a(i, g) = -1 Then
　　　　　　a(i, g) = gk
　　　　　　gk = gk + 1
　　　　End If
　　Next
　　If g + 1 < n Then
　　　　zhy1 (g + 1)
　　　　If tm = 1 Then Exit Sub
　　Else
　　　　For i = 0 To n - 1
　　　　　　For j = 0 To n - 1
　　　　　　　　y(a(i, j)) = i
　　　　　　　　x(a(i, j)) = j
　　　　　　Next
　　　　Next
　　　　tm = 1
　　　　Exit Sub
　　End If
　　　　
End Sub

Sub zhykakunin()
　　Dim i As Byte
　　
　　For i = 0 To n * n - 1
　　　　Cells(5 + y(i), 1 + x(i)) = i
　　Next
　　
End Sub

Sub ms1(g As Byte)

　　Dim i As Integer, j As Byte, k As Byte, a As Byte, b As Byte, w As Integer, sa As Integer, h As Byte
　　Dim ii As Integer, iii As Integer, kk As Byte

　　a = x(g)
　　b = y(g)
　　If a = n - 1 And b = n - 1 Then
　　　　w = 0
　　　　For i = 0 To n - 2
　　　　　　w = w + mah1(i, i)
　　　　Next
　　　　sa = Int(n * (n - 1) / 2) - w
　　　　If sa < 0 Or sa > (n - 1) Then Exit Sub
　　　　If p1(sa) >= n Then Exit Sub
　　　　mah1(b, a) = sa
　　　　p1(sa) = p1(sa) + 1
　　　　ms1 (g + 1)
　　　　p1(sa) = p1(sa) - 1
　　　　Exit Sub
　　End If
　　If a = 0 And b = n - 1 Then
　　　　w = 0
　　　　For i = 0 To n - 2
　　　　　　w = w + mah1(i, n - 1 - i)
　　　　Next
　　　　sa = Int(n * (n - 1) / 2) - w
　　　　If sa < 0 Or sa > (n - 1) Then Exit Sub
　　　　If p1(sa) >= n Then Exit Sub
　　　　mah1(b, a) = sa
　　　　p1(sa) = p1(sa) + 1
　　　　ms1 (g + 1)
　　　　p1(sa) = p1(sa) - 1
　　　　Exit Sub
　　End If
　　If a = n - 2 And b = 0 Then
　　　　w = 0
　　　　For i = 0 To n - 3
　　　　　　w = w + mah1(b, i)
　　　　Next
　　　　w = w + mah1(b, n - 1)
　　　　sa = Int(n * (n - 1) / 2) - w
　　　　If sa < 0 Or sa > (n - 1) Then Exit Sub
　　　　If p1(sa) >= n Then Exit Sub
　　　　mah1(b, a) = sa
　　　　p1(sa) = p1(sa) + 1
　　　　ms1 (g + 1)
　　　　p1(sa) = p1(sa) - 1
　　　　Exit Sub
　　End If
　　If a = 0 And b = n - 2 Then
　　　　w = 0
　　　　For i = 0 To n - 3
　　　　　　w = w + mah1(i, a)
　　　　Next
　　　　w = w + mah1(n - 1, a)
　　　　sa = Int(n * (n - 1) / 2) - w
　　　　If sa < 0 Or sa > (n - 1) Then Exit Sub
　　　　If p1(sa) >= n Then Exit Sub
　　　　mah1(b, a) = sa
　　　　p1(sa) = p1(sa) + 1
　　　　ms1 (g + 1)
　　　　p1(sa) = p1(sa) - 1
　　　　Exit Sub
　　End If
　　If a = n - 1 And b > 0 And b < n - 1 Then
　　　　w = 0
　　　　For i = 0 To n - 2
　　　　　　w = w + mah1(b, i)
　　　　Next
　　　　sa = Int(n * (n - 1) / 2) - w
　　　　If sa < 0 Or sa > (n - 1) Then Exit Sub
　　　　If p1(sa) >= n Then Exit Sub
　　　　mah1(b, a) = sa
　　　　p1(sa) = p1(sa) + 1
　　　　ms1 (g + 1)
　　　　p1(sa) = p1(sa) - 1
　　　　Exit Sub
　　End If
　　If a > 0 And a < n - 1 And b = n - 1 Then
　　　　w = 0
　　　　For i = 0 To n - 2
　　　　　　w = w + mah1(i, a)
　　　　Next
　　　　sa = Int(n * (n - 1) / 2) - w
　　　　If sa < 0 Or sa > (n - 1) Then Exit Sub
　　　　If p1(sa) >= n Then Exit Sub
　　　　mah1(b, a) = sa
　　　　p1(sa) = p1(sa) + 1
　　　　If g + 1 < n * n Then
　　　　　　ms1 (g + 1)
　　　　Else
　　　　　　ms2 (0)
　　　　End If
　　　　p1(sa) = p1(sa) - 1
　　　　Exit Sub
　　End If
　　
　　ii = n * Rnd
　　Dim ss As Byte
　　If n = 4 Then ss = 1
　　If n = 5 Then ss = 3
　　If n = 6 Then ss = 5
　　If n = 7 Then ss = 3
　　If n = 8 Then ss = 1
　　If n = 9 Then ss = 4
　　If n = 10 Then ss = 9
　　If n = 11 Then ss = 6
　　For i = 0 To n - 1
　　　　iii = (ii + ss * i) Mod n
　　　　mah1(b, a) = iii
　　　　h = 0
　　　　If p1(mah1(b, a)) >= n Then GoTo tobi
　　　　p1(mah1(b, a)) = p1(mah1(b, a)) + 1
　　　　h = 1
　　　　ms1 (g + 1)
tobi:
　　　　If h = 1 Then p1(mah1(b, a)) = p1(mah1(b, a)) - 1
　　Next
End Sub
Sub ms2(g As Byte)
　　Dim i As Integer, j As Byte, k As Byte, a As Byte, b As Byte, w As Integer, sa As Integer, h As Byte
　　Dim ii As Integer, iii As Integer, kk As Byte, hs As Integer
　　a = x(g)
　　b = y(g)
　　hs = mah1(b, a)
　　If a = n - 1 And b = n - 1 Then
　　　　w = 0
　　　　For i = 0 To n - 2
　　　　　　w = w + mah2(i, i)
　　　　Next
　　　　sa = Int(n * (n - 1) / 2) - w
　　　　If sa < 0 Or sa > (n - 1) Then Exit Sub
　　　　If th(mah1(b, a), sa) = 1 Then Exit Sub
　　　　If p2(sa) >= n Then Exit Sub
　　　　mah2(b, a) = sa
　　　　p2(sa) = p2(sa) + 1
　　　　th(mah1(b, a), mah2(b, a)) = 1
　　　　ms2 (g + 1)
　　　　p2(sa) = p2(sa) - 1
　　　　th(mah1(b, a), mah2(b, a)) = 0
　　　　Exit Sub
　　End If
　　If a = 0 And b = n - 1 Then
　　　　w = 0
　　　　For i = 0 To n - 2
　　　　　　w = w + mah2(i, n - 1 - i)
　　　　Next
　　　　sa = Int(n * (n - 1) / 2) - w
　　　　If sa < 0 Or sa > (n - 1) Then Exit Sub
　　　　If th(mah1(b, a), sa) = 1 Then Exit Sub
　　　　If p2(sa) >= n Then Exit Sub
　　　　mah2(b, a) = sa
　　　　p2(sa) = p2(sa) + 1
　　　　th(mah1(b, a), mah2(b, a)) = 1
　　　　ms2 (g + 1)
　　　　p2(sa) = p2(sa) - 1
　　　　th(mah1(b, a), mah2(b, a)) = 0
　　　　Exit Sub
　　End If
　　If a = n - 2 And b = 0 Then
　　　　w = 0
　　　　For i = 0 To n - 3
　　　　　　w = w + mah2(b, i)
　　　　Next
　　　　w = w + mah2(b, n - 1)
　　　　sa = Int(n * (n - 1) / 2) - w
　　　　If sa < 0 Or sa > (n - 1) Then Exit Sub
　　　　If th(mah1(b, a), sa) = 1 Then Exit Sub
　　　　If p2(sa) >= n Then Exit Sub
　　　　mah2(b, a) = sa
　　　　p2(sa) = p2(sa) + 1
　　　　th(mah1(b, a), mah2(b, a)) = 1
　　　　ms2 (g + 1)
　　　　p2(sa) = p2(sa) - 1
　　　　th(mah1(b, a), mah2(b, a)) = 0
　　　　Exit Sub
　　End If
　　If a = 0 And b = n - 2 Then
　　　　w = 0
　　　　For i = 0 To n - 3
　　　　　　w = w + mah2(i, a)
　　　　Next
　　　　w = w + mah2(n - 1, a)
　　　　sa = Int(n * (n - 1) / 2) - w
　　　　If sa < 0 Or sa > (n - 1) Then Exit Sub
　　　　If th(mah1(b, a), sa) = 1 Then Exit Sub
　　　　If p2(sa) >= n Then Exit Sub
　　　　mah2(b, a) = sa
　　　　p2(sa) = p2(sa) + 1
　　　　th(mah1(b, a), mah2(b, a)) = 1
　　　　ms2 (g + 1)
　　　　p2(sa) = p2(sa) - 1
　　　　th(mah1(b, a), mah2(b, a)) = 0
　　　　Exit Sub
　　End If
　　If a = n - 1 And b > 0 And b < n - 1 Then
　　　　w = 0
　　　　For i = 0 To n - 2
　　　　　　w = w + mah2(b, i)
　　　　Next
　　　　sa = Int(n * (n - 1) / 2) - w
　　　　If sa < 0 Or sa > (n - 1) Then Exit Sub
　　　　If th(mah1(b, a), sa) = 1 Then Exit Sub
　　　　If p2(sa) >= n Then Exit Sub
　　　　mah2(b, a) = sa
　　　　p2(sa) = p2(sa) + 1
　　　　th(mah1(b, a), mah2(b, a)) = 1
　　　　ms2 (g + 1)
　　　　p2(sa) = p2(sa) - 1
　　　　th(mah1(b, a), mah2(b, a)) = 0
　　　　Exit Sub
　　End If
　　If a > 0 And a < n - 1 And b = n - 1 Then
　　　　w = 0
　　　　For i = 0 To n - 2
　　　　　　w = w + mah2(i, a)
　　　　Next
　　　　sa = Int(n * (n - 1) / 2) - w
　　　　If sa < 0 Or sa > (n - 1) Then Exit Sub
　　　　If th(mah1(b, a), sa) = 1 Then Exit Sub
　　　　If p2(sa) >= n Then Exit Sub
　　　　mah2(b, a) = sa
　　　　p2(sa) = p2(sa) + 1
　　　　th(mah1(b, a), mah2(b, a)) = 1
　　　　If g + 1 < n * n Then
　　　　　　ms2 (g + 1)
　　　　Else
　　　　　　For j = 0 To n - 1
　　　　　　　　For k = 0 To n - 1
　　　　　　　　　　Cells(6 + k + Int(cn / 10) * (n + 1), 1 + j + (cn Mod 10) * (n + 1)) = n * mah1(j, k) + mah2(j, k) + 1
　　　　　　　　Next
　　　　　　Next
　　　　　　cn = cn + 1
　　　　　　Cells(4, 12) = cn
　　　　End If
　　　　p2(sa) = p2(sa) - 1
　　　　th(mah1(b, a), mah2(b, a)) = 0
　　　　Exit Sub
　　End If
　　ii = n * Rnd
　　Dim ss As Byte
　　If n = 4 Then ss = 3
　　If n = 5 Then ss = 1
　　If n = 6 Then ss = 1
　　If n = 7 Then ss = 3
　　If n = 8 Then ss = 3
　　If n = 9 Then ss = 1
　　If n = 10 Then ss = 9
　　If n = 11 Then ss = 6
　　For i = 0 To n - 1
　　　　iii = (ii + ss * i) Mod n
　　　　mah2(b, a) = iii
　　　　h = 0
　　　　If p2(mah2(b, a)) >= n Then GoTo tobi
　　　　If th(mah1(b, a), mah2(b, a)) = 1 Then GoTo tobi
　　　　p2(mah2(b, a)) = p2(mah2(b, a)) + 1
　　　　th(mah1(b, a), mah2(b, a)) = 1
　　　　h = 1
　　　　ms2 (g + 1)
tobi:
　　　　If h = 1 Then
　　　　　　p2(mah2(b, a)) = p2(mah2(b, a)) - 1
　　　　　　th(mah1(b, a), mah2(b, a)) = 0
　　　　End If
　　Next
End Sub

Private Sub CommandButton2_Click()
　　Rows("5:2000").Select
　　Selection.ClearContents
　　Cells(4, 12).Select
　　Selection.ClearContents
　　Cells(1, 1).Select
End Sub

ダウンロード用参考ファイル

ダウンロード用ファイルをクリックして、改良によってとても速くなったことを体感して下さい。
さて、皆さん時間を計測できるようにさらに改善しましょう。

第１４話へ　第１６話へ

　　

VBA講義第１部へ
vc++講義へ
vb講義へ
ＶＢ講義基礎へ
初心者のための世界で一番わかりやすいVisual C++入門基礎講座へ
初心者のための世界で一番わかりやすいVisual Basic入門基礎講座へ

数学研究室に戻る