我来解数独(附delphi源码)

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

unit uSudoku;

interface

uses
  Classes, sysutils, forms, windows, dialogs;

type
  TMapArray = array[.., ..] 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 :=  to  do
      if (i<>x) and (FMap[i,y]=FMap[x,y]) then
      begin
        result := false;
        break;
      end;
  end;

  // 检查竖向冲突情况
  if result then
  begin
    for i :=  to  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-) div  * ;
    yy0 := (y-) div  * ;
    for ix :=  to  do
      for iy :=  to  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 := ;
  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< then
    yy := yy+
  else
  begin
    yy := ;
    xx := xx+;
  end;

  result := xx<=;
end;

// 求解，结果放于ssResults中
function TSudokuMap.go(x, y: Integer): boolean;
var
  i: integer;
  xx, yy: integer;
begin
if FMap_init[x,y]> 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 :=  to  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=) and (y=) 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 :=  to  do
  begin
    s := ss[x-];
    for y :=  to  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=##;
var
  x, y: integer;
  s: string;
  ch: string;
begin
  s := '';
  for x :=  to  do
  begin
    for y :=  to  do
    begin
      ch := inttostr(FMap[x,y]);
      if ch='' 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(,);
  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解。希望老人知道了之后不要太伤心哦~