| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 2601 人关注过本帖
标题:用vb来计算数独的问题
取消只看楼主 加入收藏
风月
Rank: 1
等 级:新手上路
帖 子:19
专家分:0
注 册:2009-9-9
结帖率:100%
收藏
已结贴  问题点数:15 回复次数:8 
用vb来计算数独的问题
我在vb上写了一个计算数独的程序
但是按键按下后程序卡死,并且不执行按键后的内容
若将最后一段删去后,虽功能无法实现,但程序正常运行
请各位大大帮忙解惑
ps:算法可能不是很好,如果可以最好帮我优化下算法


附上程序:
(初次尝试,程序有点乱)




Dim a(81, 40, 3) As Integer



Private Sub C_Click()

Dim t1, t2 As Integer
Dim k1, k2, k3, k4 As Integer
Dim p, q As Integer
Dim n, o, r As Integer
Dim m As Integer
Dim t As Integer
Dim j As Integer
Dim t3 As Integer
Dim mm As Integer
Dim sd As Long
mm = 0
j = 0
m = 0
d = 0
'sd = Text2.Text
'For t2 = 0 To 80 'read the number
'  a(t2, 0, 0) = sd Mod 10
'  sd = Int(sd / 10)
'Next t2
'
'For t2 = 0 To 80 'display the number
'   Text1(t2).Text = a(t2, 0, 0)
'Next t2




For t2 = 0 To 80 'read and deal with the number
  a(t2, 0, m) = Text1(t2).Text
  If a(t2, 0, m) > 9 Then a(t2, 0, m) = a(t2, 0, m) / 10
  If a(t2, 0, m) <= 0 Then a(t2, 0, m) = -(2 ^ 9 - 1)
Next t2


For t2 = 0 To 80 'display
Text1(t2).Text = a(t2, 0, 0)
Next t2



kkk: '出错后,重新读取最后一次对的存档
If d = 1 Then

For t1 = 0 To 80
  a(t1, 0, 0) = a(t1, j, 0)
Next t1
For t2 = 0 To 80
  If a(t2, 0, 0) < 0 Then
    For p = 0 To 8
      If -a(t2, 0, 0) / 2 ^ p Mod 2 = 1 Then
        
        a(t2, 0, 0) = a(t2, 0, 0) + 2 ^ p
        For t1 = 0 To 80
           a(t1, j, 0) = a(t1, 0, 0)
        Next t1
        a(t2, 0, 0) = p + 1
      End If
      GoTo eee
    Next p
  End If
Next t2
End If
eee:

d = 0’进入读档程序标志
t = 1’再一次运算中,若改变过表格中数据,则t=1,若无,t=0
Do


jin: '假设数据后跳转位置


t = 0

For m = 0 To 2’用表格中数据推理(无假设)

For k1 = 0 To 80 Step 9’将表格中数据以同列,同行,同一个小九宫不能有相同数进行筛选
  For k2 = 0 To 8
    If a(k1 + k2, 0, m) > 0 Then
      For k3 = 0 To 8
        If a(k1 + k3, 0, m) < 0 And Int((-a(k1 + k3, 0, m) / (2 ^ (a(k1 + k2, 0, m) - 1)))) Mod 2 = 1 Then
          a(k1 + k3, 0, m) = a(k1 + k3, 0, m) + 2 ^ (a(k1 + k2, 0, m) - 1)
          t = 1
        End If
      Next k3
    End If
  Next k2
Next k1


For k1 = 0 To 80 Step 9’若在一行,一列,或一个九宫中有一个数尽在一个格中有可能,则确定这个数
  For k2 = 0 To 8
    p = 0
    For k3 = 0 To 8
      If (a(k1 + k3, 0, m) > 0 And a(k1 + k3, 0, m) <> k2 + 1) Or (a(k1 + k3, 0, m) < 0 And Int(-a(k1 + k3, 0, m) / 2 ^ (k2)) Mod 2 = 0) Then
        p = p + 1
      Else
        q = k1 + k3
      End If
    Next k3
    If p = 8 Then
      If a(q, 0, m) < 0 Then
        a(q, 0, m) = k2 + 1
        t = 1
      End If
    End If
  Next k2
Next k1


  For t2 = 0 To 80’若某个格中只有一种可能性,则确定该数
    If a(t2, 0, m) < 0 Then
      For p = 0 To 8
        If -a(t2, 0, m) = 2 ^ p Then
          a(t2, 0, m) = p + 1
          t = 1
        End If
      Next p
    End If
  Next t2
  
  
  
  For t1 = 0 To 80 Step 9’若在同行,同列,同一个九宫中有两数相同,则进入读档程序
    For t2 = 0 To 8
      For t3 = 0 To 8
      If a(t1 + t2, 0, m) = a(t1 + t3, 0, m) And t2 <> t3 Then
      
         If a(t1 + t2, 0, m) > 0 Then
        
         
          d = 1
         
         
          GoTo kkk
          End If
        End If
      Next t3
    Next t2
  Next t1
  
  
  
  
  

