问答1 问答5 问答50 问答500 问答1000
网友互助专业问答平台

用pascal设计一个可以解数独的程序;

提问网友 发布时间:2022-04-20 08:51
声明:本网页内容为用户发布,旨在传播知识,若有侵权等问题请及时与本网联系,我们将在第一时间删除处理。
E-MAIL:1656858193@qq.com
5个回答
热心网友 回答时间:2022-05-08 00:09
var
i,j,s,x,y,k,l:integer;
t:boolean;
a:array [1..9,1..9] of integer;
b,d:array [1..82] of integer;
st:string;
begin
for i:=1 to 9 do begin
readln(st);
for j:=1 to 9 do a[i,j]:=ord(st[j])-48;
end;
s:=0;
for i:=1 to 9 do
for j:=1 to 9 do
if a[i,j]=0 then begin
s:=s+1;
d[s]:=(i-1)*9+j;
end;
k:=0;l:=0;x:=(d[1]-1) div 9+1;y:=(d[1]-1) mod 9+1;
while l<>s do begin
k:=k+1;
if k>9 then begin
if l=0 then begin
writeln('No Answer!');
halt;
end;
k:=b[l];
a[x,y]:=0;
x:=(d[l]-1) div 9+1;y:=(d[l]-1) mod 9+1;
b[l]:=0;
l:=l-1;
end
else begin
t:=true;
for i:=1 to 9 do
if a[i,y]=k then begin t:=false;break;end;
if t then
for i:=1 to 9 do
if a[x,i]=k then begin t:=false;break;end;
if t then begin
case x of
1,2,3:begin
if (y=1) or (y=2) or (y=3) then
for i:=1 to 3 do
for j:=1 to 3 do
if a[i,j]=k then t:=false;
if (y=4) or (y=5) or (y=6) then
for i:=1 to 3 do
for j:=4 to 6 do
if a[i,j]=k then t:=false;
if (y=7) or (y=8) or (y=9) then
for i:=1 to 3 do
for j:=7 to 9 do
if a[i,j]=k then t:=false;
end;
4,5,6:begin
if (y=1) or (y=2) or (y=3) then
for i:=4 to 6 do
for j:=1 to 3 do
if a[i,j]=k then t:=false;
if (y=4) or (y=5) or (y=6) then
for i:=4 to 6 do
for j:=4 to 6 do
if a[i,j]=k then t:=false;
if (y=7) or (y=8) or (y=9) then
for i:=4 to 6 do
for j:=7 to 9 do
if a[i,j]=k then t:=false;
end;
7,8,9:begin
if (y=1) or (y=2) or (y=3) then
for i:=7 to 9 do
for j:=1 to 3 do
if a[i,j]=k then t:=false;
if (y=4) or (y=5) or (y=6) then
for i:=7 to 9 do
for j:=4 to 6 do
if a[i,j]=k then t:=false;
if (y=7) or (y=8) or (y=9) then
for i:=7 to 9 do
for j:=7 to 9 do
if a[i,j]=k then t:=false;
end;
end;
if t then begin
a[x,y]:=k;
l:=l+1;
b[l]:=k;
k:=0;
x:=(d[l+1]-1) div 9+1;y:=(d[l+1]-1) mod 9+1;
end;
end;
end;
end;
for i:=1 to 9 do begin
for j:=1 to 9 do write(a[i,j]);
writeln;
end;
end.
热心网友 回答时间:2022-05-08 01:27
{$A+,B-,D-,E-,F-,G+,I-,L-,N+,O-,P+,Q-,R-,S-,T-,V-,X+,Y-}
{$optimization on}
{$inline on}
const
m = 324;
var
i, j, k, tot, t, min: longint;
l, r, u, d, col, rr, cc, lab: array [0..m * (9 * 9 * 9 + 1)] of longint;
map: array [1..9, 1..9] of longint;
size: array [1..m] of longint;
ch: char;
f: boolean;

procere Remove(x: longint); inline;
var
i, j: longint;
begin
r[l[x]] := r[x];
l[r[x]] := l[x];
i := d[x];
while i <> x do
begin
j := r[i];
while j <> i do
begin
Dec(size[col[j]]);
u[d[j]] := u[j];
d[u[j]] := d[j];
j := r[j];
end;
i := d[i];
end;
end;

procere Resume(x: longint); inline;
var
i, j: longint;
begin
i := u[x];
while i <> x do
begin
j := l[i];
while j <> i do
begin
Inc(size[col[j]]);
u[d[j]] := j;
d[u[j]] := j;
j := l[j];
end;
i := u[i];
end;
l[r[x]] := x;
r[l[x]] := x;
end;

