第23講 数独を解くソフトVer.1の制作
第12話 予想だにしない結末
厳しい順に入力していって、Ver.1完成のはずだったのですが・・・・
Ver.1となるはずだったコード
Dim m(9, 9) As Byte, cn As Byte, onf(9, 9, 9) As Byte, ls(9, 9, 9) As Byte, lcn(9, 9) As Byte
Dim khs As Byte, yk(81) As Byte, xk(81) As Byte, tm As Byte
Private Sub CommandButton1_Click()
  hj = Timer
  tm = 0
  cn = 0
  dainyuu
  kouzoukaiseki
  'hyouji
  zahyousakusei (0)
  'hyouji2
  f (0)
  ow = Timer
  Cells(6, 12) = "作成時間は"
  Cells(6, 13) = ow - hj
  Cells(6, 14) = "秒です。"
End Sub
Sub dainyuu()
  Dim i As Byte, j As Byte
  For i = 0 To 8
    For j = 0 To 8
      m(i, j) = Cells(3 + i, 2 + j)
    Next
  Next
  For i = 0 To 8
    For j = 0 To 8
      If m(i, j) < 1 Then
        m(i, j) = 0
      End If
    Next
  Next

End Sub
Sub kouzoukaiseki()
  Dim i As Byte, j As Byte, k As Byte, l As Byte, si As Byte, sj As Byte
  khs = 0
  For i = 0 To 8
    For j = 0 To 8
      If m(i, j) = 0 Then
        yk(khs) = i
        xk(khs) = j
        khs = khs + 1
        For k = 0 To 8
          onf(i, j, k) = 1
        Next
        For k = 0 To 8
          If m(i, k) > 0 Then onf(i, j, m(i, k) - 1) = 0
        Next
        For k = 0 To 8
          If m(k, j) > 0 Then onf(i, j, m(k, j) - 1) = 0
        Next
        si = Int(i / 3)
        sj = Int(j / 3)
        For k = 0 To 2
          For l = 0 To 2
            If 3 * si + k <> i And 3 * sj + l <> j Then If m(3 * si + k, 3 * sj + l) > 0 Then onf(i, j, m(3 * si + k, 3 * sj + l) - 1) = 0
          Next
        Next
      End If
      lcn(i, j) = 0
      For k = 0 To 8
        If onf(i, j, k) = 1 Then
          ls(i, j, lcn(i, j)) = k + 1
          lcn(i, j) = lcn(i, j) + 1
        End If
      Next
    Next
  Next
End Sub
Sub hyouji()
  Dim i As Byte, j As Byte, k As Byte
  For i = 0 To 8
    For j = 0 To 8
      If m(i, j) = 0 Then Cells(13 + i, 2 + j) = lcn(i, j)
      If m(i, j) > 0 Then Cells(13 + i, 2 + j) = "*"
    Next
  Next
End Sub
Sub zahyousakusei(g As Byte)
  Dim i As Byte, j As Byte, w As Byte, min As Byte, ik As Byte, jk As Byte, k As Byte
  min = 10
  
  For i = g To khs - 1
    If lcn(yk(i), xk(i)) < min Then
      min = lcn(yk(i), xk(i))
      ik = yk(i)
      jk = xk(i)
      k = i
    End If
  Next
  w = yk(g)
  yk(g) = ik
  yk(k) = w
  w = xk(g)
  xk(g) = jk
  xk(k) = w
  If g + 1 < khs - 1 Then
    zahyousakusei (g + 1)
    If tm = 1 Then Exit Sub
  Else
    tm = 1
    Exit Sub
  End If
End Sub
Sub hyouji2()
  Dim i As Byte, j As Byte, k As Byte
  For i = 0 To khs - 1
    Cells(13 + yk(i), 2 + xk(i)) = i
  Next
End Sub
Sub f(g As Integer)
  Dim x As Byte, y As Byte
  Dim i, j, k, zy, zx As Byte
  y = yk(g)
  x = xk(g)
  If m(x, y) > 0 Then
    If g + 1 < 81 Then
      f (g + 1)
    Else
      For j = 0 To 8
        For k = 0 To 8
          Cells(13 + j, 2 + k) = m(j, k)
        Next
      Next
      cn = cn + 1
      If cn = 1 Then Exit Sub
    End If
    Exit Sub
  End If
  Dim xa As Byte, ya As Byte, xs As Byte, ys As Byte, kk As Byte, kkk As Byte
  xa = x Mod 3
  ya = y Mod 3
  xs = Int(x / 3)
  ys = Int(y / 3)
  kk = 9 * Rnd()
  For i = 1 To 9
    kkk = (kk + 4 * i) Mod 9 + 1
    m(x, y) = kkk
    
    For j = 0 To 8
      If j <> x Then
        If m(x, y) = m(j, y) Then GoTo tobi
      End If
    Next
   
    For j = 0 To 8
      If j <> y Then
        If m(x, y) = m(x, j) Then GoTo tobi
      End If
    Next
    For j = 0 To 2
      For k = 0 To 2
        If 3 * xs + j <> x And 3 * ys + k <> y Then
          If m(x, y) = m(3 * xs + j, 3 * ys + k) Then GoTo tobi
        End If
      Next
    Next
    If g + 1 < 81 Then
      f (g + 1)
    Else
      For j = 0 To 8
        For k = 0 To 8
          Cells(13 + j, 2 + k) = m(j, k)
        Next
      Next
      cn = cn + 1
      If cn = 1 Then Exit Sub
    End If
    If cn = 1 Then Exit Sub
tobi:
  Next
  m(x, y) = 0Private Sub CommandButton2_Click()
  'Rows("3:11").Select
  'Selection.ClearContents
  Rows("13:32").Select
  Selection.ClearContents
  Cells(2, 1).Select
End Sub

次の2つダウンロード用ファイルを開いてください。
ダウンロード用参考ファイルVer.0時間計測版版
ダウンロード用参考ファイルVer.1もどき時間計測版版

2つは新次元難問数独自動生成ソフトVer.1
の作らせた100題の難問を解かせたときの1題あたりの解答時間を計測するものです。。
Ver.0では数独という結果であり、
Ver.1もどきでは問題構造解析
残念ながらVer.0の圧倒です。
約4倍速いという結果です。
ウーン、これはどういうことでしょうか。
ランダムを使っているので、1,2題での逆転はあり得るでしょうが、
100題の平均です。
どうして、Ver.0の方が圧倒的に速いのでしょうか。

いろいろ調べましたが、原因は不明です。
例えば、問題構造解析とランク付けが重すぎて、逆転してしまう可能性を考えましたが、
両者にコンピュータが掛けている時間はせいぜい1題あたり平均で0.04秒程度にすぎません。
Ver.0の1題平均が約0.4秒ですから、
1/10遅れてのスタートですが、逆転は可能なはずです。
場合の数は、厳しい順に追う方が圧倒的に少ないのですから。

前に、ソフトを作ったときは条件が厳しい順にやった方が圧倒的に速かったのですが。
まさに、???です。
皆さんにお知恵をお借りしたいと思います。

とりあえず、ランク付け順に行くことは諦めて、
問題構造解析のもう一つの果実、リスト内容の把握の方を利用してVer.1の完成とします。
実際に、Ver.0よりかなり速くなりました。
1個あたりの平均が0.184523805975914秒です。4.4/1.8=約2.4倍です。

今回は失敗しましたが、ランク付けは改良して後のバージョンで使いますので、
残しておいてください。

第11話へ 第13話へ

004
  


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

数学研究室に戻る