第18講 一般種法×末項確定法(魔方陣作成マクロVer.4)への挑戦

第13話 最適値自動探索プログラムの奇妙な振る舞い
実は、昨日最適な値を自動探索するプログラムを半日試行錯誤しましたが、
不完全なものしかできませんでした。
不完全というのは、どういう訳かボタンを押しても1回目は何も打ち出さず、
1回目が終了してからボタンを押すと何回でも結果を打ち出すという謎と6次あたりで、
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
p1(sa) = p1(sa) - 1でオーバーフローが指摘される謎が解明できませんでした。
前半の謎も本当に見当もつきませんが、
  p1(sa) = p1(sa) + 1
  ms1 (g + 1)
  p1(sa) = p1(sa) - 1
p1(sa)が0になる道理はないと思うのですが、0になるためのオーバーフローが指摘されるのも理解しがたいことです。
直前に1を加えているのですから、不思議です。
セルが進んだ段階で0になる可能性があるのではとお思いになるかもしれませんが、
どのこのセルでも p1(sa) = p1(sa) + 1 と p1(sa) = p1(sa) - 1 はセットになっており、
必ずp1(sa) = p1(sa) + 1の操作が先に行われており、どう考えても0になる可能性は考えられません。
他の次数(確か5次と記憶しますが)では、
  ii = n * Rnd
  For i = 0 To n - 1
    iii = (ii + sh(d) * 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)
    sk = sk + 1
tobi:
    If h = 1 Then p1(mah1(b, a)) = p1(mah1(b, a)) - 1
    If cn = 1 Then Exit Sub
    If sk > 2000 Then Exit Sub
  Next
End Sub
If h = 1 Then p1(mah1(b, a)) = p1(mah1(b, a)) - 1でオーバーフローしてきされ、
p1(mah1(b, a)の値を見ると0になっていましたが、こちらでもp1(mah1(b, a)) = p1(mah1(b, a)) + 1が実行されたときのみに
p1(mah1(b, a)) - 1の命令を遂行するようになっており、すべてのセルで同様ですから不思議としか言いようがありません。
そもそもp1(sa)やp1(mah1(b, a)) が0になってしまっていたら、Ver.4自体が動きません。
しかし、何度条件を変えて実行しても3次から10次まで全く問題なく動くのですから、
奇妙奇天烈摩訶不思議です。
仕方なく、
If p1(sa) > 0 Then p1(sa) = p1(sa) - 1やIf h = 1 Then If p1(mah1(b, a)) > 0 Then p1(mah1(b, a)) = p1(mah1(b, a)) - 1
として、各次2回ずつ実験することによって実験値をえることが出来ましたが、非常に気持ちが悪いわけです。

不十分ながら、今回コードをお見せするのは、皆さんにも知恵を貸したいただきたいからです。
是非、2つの謎の解明につからを貸してください。

最適地探索プログラムコード例
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 gk As Integer, tm As Byte
Dim sh(10) As Byte, sh1(10) As Byte, d As Byte, e As Byte, p(36) As Byte, min As Integer
Dim n As Byte, cn As Integer
Dim sk As Long, c As Long
Dim kz As Byte, kz2 As Integer
Private Sub CommandButton1_Click()
  Dim i As Integer, j As Integer, kk As Byte
  min = 10000
  n = Cells(3, 8)
  If n = 4 Then
    sh(0) = 1
    sh(1) = 3
  End If
  If n = 5 Then
    sh(0) = 1
    sh(1) = 2
    sh(2) = 3
    sh(3) = 4
  End If
  If n = 6 Then
    sh(0) = 1
    sh(1) = 5
  End If
  If n = 7 Then
    sh(0) = 1
    sh(1) = 2
    sh(2) = 3
    sh(3) = 4
    sh(4) = 5
    sh(5) = 6
  End If
  If n = 8 Then
    sh(0) = 1
    sh(1) = 3
    sh(2) = 5
    sh(3) = 7
  End If
  If n = 9 Then
    sh(0) = 1
    sh(1) = 2
    sh(2) = 4
    sh(3) = 5
    sh(4) = 7
    sh(5) = 8
  End If
  If n = 10 Then
    sh(0) = 1
    sh(1) = 3
    sh(2) = 7
    sh(3) = 9
  End If
  If n = 11 Then
    sh(0) = 1
    sh(1) = 2
    sh(2) = 3
    sh(3) = 4
    sh(4) = 5
    sh(5) = 6
    sh(6) = 7
    sh(7) = 8
    sh(8) = 9
    sh(9) = 10
  End If
  If n = 12 Then
    sh(0) = 1
    sh(1) = 5
    sh(2) = 7
    sh(3) = 11
  End If
   If n = 4 Then
    sh1(0) = 1
    sh1(1) = 3
  End If
  If n = 5 Then
    sh1(0) = 1
    sh1(1) = 2
    sh1(2) = 3
    sh1(3) = 4
  End If
  If n = 6 Then
    sh1(0) = 1
    sh1(1) = 5
  End If
  If n = 7 Then
    sh1(0) = 1
    sh1(1) = 2
    sh1(2) = 3
    sh1(3) = 4
    sh1(4) = 5
    sh1(5) = 6
  End If
  If n = 8 Then
    sh1(0) = 1
    sh1(1) = 3
    sh1(2) = 5
    sh1(3) = 7
  End If
  If n = 9 Then
    sh1(0) = 1
    sh1(1) = 2
    sh1(2) = 4
    sh1(3) = 5
    sh1(4) = 7
    sh1(5) = 8
  End If
  If n = 10 Then
    sh1(0) = 1
    sh1(1) = 3
    sh1(2) = 7
    sh1(3) = 9
  End If
  If n = 11 Then
    sh1(0) = 1
    sh1(1) = 2
    sh1(2) = 3
    sh1(3) = 4
    sh1(4) = 5
    sh1(5) = 6
    sh1(6) = 7
    sh1(7) = 8
    sh1(8) = 9
    sh1(9) = 10
  End If
   If n = 12 Then
    sh1(0) = 1
    sh1(1) = 5
    sh1(2) = 7
    sh1(3) = 11
  End If
  
  syokika1
  zhy
  zhy1 (0)
  kz2 = 0
  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
        Rnd (-1)
        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
End Sub
Sub syokika1()
  Dim i As Byte
  Dim j As Byte
  For i = 0 To n - 1
    For j = 0 To n - 1
      a(i, j) = -1
    Next
  Next

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
   For i = 0 To n - 1
    For j = 0 To n - 1
      mah1(i, j) = 0
      mah2(i, j) = 0
    Next
  Next
  tm = 0
  sk = 0
  cn = 0
  gk = n

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
  If cn = 1 Then Exit Sub
  If sk > 2000 Then Exit Sub
  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)
    If p1(sa) > 0 Then 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)
    If p1(sa) > 0 Then 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)
    If p1(sa) > 0 Then 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)
    If p1(sa) > 0 Then 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)
    If p1(sa) > 0 Then 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
    If p1(sa) > 0 Then p1(sa) = p1(sa) - 1
    Exit Sub
  End If
  
  ii = n * Rnd
  For i = 0 To n - 1
    iii = (ii + sh(d) * 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)
    sk = sk + 1
   
