回 帖 发 新 帖 刷新版面

主题:[讨论]我是剛學的, 請問如何用pascal 寫數獨? 謝謝

我是剛學的, 請問如何用pascal 寫數獨? 謝謝~~~~[em2]

回复列表 (共11个回复)

沙发

用简体字好吗?

板凳

数独?等你学会了高效率的搜索和高效率的煎枝后再写吧

3 楼

刚学就想写数独
勇气可嘉
问一句:你是想写一个生成器还是一个求解器?
不管写哪个你要先把求解器写出来,因为生成器的生成结果必须能通过验证
而求解器的思路就是纯粹的迭代
记录下本行已经出现过的数字,然后向本行空格中填入尚未出现过的数字,再检验是不是本行本列都符合要求,不满足就换当前位置数字,当前位置数字换完还得不到解就换上次决定的数字
依此类推

4 楼

求解器太难写了,算法复杂度为O(9^81)

5 楼

网上有数独的Pascal参考版本
或者你可以翻看一下以前的帖子,我有一个自己原创的数独游戏,可以供你参考一下(发帖人:我是学生),有不懂的可以问大家。

6 楼

楼上的数独游戏我看过,把计算求解那部分省略了,直接弄几个答案

7 楼

我也想知道生成器与求解器应该怎样写,能讲解一下吗?

8 楼

用高效率的剪枝

源程序:http://hi.baidu.com/wywy/blog/item/fa38d416acb43c18972b438b.html
下载地址:http://wyoi.ys168.com

不过注意,在全部计算时很占内存

9 楼