For p = 1 To 9’每次运算仅进行 行或列或小九宫,该段进行3个数组的数据更新
  For q = 1 To 9
    n = 9 * (p - 1) + q - 1
    o = 9 * (q - 1) + p - 1
    If p < 4 Then
      r = 3 * (q - Int((q - 0.1) / 3) * 3 - 1) + p
    End If
    If p > 3 And p < 7 Then
      r = 3 * (q - Int((q - 0.1) / 3) * 3 - 1) + 6 + p
    End If
    If p > 6 And p < 10 Then
      r = 3 * (q - Int((q - 0.1) / 3) * 3 - 1) + 9 * 2 - 6 + p
    End If
    r = r + (Int((q - 0.1) / 3) - 0) * 27 - 1
   
    If m = 0 Then
      a(r, 0, 2) = a(n, 0, 0)
      a(o, 0, 1) = a(n, 0, 0)
    End If
   
    If m = 1 Then
      a(r, 0, 2) = a(o, 0, 1)
      a(n, 0, 0) = a(o, 0, 1)
    End If
   
    If m = 2 Then
      a(n, 0, 0) = a(r, 0, 2)
      a(o, 0, 1) = a(r, 0, 2)
    End If
   
  Next q
Next p


Next m
'Next t


For t2 = 0 To 80’显示
   Text1(t2).Text = a(t2, 0, 0)
Next t2

Loop While t = 1
For t2 = 0 To 80’若没有可推理的解,则进行假设,对于最前面不可确定的数据进行假设,并在存档中删除这种可能性
  If a(t2, 0, 0) < 0 Then
    For p = 0 To 8
      If -a(t2, 0, 0) / 2 ^ p Mod 2 = 1 Then
        j = j + 1
        a(t2, 0, 0) = a(t2, 0, 0) + 2 ^ p
        For t1 = 0 To 80
           a(t1, j, 0) = a(t1, 0, 0)
        Next t1
        a(t2, 0, 0) = p + 1
        GoTo www
      End If
    Next p
  End If
Next t2
www:
If t2 <> 81 Then
  GoTo jin
End If









For t2 = 0 To 80
   Text1(t2).Text = a(t2, 0, 0)
Next t2

End Sub




Private Sub Form_Load()
Dim tt1, tt2 As Integer
For tt1 = 0 To 80
  Text1(tt1).Width = 220
Next tt1
For tt1 = 0 To 8
  For tt2 = 0 To 8
    Text1(tt1 * 9 + tt2).Left = tt1 * 350 + 730
    Text1(tt1 * 9 + tt2).Top = 370 + tt2 * 400
  Next tt2
Next tt1


For tt1 = 0 To 80
  Text1(tt1).Text = 0
Next tt1

End Sub


若删去:

For t2 = 0 To 80
  If a(t2, 0, 0) < 0 Then
    For p = 0 To 8
      If -a(t2, 0, 0) / 2 ^ p Mod 2 = 1 Then
        j = j + 1
        a(t2, 0, 0) = a(t2, 0, 0) + 2 ^ p
        For t1 = 0 To 80
           a(t1, j, 0) = a(t1, 0, 0)
        Next t1
        a(t2, 0, 0) = p + 1
        GoTo www
      End If
    Next p
  End If
Next t2
www:
If t2 <> 81 Then
  GoTo jin
End If

则可工作
搜索更多相关主题的帖子: 计算 数独 最好 
2010-04-02 19:19
风月
Rank: 1
等 级:新手上路
帖 子:19
专家分:0
注 册:2009-9-9
收藏
得分:0 
谢谢
2010-04-02 20:30
风月
Rank: 1
等 级:新手上路
帖 子:19
专家分:0
注 册:2009-9-9
收藏
得分:0 
恩,我昨天晚上做了一个晚上,终于好了
bug消掉了。。。就是有一种可能性没考虑到。。。
悲剧
2010-04-03 09:36
风月
Rank: 1
等 级:新手上路
帖 子:19
专家分:0
注 册:2009-9-9
收藏
得分:0 
谢谢2楼的程序
我好好看一下,你的程序好像效率比我的高啊。。。
2010-04-03 09:36
风月
Rank: 1
等 级:新手上路
帖 子:19
专家分:0
注 册:2009-9-9
收藏
得分:0 
我把我的程序也发上来吧,
ps:原程序无注释。。。看起来可能比较落累。。。




数独计算.rar (9.57 KB)
2010-04-03 09:42
风月
Rank: 1
等 级:新手上路
帖 子:19
专家分:0
注 册:2009-9-9
收藏
得分:0 
哦,谢谢,我在程序中当算不出事需要假设的,所以后面的39个数组是用来放置假设前的数据用(是用来一层层的假设的,因为有时候假设的是错误的),我再去改一下
2010-04-03 11:25
风月
Rank: 1
等 级:新手上路
帖 子:19
专家分:0
注 册:2009-9-9
收藏
得分:0 
还有啊
大大,你怎么做出来这么好看的框出来的?
2010-04-03 11:48
风月
Rank: 1
等 级:新手上路
帖 子:19
专家分:0
注 册:2009-9-9
收藏
得分:0 
问一下,怎么做出来这种样子的格子的?
2010-04-03 11:51
风月
Rank: 1
等 级:新手上路
帖 子:19
专家分:0
注 册:2009-9-9
收藏
得分:0 
谢谢
2010-04-03 12:46
快速回复:用vb来计算数独的问题
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.024168 second(s), 9 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved