第17講 末項確定法(魔方陣作成マクロVer.3)への挑戦

第3話 末項確定法版自動実験とVer.3完成コード
コード例
Dim mah(6, 6) As Byte, x(36) As Byte, y(36), sh(20) As Byte, d 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, j As Integer
  n = Cells(3, 8)
  If n = 4 Then         
    sh(0) = 1
    sh(1) = 3
    sh(2) = 5
    sh(3) = 7
    sh(4) = 9
    sh(5) = 11
    sh(6) = 13
    sh(7) = 15
  End If
  If n = 5 Then
    sh(0) = 1
    sh(1) = 2
    sh(2) = 3
    sh(3) = 4
    sh(4) = 6
    sh(5) = 7
    sh(6) = 8
    sh(7) = 9
    sh(8) = 11
    sh(9) = 12
    sh(10) = 13
    sh(11) = 14
    sh(12) = 16
    sh(13) = 17
    sh(14) = 18
    sh(15) = 19
    sh(16) = 21
    sh(17) = 22
    sh(18) = 23
    sh(19) = 24
  End If
  If n = 6 Then
   sh(0) = 1
   sh(1) = 5
   sh(2) = 7
   sh(3) = 11
   sh(4) = 13
   sh(5) = 17
   sh(6) = 19
   sh(7) = 23
   sh(8) = 25
   sh(9) = 29
   sh(10) = 31
   sh(11) = 35
  End If              

  zhy
  kz2 = 0
  For c = 1 To 10000
    h = 0
    If n = 4 Then kk = 7
    If n = 5 Then kk = 19
    If n = 6 Then kk = 11
    kz = 0
    For d = 0 To kk
      sk = 0
      cn = 0
      Rnd (-1)          '乱数系列の初期化、これがないとRandomizeで番号を指定しても反映されない。
      Randomize (c)       '乱数系列の指定。Rnd(-1)とセットで使う。
      ms (0)
      If cn = 1 Then h = 1
    Next
    If h = 1 Then
      Cells(5 + kz2, 1) = c
      kz2 = kz2 + 1  '行位置調整
    End If
  Next

End Sub
        ・
        ・
        ・
Sub ms(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 + mah(i, i)
    Next
    sa = Int(n * (n * n + 1) / 2) - w
    If sa < 1 Or sa > n * n Then Exit Sub
    If p(sa - 1) = 1 Then Exit Sub
    mah(b, a) = sa
    p(sa - 1) = 1
    ms (g + 1)
    p(sa - 1) = 0
    Exit Sub
  End If
  If a = 0 And b = n - 1 Then
    w = 0
    For i = 0 To n - 2
      w = w + mah(i, n - 1 - i)
    Next
    sa = Int(n * (n * n + 1) / 2) - w
    If sa < 1 Or sa > n * n Then Exit Sub
    If p(sa - 1) = 1 Then Exit Sub
    mah(b, a) = sa
    p(sa - 1) = 1
    ms (g + 1)
    p(sa - 1) = 0
    Exit Sub
  End If
  If a = n - 2 And b = 0 Then
    w = 0
    For i = 0 To n - 3
      w = w + mah(b, i)
    Next
    w = w + mah(b, n - 1)
    sa = Int(n * (n * n + 1) / 2) - w
    If sa < 1 Or sa > n * n Then Exit Sub
    If p(sa - 1) = 1 Then Exit Sub
    mah(b, a) = sa
    p(sa - 1) = 1
    ms (g + 1)
    p(sa - 1) = 0
    Exit Sub
  End If
  If a = 0 And b = n - 2 Then
    w = 0
    For i = 0 To n - 3
      w = w + mah(i, a)
    Next
    w = w + mah(n - 1, a)
    sa = Int(n * (n * n + 1) / 2) - w
    If sa < 1 Or sa > n * n Then Exit Sub
    If p(sa - 1) = 1 Then Exit Sub
    mah(b, a) = sa
    p(sa - 1) = 1
    ms (g + 1)
    p(sa - 1) = 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 + mah(b, i)
    Next
    sa = Int(n * (n * n + 1) / 2) - w
    If sa < 1 Or sa > n * n Then Exit Sub
    If p(sa - 1) = 1 Then Exit Sub
    mah(b, a) = sa
    p(sa - 1) = 1
    ms (g + 1)
    p(sa - 1) = 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 + mah(i, a)
    Next
    sa = Int(n * (n * n + 1) / 2) - w
    If sa < 1 Or sa > n * n Then Exit Sub
    If p(sa - 1) = 1 Then Exit Sub
    mah(b, a) = sa
    p(sa - 1) = 1
    If g + 1 < n * n Then
      ms (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)) = mah(j, k)
        'Next
      'Next
      cn = cn + 1
      
Cells(5 + kz2, 3 + 2 * kz) = sh(d)   'dではなくsh(d)を表示するように変更、こうしないとsh(3) = 11等によっていちいち翻訳が必要になる。
      Cells(5 + kz2, 4 + 2 * kz) = sk
      
If sk < min Then              '最小値を実行画面の中から探さなくてもよいように変更。
        min = sk
        Cells(1, 6) = min
        Cells(2, 6) = c
        Cells(3, 6) = sh(d)
      End If

      kz = kz + 1
      If cn = 1 Then Exit Sub
    End If
    p(sa - 1) = 0
    Exit Sub
  End If
          ・
          ・
          ・
      For j = 0 To n - 1
        w = w + mah(j, a)
      Next
      If w <> Int(n * (n * n + 1) / 2) Then GoTo tobi
    End If
    ms (g + 1)
tobi:
    If h = 1 Then p(mah(b, a) - 1) = 0
  Next

End Sub
実行画面例
c++

実験をもとに完成したVer.3のコード
Dim mah(6, 6) As Byte, x(36) As Byte, y(36) As Byte, p(36) As Byte
Dim n As Byte, cn As Integer
Private Sub CommandButton1_Click()
  Dim i, j As Integer
  n = Cells(3, 8)
  Rnd (-1)
  
If n = 4 Then Randomize (425)
  If n = 5 Then Randomize (24)
  If n = 6 Then Randomize (4768)

  syokika
  zhy
  ms (0)
End Sub
         ・
         ・
         ・
Sub ms(g As Byte)
         ・
         ・
         ・
  If a > 0 And a < n - 1 And b = n - 1 Then
    w = 0
    For i = 0 To n - 2
       w = w + mah(i, a)
    Next
    sa = Int(n * (n * n + 1) / 2) - w
    If sa < 1 Or sa > n * n Then Exit Sub
    If p(sa - 1) = 1 Then Exit Sub
    mah(b, a) = sa
    p(sa - 1) = 1
    If g + 1 < n * n Then
      ms (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)) = mah(j, k)
        Next
      Next
      cn = cn + 1
      Cells(4, 12) = cn
    End If
    p(sa - 1) = 0
    Exit Sub
  End If

  ii = n * n * Rnd
  
If n = 4 Then kk = 3
  If n = 5 Then kk = 13
  If n = 6 Then kk = 11
  If n = 3 Then kk = 1

  For i = 0 To n * n - 1
    iii = (ii + kk * i) Mod n * n
          ・
          ・
          ・
  Next

End Sub


完成Ver.3ファイル


さて、Ver.3が完成しました。
Ver.2とVer.3のそれぞれについて時間計測が出来るようにして、
どのぐらい速くなったかを確認しましょう。
コードを考えましょう。






第2話へ 第4話へ

004
  

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

数学研究室に戻る