{如果使用TP编译,请先安装CRT补丁}
program sdjsq;{数独解算器}
{-------------调用库------------------------------------------------USES}
  uses CRT,Dos;{使用CRT Dos库}
{-------------数据类型定义------------------------------------------TYPE}
  type
    sz=0..9;{数字,byte类型的子界占一byte}
    sy=1..9;{same as sz}
    sd=array [sy,sy] of sz;{数独,占8×8×1byte=81byte}
    ss=set of sy;{数字的集合}
{-------------变量定义-----------------------------------------------VAR}
  var
    a:sd;
    x,y:byte;
{=============打印边框============================================PRINTK}
  procedure printk;
    var
      i, k : byte;
      flag : boolean;
  begin
    gotoxy(1,1);textcolor(15);textbackground(0);
    write(#218);for k:=1 to 8 do write(#196#194);writeln(#196#191);
    for i := 1 to 9 do begin
      write(#179);for k:=1 to 9 do begin
        textbackground(1-ord(((i-1) div 3+(k-1) div 3) mod 2=0));
        write(#32);textbackground(0);write(#179);
      end;
      writeln;
      if i<>9 then begin
        write(#195);for k:=1 to 8 do write(#196#197);writeln(#196#180);
      end;
    end;
    write(#192);for k:=1 to 8 do write(#196#193);writeln(#196#217);
    gotoxy(1,1);
  end;
{=============可以填的数==============================================KY}
  procedure ky(a:sd;x,y:byte;var s:ss);
    var
      i,j:byte;
  begin
    s:=[1,2,3,4,5,6,7,8,9];
    for i:=1 to 9 do if i<>x then s:=s-[a[i,y]];
    for i:=1 to 9 do if i<>y then s:=s-[a[x,i]];
    for i:=1 to 3 do for j:=1 to 3 do
      if ((x-1)div 3*3+i<>x) and ((y-1)div 3*3+j<>y)
       then s:=s-[a[(x-1)div 3*3+i,(y-1)div 3*3+j]];
    s:=s-[0];
  end;
{=============打印数据=============================================PRINT}
    procedure print(xn,yn,color:byte);
    begin
      gotoxy(2*xn,2*yn);
      textcolor(color);
      textbackground(5+ord(not ((x=xn)and(y=yn)))*(-4-ord(((xn-1) div 3+(yn-1) div 3) mod 2=0)));
      if a[xn,yn]<>0 then write(a[xn,yn]) else write(#32);
      gotoxy(1,1);
    end;
{=============用键盘读入数据===========================INPUT BY KEYBOARD}
  procedure inputbkb(var a:sd);
    label 1;
    var
      xi,yi:byte;
      c:char;
      s:ss;i:byte;
  begin
    printk;
    fillchar(a,sizeof(a),0);x:=1;y:=1;print(1,1,0);
    textcolor(15);textbackground(0);
    s:=[1..9];gotoxy(1,20);for i:=1 to 9 do write(i:2);
    repeat
      c:=readkey;
      xi:=x;yi:=y;
      case c of
        (*#13{Enter}, #27{Esc}*)
        #27:halt;
        (*#72{Up}, #75{Left}, #77{Right}, #80{Down}*)
        #0:begin
          c:=readkey;
          case c of
            #75:if x<>1 then x:=x-1 else write('');
            #72:if y<>1 then y:=y-1 else write('');
            #80:if y<>9 then y:=y+1 else write('');
            #77:if x<>9 then x:=x+1 else write('');
            #83:a[x,y]:=0;
          end;
        end;
        #48..#58:if (ord(c)-48 in s) or (c=#48)
          then a[x,y]:=ord(c)-48 else write('');
      end;
      print(xi,yi,12);print(x,y,12);
      ky(a,x,y,s);
      gotoxy(1,20);
      textcolor(15);textbackground(0);delline;
      for i:=1 to 9 do if i in s then write(i:2);
    until c=#13;
    x:=0;y:=0;print(xi,yi,12);
  end;
  procedure noans;
  begin
    gotoxy(1,20);
    delline;
    textcolor(143);textbackground(0);
    write('No answer!');
    readkey;
    halt;
  end;

10 楼

{续}
{=============用文件读入数据===============================INPUT BY FILE}
  procedure inputbf(var a:sd;const path:string);
    function Exist(Path:string):boolean;
      var
        S: PathStr;
    begin
      S := FSearch(Path, GetEnv(''));
      Exist := S <> '';
    end;
    var
      x,y:byte;
      c:char;
      f:text;
  begin
    if not exist(path) then begin
      inputbkb(a);
    end else begin
      assign(f,path);reset(f);printk;
      for y:=1 to 9 do begin
        for x:=1 to 9 do begin
          read(f,c);
          if not (c in [#48..#58,#32]) then begin
            inputbkb(a);exit;
          end;
          if c=#32 then a[x,y]:=0 else a[x,y]:=ord(c)-48;print(x,y,12);
        end;
        readln(f);
      end;
    end;
  end;
{=============填入固定数据============================================TC}
  procedure tc;
    var
      x,y,i,t,n,f:byte;
      s:ss;
  begin
    repeat
      f:=0;
      for x:=1 to 9 do
       for y:=1 to 9 do
        if a[x,y]=0 then begin
         ky(a,x,y,s);t:=0;if s=[] then noans;
         for i:=1 to 9 do if i in s then begin
           t:=t+1;n:=i;
         end;
         if t=1 then begin a[x,y]:=n;print(x,y,14);f:=f+1; end;
       end;
    until f=0;
  end;
{=============递归求解===============================================TRY}
  function answer:boolean;
    var
      ans:boolean;
      procedure try(x,y:byte);
      var
        i,j,n:byte;
        s:ss;
    begin
      if keypressed then if readkey=#27 then halt;
      if (y<>10) then begin
        if a[x,y]<>0 then if x=9 then try(1,y+1) else try(x+1,y) else begin
          ky(a,x,y,s);if s=[] then exit;
          n:=random(8)+1;
          for j:=n to n+8 do begin
            i:=j mod 9+1;
            if i in s then begin
              a[x,y]:=i;print(x,y,10);
              if x=9 then try(1,y+1) else try(x+1,y);
              if ans then exit;
              a[x,y]:=0;print(x,y,0);
            end
          end;
        end;
      end else begin
        gotoxy(1,20);textcolor(15);delline;write('Complete!');answer:=true;ans:=true;
      end;
    end;
  begin
    answer:=false;ans:=false;
    try(1,1)
  end;
  procedure crtinit;
    var
      OrigMode: Word;
  begin
    OrigMode:=LastMode;                  { Remember original video mode }
    TextMode(Lo(LastMode)+Font8x8);      { use 43 or 50 lines on EGA/VGA }
  end;
begin
  randomize;
  crtinit;
  textbackground(0);clrscr;
  if ParamCount=0 then inputbkb(a) else inputbf(a,ParamStr(1));
  tc;
  textcolor(15);textbackground(0);gotoxy(1,20);delline;writeln('Trying...');gotoxy(1,1);
  if not answer then noans;
  readkey;
end.

我来回复

您尚未登录,请登录后再回复。点此登录或注册