数独搜索|华山论剑 - OI爱好者（OIFans.cn）

只看楼主倒序阅读 0 发表于: 2006-05-21

program shudu;
uses crt;

const atgx:array[1..9]of byte=(2,4,6,8,10,12,14,16,18);
atgy:array[1..9]of byte=(2,4,6,8,10,12,14,16,18);
ch:array[1..4,1..11]of char=((#218,#196,#191,#179,#192 ,#190,#195,#180,
#193,#194,#197),(#220,#220,#220,#219,#220,#220,#219,#219,#220,#220,#219),
(#201,#205,#187,#186,#200,#188,#204,#185,#202,#203,#206),(' ',' ',' ',' ',
' ',' ', ' ',' ',' ',' ',' '));
var a:array[1..9,1..9]of 0..9;
b,d,e,f:array[1..9,1..9]of boolean;
i,j:integer;
PROCEDURE draws(k,color:byte);
VAR i,j:integer;
BEGIN
window(31,3,50,21);
textbackground(color);
clrscr;
textcolor(12);
write(ch[k,1]);
for j:=1 to 8 do
write(ch[k,2],ch[k,10]);
writeln(ch[k,2],ch[k,3]);
for i:=1 to 8 do
begin
for j:=1 to 9 do
write(ch[k,4],' ');
writeln(ch[k,4]);
write(ch[k,7]);
for j:=1 to 8 do
write(ch[k,2],ch[k,11]);
writeln(ch[k,2],ch[k,8]);
end;
for i:=1 to 9 do write(ch[k,4], ' ');
writeln(ch[k,4]);
write(ch[k,5]);
for i:=1 to 8 do
write(ch[k,2],ch[k,9]);
write(ch[k,2],ch[k,6]);
textcolor(lightgray);gotoxy(wherex,wherey-1)
END;
PROCEDURE inputs;
VAR
b1,b2,am,is,are:byte;
cha:char;
flag:boolean;
BEGIN
window(20,1,60,2);textcolor(red);
write('PRESS<ESC><ENTER><F1>(F1 to no input!)');
flag:=false;
repeat
cha:=readkey;
case cha of
#27:halt;
#13:flag:=true;
#59:exit;
end
until flag;
clrscr;
flag:=false;
gotoxy(20,2);
writeln('Inputting...');
write(' Press <Backspace><Enter>');
draws(1,10);
gotoxy(atgx[1],atgy[1]);
textcolor(red);
repeat
cha:=readkey;
case cha of
'1'..'9':BEGIN
a[(wherex)div 2,(wherey)div 2]:=ord(cha)-ord('0');
write(ord(cha)-ord('0'));
gotoxy(wherex-1,wherey);
b[(wherex)div 2,(wherey)div 2]:=true;
END;
#77:gotoxy(wherex+2,wherey);
#75:gotoxy(wherex-2,wherey);
#72:gotoxy(wherex,wherey-2);
#80:gotoxy(wherex,wherey+2);
#13:exit;
#08:BEGIN b1:=wherex;b2:=wherey;
a[(wherex)div 2,(wherey)div 2]:=0;write(' ');
gotoxy(wherex-1,wherey);
b[(b2)div 2,(b1)div 2]:=false;END;
end
UNTIL flag;
end;
PROCEDURE clear;
VAR ii,j:integer;
BEGIN
window(31,3,50,21);
for ii:=1 to 9 do
FOR j:=1 to 9 DO
IF not b[ii,j] THEN BEGIN
gotoxy(atgx[ii],atgy[j]);write(' ');end;
END;
PROCEDURE print;
VAR ii,j:integer;
BEGIN
window(31,3,50,21);
textcolor(14);
for ii:=1 to 9 do
FOR j:=1 to 9 DO
BEGIN
IF b[ii,j]=false THEN BEGIN
gotoxy(atgx[ii],atgy[j]);
write(a[ii,j]);sound(200+a[ii,j]*10);
delay(50);nosound;delay(20);END;
end;
readkey;
clear;
END;
procedure andy(mm,nn:integer);
var i,t,p:integer;fl:boolean;
begin //1
if mm>9 then print
else if b[mm,nn]=false then
BEGIN //2
p:=random(9)+1;
For i:=p to 9 do
If (d[mm,i])then if(e[nn,i])then
BEGIN //3
t:=(mm-1)div 3+1+((nn-1) div 3)*3;
IF f[t,i] then begin //4
d[mm,i]:=false;
a[mm,nn]:=i;
e[nn,i]:=false;
f[t,i]:=false;
iF nn=9
then andy(mm+1,1)
ELSE andy(mm,nn+1);
f[t,i]:=true;
d[mm,i]:=true;
e[nn,i]:=true
end;END; //4,3
For i:=p-1 downto 1 do
If (d[mm,i])then if(e[nn,i])then
BEGIN
t:=(mm-1)div 3+1+((nn-1) div 3)*3;
IF f[t,i] then begin
d[mm,i]:=false;
a[mm,nn]:=i;
e[nn,i]:=false;
f[t,i]:=false;
iF nn=9
then andy(mm+1,1)
ELSE andy(mm,nn+1);
f[t,i]:=true;
d[mm,i]:=true;
e[nn,i]:=true end //4
END; //3
END //2
else if nn=9 then andy(mm+1,1)
else andy(mm,nn+1)
end;

BEGIN
textbackground(lightgreen);
clrscr;
for i:= 1 to 9 do
for j:=1 to 9 do
BEGIN
b[i,j]:=false;d[i,j]:=true;
e[i,j]:=true;f[i,j]:=true
END;
inputs;
for i:=1 to 9 do
for j:=1 to 9 do
BEGIN
IF b[i,j] THEN BEGIN
d[i,a[i,j]]:=false;e[j,a[i,j]]:=false;
f[(i-1)div 3+1+((j-1) div 3)*3,a[i,j]]:=false END;
END;
inc(i);
andy(1,1);
window(0,0,26,80);
textbackground(lightgreen);
textcolor(yellow);
clrscr
END.
[attachment=42]

[ 此贴被sunlight在2006-08-12 08:15重新编辑 ]