[讨论]破解数独的算法

Eastsun

从代码来推导算法是有一定难度的，不过还是有迹可寻的^_^

第二种算法无论从代码形式上还是对时间，空间的要求上都是很优美有效的，呵呵。

wqx1

可是你的算法连M个人和隔N个人都没有!
增加一个吧.

以后就拿这个算它了!

能用BASIC编一个吗?

玄狼剑

我在网上只找到了pascal版的，速度很快，仅用一秒就可以破解一个数独！


要填入的空格记作0,题目本来有的数字就填入数阵中
其实这个程序的主要思想就是搜索，说明白了就是一个一个试，这样似乎需要试9^81~这个数量别说pc就连super computer都难接受
在着如果用经典DFS的递归算法堆栈肯定会溢出 so我们需要优化我们的算法
用2重循环尝试填充每一个方格的非递归方法
首先 如果格子填的数要不与其他已填的格子矛盾 我们可以把这个格子所在的行中未被填入的数的集合记为xc，列未被填入的数的数的集合记作yc,这个9*9方格中未被填入的数的集合记作bc,则这个方格填入的数一定属于 c=xc∩yc∩bc
其次 如果c为空集则不必再试下去,也不必要从头试,可以退回到前一个格子重填
这样所有的数据均可以在55ms内解出(Turbo Pascal+WinXp下)


type choise=set of 0..9;
    datatable=array [1..9] of array [1..9] of integer;
    oper=record
         x,y:integer;
         xc,yc,bc:choise;
         chose:integer;
         errs:choise;
        end;
var xc,yc,bc:array [1..9] of set of 0..9;
   data:datatable;
   f:boolean;
procedure ini;  {初始化}
var i:integer;
begin
    f:=false;
    for i:=1 to 9 do
    begin
        xc:=[1..9];    {置代选集和为1~9}
        yc:=[1..9];
        bc:=[1..9];
        end;
    end;
procedure callhalt;        {结束程序}
begin
writeln('Data Error!');
readln;
readln;
halt;
end;
procedure readdata;  {读数据}
var x,y:integer;
begin
    writeln('Input Data');
    for x:=1 to 9 do
    begin
    write('Line',x,' :  ');
    for y:=1 to 9 do
    begin
    read(data[x][y]);
    if data[x][y]<>0 then
    begin
    if not ((data[x][y] in xc[x]) and (data[x][y] in yc[y]) and (data[x][y] in bc[((y-1) div 3)+1+((x-1) div 3)*3]))
    then callhalt;                      {如果这个数字在行或列或3*3方格中出现2次则数据错误}
    xc[x]:=xc[x]-[data[x][y]];              {将出现过的数字从集合中删除}
    yc[y]:=yc[y]-[data[x][y]];
    bc[((y-1) div 3)+1+((x-1) div 3)*3]:=bc[((y-1) div 3)+1+((x-1) div 3)*3]-[data[x][y]];

    end;
    end;
    readln;
    end;
end;
procedure print;        {输出结果}
var x,y:integer;
begin
writeln(&#39;Answer:&#39; );
for x:=1 to 9 do
begin
write(&#39;Line&#39;,x, &#39; : &#39;);
for y:=1 to 9 do write(data[x][y]:2);
writeln;
end;
f:=true;
end;
procedure search;     {搜索}
var tmp:datatable;
   x,y,i,p:integer;
   now:choise;
   s:array [1..82] of oper;
begin
    fillchar(s,sizeof(s),0);
    p:=0;
    for x:=1 to 9 do
    for y:=1 to 9 do
    if data[x][y]=0 then      {如果是空格}
    begin
        now:=xc[x]*yc[y]*bc[((y-1) div 3)+1+((x-1) div 3)*3]-s[p+1].errs;
        if (x=1) and (y=1) and (now=[]) then
        exit;
        if now=[] then {如果不能继续则退回}
        begin
            s[p+1].errs:=[];
            s[p].errs:=s[p].errs+[s[p].chose];  {将这种方法加入已试集合}
            xc[s[p].x]:=s[p].xc;
           yc[s[p].y]:=s[p].yc;
            bc[((s[p].y-1) div 3)+1+((s[p].x-1) div 3)*3]:=s[p].bc;{恢复以前状态}
            x:=s[p].x;
           y:=s[p].y-1;
           data[x][y+1]:=0;
           if y=0 then begin x:=x-1; y:=9; end;
           p:=p-1;
           continue;                       {退出本次循环}
           end;
        for i:=1 to 9 do if i in now then        {找出一种填法}
        begin
            p:=p+1;
            s[p].x:=x;
            s[p].y:=y;
            s[p].chose:=i;
            s[p].xc:=xc[x];
            s[p].yc:=yc[y];
            s[p].bc:=bc[((y-1) div 3)+1+((x-1) div 3)*3];
            data[x][y]:=i;        {填入数字}
            xc[x]:=xc[x]-;
            yc[y]:=yc[y]-;
            bc[((y-1) div 3)+1+((x-1) div 3)*3]:=bc[((y-1) div 3)+1+((x-1) div 3)*3]-;
            break;
            end;
        end;
    if p<>0 then print;
    end;

begin
ini;
readdata;
writeln(&#39;Searching...&#39;);
search;
if not f then writeln(&#39;No Ansewer&#39;);
writeln(&#39;Press Any Key to Exit...&#39;);
readln;
end.


不知道哪位高人可以转成lavax的...