procere print; inline;
var
i, j: longint;
begin
f := True;
for i := 1 to 9 do
begin
for j := 1 to 9 do
Write(map[i, j]);
writeln;
end;
end;

procere DFS;
var
x, i, j: longint;
begin
if r[0] = 0 then
begin
print;
exit;
end;
min := maxlongint;
i := r[0];
while i <> 0 do
begin
if size[i] < min then
begin
min := size[i];
x := i;
end;
i := r[i];
end;
Remove(x);
i := d[x];
while i <> x do
begin
map[rr[i], cc[i]] := lab[i];
j := r[i];
while j <> i do
begin
Remove(col[j]);
j := r[j];
end;
DFS;
if f then
exit;
j := l[i];
while j <> i do
begin
Resume(col[j]);
j := l[j];
end;
i := d[i];
end;
Resume(x);
end;

procere Insert_(x, y, i, n: longint); inline;
begin
Inc(size[i]);
Inc(tot);
rr[tot] := x;
cc[tot] := y;
lab[tot] := n;
col[tot] := i;
r[tot] := tot + 1;
l[tot] := tot - 1;
u[tot] := u[i];
d[tot] := i;
d[u[i]] := tot;
u[i] := tot;
end;

procere Insert(x, y, k, n: longint); inline;
begin
t := tot + 1;
Insert_(x, y, (x - 1) * 9 + y, n);
Insert_(x, y, 81 + (x - 1) * 9 + n, n);
Insert_(x, y, 162 + (y - 1) * 9 + n, n);
Insert_(x, y, 243 + (k - 1) * 9 + n, n);
r[tot] := t;
l[t] := tot;
end;

begin
f := False;
for i := 1 to m do
begin
l[i] := i - 1;
r[i] := i + 1;
u[i] := i;
d[i] := i;
size[i] := 0;
end;
l[0] := m;
r[0] := 1;
r[m] := 0;
tot := m;
for i := 1 to 9 do
begin
for j := 1 to 9 do
begin
read(ch);
if ch = '0' then
for k := 1 to 9 do
Insert(i, j, (i - 1) div 3 * 3 + (j + 2) div 3, k)
else
Insert(i, j, (i - 1) div 3 * 3 + (j + 2) div 3, Ord(ch) - 48);
end;
readln;
end;
DFS;
if f=false then writeln('No Answer!');
readln;
end.
热心网友 回答时间:2022-05-08 03:02
数独的条件是什么啊 ,同行不同,同列不同 还是…………
热心网友 回答时间:2022-05-08 04:53
这不是数独,第四个九宫格里无处填3
热心网友 回答时间:2022-05-08 07:01
同上

本文如未解决您的问题请添加抖音号:51dongshi(抖音搜索懂视),直接咨询即可。

用电脑怎么编程 动态规划算法程序例子 ord(‘z’)=什么 求教matlab大神,cbeblord函数如何定义?我查了hel... 目前世界排名最大的前十大机场 mka-14103的灵敏值1015是什么意思 推荐一款干簧管。要求是:2*15MM(最长可以是16MM... 想请问OKI干簧管与艾礼富干簧管的区别。以及他们的... vivo手机无法下载安装app怎么回事 小学三年级可能性问题家长怎么辅导 统计与可能性问题 小学数学可能性问题:盒中有3个红球,3个白球,任意... 可能性问题: 一个盒子里放了红桃、黑桃、方块三种... 可能性问题 一道小学五年级数学可能性问题 小学数学中的可能性问题 生活中的可能性问题举例 数学:可能性问题:3个红球,3个白球,任意摸出两... 数学简单的可能性问题!可我不会做……哪位好心人来... 高中数学等可能概率事件公式的运用中的基本事件的... FLASH8动作,脚本怎样使用(篇写) Connecting 世界版 歌词 flash常用命令 String是最基本的数据类型吗? qq韩文昵称 2008年很火的一首韩文歌 编一个数独程序(只需要生成过程),PASCAL 好的追... 我有个PASCAL语言编程问题!!急 如何使用比longint更大的数据类型? pascal计算机基础知 淘宝上几十元的电烙铁哪个好用些 白光焊台sbk936b调温失效一直加热原因怎样修 一台SBK936焊台,开机瞬间指示灯闪一下,而后便没... 维修手机烙铁要多少℃ 高手问下,主板维修需要什么样的风枪和烙铁 什么是sbk文件 快克、宝工、安泰信和深圳白光焊台哪个好? B5689-SBK-B卡西欧手表怎么调时间? .sbk和.class分别是什么文件? 日本白光焊台FX-888和日本焊台936有什么区别?价位...
Top