Dijkstra最短路径（一点到各顶点最短路径）
{本程序解决6个顶点之间的最短路径问题,各顶点间关系的数据文件在sj.txt中}
{如果顶点I到顶点J不能直达就设置距离为30000}
program dijkstra;
type
jihe=set of 0..5;
var
a:array[0..5,0..5] of integer;
dist:array[0..5] of integer;
i,j,k,m,n:integer;
fv:text;
s:jihe;
begin
s:=[0];
assign(fv,'sj.txt');
reset(fv);
for i:=0 to 5 do {从文件中读数据,其中a[i,j]代表从顶点i到顶点j的直达距离,如果不通用30000代替}
begin
for j:=0 to 5 do read(fv,a[i,j]);
readln(fv)
end;
for i:=1 to 5 do {设置DIST数组的初始值,即为顶点0到各顶点的直达距离(算法的第一步)}
dist[i]:=a[0,i];
for i:=1 to 5 do
begin
m:=0;
dist[m]:=30000; {设置DIST[M]的目的是为下面的一步做准备,即在DIST数组中一个最小的值}
for j:=1 to 5 do {算法的第二步,找最小的DIST值}
if (not (j in s)) and (dist[m]>dist[j])
then m:=j ; {用M来记录到底是哪个顶点}
s:=s+[m]; {把顶点加入S中}
for k:=1 to 5 do {算法的第三步,修改后面的DIST值}
if (not (k in s)) and (dist[k]>dist[m]+a[m,k])
then
dist[k]:=dist[m]+a[m,k]
end;
writeln('原各顶点间的路径关系是：（30000代表不通）');
for i:=0 to 5 do
begin
for j:=0 to 5 do write(a[i,j]:6);
writeln
end;
writeln; writeln;
八皇后问题
{问题描述：在国际象棋8X8的棋盘里摆放8个皇后，使每个皇后都能生存而不互相冲突，即同一行、同一列同对角线（包括主对角线和辅对角线）都只能有一个皇后}
program eightqueen; {本程序可以搜索出所有的解}
var
a,b:array[1..8] of integer;
c:array[-7..7] of integer;
d:array[2..16] of integer;
i,k:integer; {K变量用来存放答案的个数}
fv:text;
procedure print;
var
i:integer;
begin
for i:=1 to 8 do
writeln(fv,'第',i:2, '行放在第', a[i]:2,'列'); {结果输出到文件里}
k:=k+1; {每输出一个答案计数加1}
writeln(fv)
end;
procedure try(i:integer);
var
j:integer;
begin
for j:=1 to 8 do
if (b[j]=0) and (c[i-j]=0) and (d[i+j]=0) then
begin
a[i]:=j;
b[j]:=1; {宣布占领列、主副对角线}
c[i-j]:=1;
d[i+j]:=1;
if i<8 then try(i+1) else print;
b[j]:=0; {释放占领列、主副对角线}
c[i-j]:=0;
d[i+j]:=0
end
end;
begin
for i:=1 to 8 do a[i]:=0;
for i:=-7 to 7 do c[i]:=0;
for i:=2 to 16 do d[i]:=0;
k:=0;
assign(fv,'jieguo.txt'); {指定文件与文件变量相联系}
rewrite(fv); {以写的方式打开文件}
try(1);
close(fv); {一定要记得关闭文件，不然数据有可能丢失}
writeln('共有 ',k:3,' 种摆法')
end.
快速排序算法
program kuaisu(input,output);
const n=10;
var
s:array[1..10] of integer;
k,l,m:integer;
procedure qsort(lx,rx:integer);
var
I,j,t:integer;
Begin
I:lx;j:rx;t:s[I];
Repeat
While (s[j]>t) and (j>I) do
Begin
k:=k+1;
j:=j-1
end;
if I<j then
begin
s[I]:=s[j];I:=I+1;l:=l+1;
while (s[I]<t) and (I<j) do
begin
k:=k+1;
I:=I+1
End;
If I<j then
begin
S[j]:=s[I];j:=j-1;l:=l+1;
End;
End;
Until I=j;
S[I]:=t;I:=I+1;j:=j-1;l:=l+1;
If lx<j then qsort(lx,j);
If I<rx then qsort(I,rx)
End;{过程qsort结束}
Begin
Writeln('input 10 integer num:');
For m:=1 to n do read(s[m]);
K:=0;l:=0;
Qsort(l,n);
Writeln('排序后结果是：')；
For m:=1 to n do write(s[m]:4)
End.
地图四色问题
{问题描述：任何一张地图只要用四种颜色进行填涂，就可以保证相邻省份不同色}
program tt;
const num=20;
var a:array [1..num,1..num] of 0..1;
s:array [1..num] of 0..4; {用1-4分别代表RBWY四种颜色;0代表末填进任何颜色}
k1,k2,n:integer;
function pd(i,j:integer):boolean;{判断可行性：第I个省填上第J种颜色}
var k:integer;
begin
for k:=1 to i-1 do {一直从第一个省开始进行比较一直到I省减一的那个省，目的是对已经着色的省份来进行比较，因为>I的省还没 有着色，比较没有意义，着色的顺序是先第一、二、三……I个省}
if (a[i,k]=1) and (j=s[k]) then {省I和省J相邻且将填进的颜色和已有的颜色相同}
begin
pd:=false; {即不能进行着色}
exit; {退出当前函数}
end;
pd:=true; {可以进行着色}
end;
procedure print;{打印结果}
var k:integer;
begin
for k:=1 to n do{将数字转为RBWY串}
case s[k] of
1:write('R':4);
2:write('B':4);
3:write('W':4);
4:write('Y':4);
end;
writeln;
end;
procedure try(i:integer);
var j:integer;
begin
for j:=1 to 4 do
if pd(i,j) then begin
s[i]:=j;
if i=n then print
else try(i+1); {对下一个省进行着色}
s[i]:=0; {不能进行着色，将当前状态设置0，即不进行着色}
end;
end;
BEGIN
write('please input city number: '); readln(n);
writeln('please input the relation of the cities:');
for k1:=1 to n do
begin
for k2:=1 to n do read(a[k1,k2]); {A[K1，K2]=1表示省K1、K2相邻，为0就不相邻}
readln;
end;
for k1:=1 to n do s[k1]:=0; {把所有的颜色设置为0，即还没有进行着色}
try(1);
END.
穿越迷宫
{本程序假设迷宫是一个4 X 4的矩阵，入口在A[1，1]，出口在A[4，4]}
{矩阵数据放在文件shuju3.txt 中}
program mikong;
var
a,b,c:array[1..4,1..4] of integer; {数组A用来存放迷宫路径，约定元素值为0表示通，1表示不通}
{数组B用来存放方向增量}
{数组C用来记录结果，当第I步移到某一元素时，该元素就等于I}
i,j,k,m,n:integer;
fv:text;
q:boolean; {用来标记迷宫是否有出路}
procedure print;
var
m,n:integer;
begin
q:=true; {如果打印步骤，表示肯定有出路}
writeln;
writeln;
writeln('穿越迷宫的步骤是：');
for m:=1 to 4 do
begin
for n:=1 to 4 do
write(c[m,n]:4);
writeln;
end
end;
procedure try(x,y,i:integer);
var
u,v,k:integer;
begin
for k:=1 to 4 do {可以有4个方向选择}
begin
u:=x+b[k,1]; {当前坐标加上方向增量}
v:=y+b[k,2];
if (u>=1) and (u<=4) and (v>=1) and (v<=4) then {判断是否越界}
if (a[u,v]=0) and (c[u,v]=0) then {判断是否为0，为0就表示通，为1就表示不通}
begin
if (x=2) and (y=3) then writeln('aaaaaaaaaaaa');
c[u,v]:=i; {数组 C打上记号，表示此元素是第I步到达}
if (u<>4) or (v<>4) then {判断是否到出口}
try(u,v,i+1) {没有就继续走}
else print;
c[u,v]:=0 {下一路所有方向都不通，清除本次所做的标记}
end
end
end;
begin
assign(fv,'shuju3.txt');
reset(fv);
for i:=1 to 4 do
begin
for j:=1 to 4 do
read(fv,a[i,j]);
readln(fv)
end;
b[1,1]:=-1; b[1,2]:=0;
b[2,1]:=0; b[2,2]:=1;
b[3,1]:=1; b[3,2]:=0;
b[4,1]:=0; b[4,2]:=-1;
close(fv);
for i:=1 to 4 do {首先标记数组C所有元素全部为0}
for j:=1 to 4 do c[i,j]:=0;
c[1,1]:=1;
for i:=1 to 4 do {显示迷宫具体线路，0表示通，1表示不通}
begin
for j:=1 to 4 do
write(a[i,j]:4);
writeln
end;
q:=false; {假设迷宫没有出路}
try(1,1,2);
if q=false then writeln( '此迷宫没有出路')
end.
扫一扫
434
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