tobi:
    If h = 1 Then If p1(mah1(b, a)) > 0 Then p1(mah1(b, a)) = p1(mah1(b, a)) - 1
    If cn = 1 Then Exit Sub
    If sk > 2000 Then Exit Sub
  Next
  mah1(b, a) = 0
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
  If cn = 1 Then Exit Sub
  If sk > 2000 Then Exit Sub
  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
      cn = cn + 1
      Cells(6 + kz2, 2 + 3 * kz) = sh(d)
      Cells(6 + kz2, 3 + 3 * kz) = sh(e)
      Cells(6 + kz2, 4 + 3 * kz) = sk
      If sk < min Then
        min = sk
        Cells(1, 7) = min
        Cells(2, 7) = c
        Cells(3, 7) = sh(d)
        Cells(4, 7) = sh1(e)
      End If
      kz = kz + 1
      If cn = 1 Then Exit Sub
    End If
    p2(sa) = p2(sa) - 1
    th(mah1(b, a), mah2(b, a)) = 0
    Exit Sub
  End If
  ii = n * Rnd
  For i = 0 To n - 1
    iii = (ii + sh(e) * 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)
    sk = sk + 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
    If cn = 1 Then Exit Sub
    If sk > 2000 Then Exit Sub
  Next
  mah2(b, a) = 0
End Sub

Private Sub CommandButton2_Click()
  Rows("6:20000").Select
  Selection.ClearContents
  Cells(4, 12).Select
  Selection.ClearContents
  Range("G1:G4").Select
  Selection.ClearContents
  Cells(1, 1).Select
End Sub

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

第12話へ 第14話へ

004
  

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

数学研究室に戻る