主题:[讨论]我是剛學的, 請問如何用pascal 寫數獨? 謝謝
maymay1314
[专家分:0] 发布于 2007-01-08 21:41:00
我是剛學的, 請問如何用pascal 寫數獨? 謝謝~~~~[em2]
回复列表 (共11个回复)
沙发
贺天行宝 [专家分:2300] 发布于 2007-01-08 22:22:00
用简体字好吗?
板凳
angwuy [专家分:2280] 发布于 2007-01-09 09:12:00
数独?等你学会了高效率的搜索和高效率的煎枝后再写吧
3 楼
雪光风剑 [专家分:27190] 发布于 2007-01-09 09:14:00
刚学就想写数独
勇气可嘉
问一句:你是想写一个生成器还是一个求解器?
不管写哪个你要先把求解器写出来,因为生成器的生成结果必须能通过验证
而求解器的思路就是纯粹的迭代
记录下本行已经出现过的数字,然后向本行空格中填入尚未出现过的数字,再检验是不是本行本列都符合要求,不满足就换当前位置数字,当前位置数字换完还得不到解就换上次决定的数字
依此类推
4 楼
angwuy [专家分:2280] 发布于 2007-01-09 21:04:00
求解器太难写了,算法复杂度为O(9^81)
5 楼
我是学生 [专家分:0] 发布于 2007-01-13 22:37:00
网上有数独的Pascal参考版本
或者你可以翻看一下以前的帖子,我有一个自己原创的数独游戏,可以供你参考一下(发帖人:我是学生),有不懂的可以问大家。
6 楼
angwuy [专家分:2280] 发布于 2007-01-14 11:52:00
楼上的数独游戏我看过,把计算求解那部分省略了,直接弄几个答案
7 楼
我是学生 [专家分:0] 发布于 2007-01-14 12:37:00
我也想知道生成器与求解器应该怎样写,能讲解一下吗?
8 楼
angwuy [专家分:2280] 发布于 2007-01-15 20:30:00
用高效率的剪枝
源程序:http://hi.baidu.com/wywy/blog/item/fa38d416acb43c18972b438b.html
下载地址:http://wyoi.ys168.com
不过注意,在全部计算时很占内存
9 楼
小田甜 [专家分:3910] 发布于 2007-01-20 21:26:00
{如果使用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 楼
小田甜 [专家分:3910] 发布于 2007-01-20 21:26:00
{续}
{=============用文件读入数据===============================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.
我来回复