我来解数独(附delphi源码)

前段时间看到“69岁农民3天破解世界最难数独游戏”，然后在看了那个号称世界最难的数独题目之后，就打算抽空编程解决。今晚抽出一个晚上，大约四五个小时的时间，中间还间歇在clash of clans上造兵和进攻（好吧我承认这不是一个好习惯）。最终，很好地解决了。下面贴出源代码。

 

unit uSudoku;



interface



uses

  Classes, sysutils, forms, windows, dialogs;



type

  TMapArray = array[1..9, 1..9] of Integer;

  TSudokuMap = class(TObject)

  private

    FMap_init: TMapArray;

    FMap: TMapArray;

    iAnswer: integer;

    function checknow(x,y: Integer): boolean;

    function get_next_x_y(var xx, yy: Integer): Boolean;

  public

    ssResults: TStrings;

    constructor Create;

    destructor Destroy; override;

    procedure init(ss: tstrings); 

    function map_output: string;

    procedure onDone();

    function go(x,y: Integer): boolean;

  end;







implementation





{ TSudokuMap }



// 检查当前坐标处的数字是否合法

function TSudokuMap.checknow(x, y: Integer): boolean;

var

  i: integer;

  ix, iy, xx0, yy0: integer;

begin

  result := true;



  // 检查横向冲突情况

  if result then

  begin

    for i := 1 to 9 do

      if (i<>x) and (FMap[i,y]=FMap[x,y]) then

      begin

        result := false;

        break;

      end;

  end;



  // 检查竖向冲突情况

  if result then

  begin

    for i := 1 to 9 do

      if (i<>y) and (FMap[x,i]=FMap[x,y]) then

      begin

        result := false;

        break;

      end;

  end;



  // 检查自己所在9宫格冲突情况

  if result then

  begin

    xx0 := (x-1) div 3 * 3;

    yy0 := (y-1) div 3 * 3;

    for ix := 1 to 3 do

      for iy := 1 to 3 do

        if ((ix+xx0<>x) or (iy+yy0<>y)) and (FMap[ix+xx0,iy+yy0]=FMap[x,y]) then

        begin

          result := false;

          break;

        end;

  end;

end;



constructor TSudokuMap.Create;

begin

  inherited;

  iAnswer := 0;

  ssResults := TStringList.Create;

end;



destructor TSudokuMap.Destroy;

begin

  FreeAndNil(ssResults);

  inherited;

end;



function TSudokuMap.get_next_x_y(var xx, yy: Integer): Boolean;

begin

  if yy<9 then

    yy := yy+1

  else

  begin

    yy := 1;

    xx := xx+1;

  end;



  result := xx<=9;

end;





// 求解，结果放于ssResults中

function TSudokuMap.go(x, y: Integer): boolean;

var

  i: integer;

  xx, yy: integer;

begin

if FMap_init[x,y]>0 then

  begin

    result := checknow(x,y);

    if Result then

    begin

      xx := x; yy := y;

      if get_next_x_y(xx, yy) then

        result := go(xx, yy);

    end;

  end

  else

  begin

    for i := 1 to 9 do

    begin

      FMap[x,y] := i;

      result := checknow(x,y);

      if Result then

      begin

        xx := x; yy := y;

        if get_next_x_y(xx, yy) then

        begin

          result := go(xx, yy);

          //if result then break;

        end

        else

          break;

      end;

    end;

  end;



  if (x=9) and (y=9) and Result then

    onDone();



  // 如果本次遍历从1到9均不成功，则将FMap[x,y]复原，以免影响后续计算

  if (not Result) then FMap[x,y] := FMap_init[x,y];

end;



{-------------------------------------------------------------------------------

  主要用于生成数独初始map。输入参数形如:

    005300000

    800000020

    070010500

    400005300

    010070006

    003200080

    060500009

    004000030

    000009700

-------------------------------------------------------------------------------}

procedure TSudokuMap.init(ss: tstrings);

var

  s: string;

  x, y: integer;

begin

  for x := 1 to 9 do

  begin

    s := ss[x-1];

    for y := 1 to 9 do

    begin

      FMap[x,y] := strtoint(s[y]);

      FMap_init[x,y] := FMap[x,y];

    end;

  end;

end;





{-------------------------------------------------------------------------------

  将FMap以如下形式输出:

    . . 5 3 . . . . .

    8 . . . . . . 2 .

    . 7 . . 1 . 5 . .

    ...

-------------------------------------------------------------------------------}

function TSudokuMap.map_output: string;

const CR=#13#10;

var

  x, y: integer;

  s: string;

  ch: string;

begin

  s := '';

  for x := 1 to 9 do

  begin

    for y := 1 to 9 do

    begin

      ch := inttostr(FMap[x,y]);

      if ch='0' then ch:='.';

      s := s+ch+' ';

    end;

    s := s + CR;

  end;

  Result := s;

end;



procedure TSudokuMap.onDone;

var

  filename: string;

begin

  Inc(iAnswer);

  ssResults.Add(IntToStr(iAnswer));

  ssResults.Add(map_output);

end;



end.

 

调用代码：

procedure TForm1.go(memo1: TMemo);

var

  Sudoku: TSudokuMap;

begin

  Sudoku := TSudokuMap.create;

  Sudoku.init(Memo1.lines);

  mmo1.Text := sudoku.map_output;

  sudoku.go(1,1);

  Caption := 'OK! '+datetimetostr(now);

  mmo4.Lines.Assign(Sudoku.ssResults);

end;



procedure TForm1.btn3Click(Sender: TObject);

begin

  go(mmo3);

end;

 

对于这道题目，程序瞬间解出答案。为了精确计算，我重复了1000次，耗时27秒。

本来还希望能找出一种以上的解，结果只有一解：

1 4 5 3 2 7 6 9 8
8 3 9 6 5 4 1 2 7
6 7 2 9 1 8 5 4 3
4 9 6 1 8 5 3 7 2
2 1 8 4 7 3 9 5 6
7 5 3 2 9 6 4 8 1
3 6 7 5 4 2 8 1 9
9 8 4 7 6 1 2 3 5
5 2 1 8 3 9 7 6 4

===========================

另外，新闻稿上老人解的那道题 http://news.qq.com/a/20130526/005425.htm

这道题录入程序后，用了一秒钟得到唯一解：

8 1 2 7 5 3 6 4 9
9 4 3 6 8 2 1 7 5
6 7 5 4 9 1 2 8 3
1 5 4 2 3 7 8 9 6
3 6 9 8 4 5 7 2 1
2 8 7 1 6 9 5 3 4
5 2 1 9 7 4 3 6 8
4 3 8 5 2 6 9 1 7
7 9 6 3 1 8 4 5 2

而老人把第四行的5改为8后，花了3个月时间才解出来。按照他的改法，程序共发现了133种解法，老人给出的解法是我的第122解。希望老人知道了之后不要太伤心哦~