历史主观题答题模板:求一道Pascal的程序!!!!

来源:百度文库 编辑:神马品牌网 时间:2024/04/28 14:33:53
求Pascal语言的程序:
按一个邻接矩阵输入一个图,输出广度优先搜索遍历(序号小的先遍历)
输出样例:V1-V2-V5-V4

递归算法:
program graph02;
{******** 邻接表表示的无向图BFs递归算法 **********}
{******* By DuQinglong 2005.3 *******}
const maxn=10;
type
datatype=integer;
nodep=^node;
node=record {*** 邻接表结点 ***}
vertex:1..maxn;
next:nodep;
end;
gnode=record {*** 图中数据结点***}
data:datatype;
head:nodep;
end;
graph=record {*** 图的类型 ***}
a:array[1..maxn]of gnode;
vexn:integer;
end;
var g:graph;
f:array[1..maxn]of boolean; {**flag**}
qu:array[1..maxn]of integer;
front,rear:integer;
fin,fout:text;
{*** 输入文件要求:第一行数据为图顶点个数,从第二行开始,第i行第一个数据为第i个结点的数据,
后面的为第i个结点的邻接顶点的编号 ***}
procedure buildadjlist(var g:graph); {*** 建立图的结构,用邻接表表示 ***}
var i,t:integer; p,q:nodep; k:1..maxn;
begin
readln(fin,g.vexn); {*** 读入图的顶点个数 ***}
for i:=1 to g.vexn do
begin
read(fin,g.a[i].data);
g.a[i].head:=nil;
t:=0;
while not eoln(fin) do {*** 采用尾插法建立链表 ***}
begin
read(fin,k);
t:=t+1;
new(p);
p^.vertex:=k;
p^.next:=nil;
if (t=1) then begin g.a[i].head:=p; q:=p; end
else begin q^.next:=p; q:=p; end;
end;
readln(fin); {*** 文件指针指向下一行 ***}
end;
end;
procedure bfs(g:graph; i:integer); {*** 输出从顶点i开始的连通分量 ***}
var p:nodep;
begin
p:=g.a[i].head;
while (p<>nil) do
begin
if (not f[p^.vertex]) then
begin
write(fout,'V',p^.vertex:1,' ');
f[p^.vertex]:=true;
inc(rear);
if (rear>maxn)then rear:=1;
qu[rear]:=p^.vertex;
end;
p:=p^.next;
end;
while (front<>rear) do
begin
inc(front);
if (front>maxn) then front:=1;
bfs(g,qu[front]);
end;
end;
procedure trav_bfs(g:graph); {*** 访问图中所有顶点 ***}
var i:integer;
begin
fillchar(f,sizeof(f),false); {*** 将访问标记数组置为false ***}
for i:=1 to g.vexn do
if (not f[i]) then
begin
write(fout,'V',i:1,' ');
f[i]:=true; front:=1; rear:=1;
bfs(g,i);
end;
end;
begin
assign(fin,'a.in');
assign(fout,'a.out');
reset(fin);
rewrite(fout);
buildadjlist(g);
close(fin);
trav_bfs(g);
close(fout);
end.

非递归算法:
program graph02;
{******** 邻接表表示的无向图BFS非递归算法 **********}
{******* By DuQinglong 2005.3 *******}
const maxn=20;
type
datatype=integer;
nodep=^node;
node=record {*** 邻接表结点 ***}
vertex:1..maxn;
next:nodep;
end;
gnode=record {*** 图中数据结点***}
data:datatype;
head:nodep;
end;
graph=record {*** 图的类型 ***}
a:array[1..maxn]of gnode;
vexn:integer;
end;
var g:graph;
f:array[1..maxn]of boolean; {**flag**}
qu:array[1..maxn]of integer;
front,rear:integer;
fin,fout:text;
{*** 输入文件要求:第一行数据为图顶点个数,从第二行开始,第i行第一个数据为第i个结点的数据,
后面的为第i个结点的邻接顶点的编号 ***}
procedure buildadjlist(var g:graph); {*** 建立图的结构,用邻接表表示 ***}
var i,t:integer; p,q:nodep; k:1..maxn;
begin
readln(fin,g.vexn); {*** 读入图的顶点个数 ***}
for i:=1 to g.vexn do
begin
read(fin,g.a[i].data);
g.a[i].head:=nil;
t:=0;
while not eoln(fin) do {*** 采用尾插法建立链表 ***}
begin
read(fin,k);
t:=t+1;
new(p);
p^.vertex:=k;
p^.next:=nil;
if (t=1) then begin g.a[i].head:=p; q:=p; end
else begin q^.next:=p; q:=p; end;
end;
readln(fin); {*** 文件指针指向下一行 ***}
end;
end;
procedure bfs(g:graph; i:integer); {*** 输出从顶点i开始的连通分量 ***}
var p:nodep; t:integer;
begin
write(fout,'V',i:1,' ');
f[i]:=true;
front:=0; rear:=1; qu[rear]:=i; {*** i入队 ***}
while (front<>rear) do
begin
inc(front); {*** 出队操作 ***}
if front>maxn then front:=1;
t:=qu[front];
p:=g.a[t].head;
while (p<>nil) do
begin
if not f[p^.vertex] then {*** 邻接顶点未被访问时 ***}
begin
write(fout,'V',p^.vertex:1,' ');
f[p^.vertex]:=true;
inc(rear);
if (rear>maxn) then rear:=1;
qu[rear]:=p^.vertex;
end;
p:=p^.next;
end;
end;
end;
procedure trav_bfs(g:graph); {*** 访问图中所有顶点 ***}
var i:integer;
begin
fillchar(f,sizeof(f),false); {*** 将访问标记数组置为false ***}
for i:=1 to g.vexn do
if (not f[i]) then bfs(g,i);
end;
begin
assign(fin,'a.in');
assign(fout,'a.out');
reset(fin);
rewrite(fout);
buildadjlist(g);
close(fin);
trav_bfs(g);
close(fout);
end.

const maxv=50; {最大结点数}
type queue=record {顺序队列类型}
data:array[1..100]of integer;
front,rear:integer;
end;
graph=record {图类型}
e:array[1..maxv,1..maxv]of integer;
visited:array[1..maxv]of boolean;
v:array[1..maxv]of char;
length:integer;
end;
stack=record {顺序栈类型}
data:array[1..100]of integer;
top:integer;
end;
var g:graph; f:text; i,j:integer;
{建立图}
procedure gcreat(var g:graph);
var i,j,k:integer;
begin
readln(f,g.length); {读入结点数}
for i:=1 to g.length do begin
for j:=1 to g.length do begin {读入矩阵}
read(f,k);
g.e[i,j]:=k;
end;
readln(f);
end;
for i:=1 to g.length do g.v[i]:=chr(i+64); {结点标记}
end;

{队列}
function isempty(q:queue):boolean; {判断是否为空队}
begin
isempty:=(q.front=q.rear);
end;
procedure inqueue(var q:queue;k:integer); {入队}
var i:integer;
begin
if isempty(q) then begin
inc(q.front);
q.data[q.front]:=k;
end else begin
inc(q.front);
for i:=q.front downto q.rear+2 do q.data[i]:=q.data[i-1];
q.data[q.rear+1]:=k;
end;
end;
procedure outqueue(var q:queue); {出队}
var i:integer;
begin
if not isempty(q) then dec(q.front);
end;
Function gethead(q:queue):integer; {取队首元素}
begin
if not isempty(q) then gethead:=q.data[q.front];
end;
procedure clear(var q:queue); {清空队列}
begin
fillchar(q.data,sizeof(q.data),0);
q.front:=0;
q.rear:=0;
end;
{栈}
procedure clears(var s:stack); {清空栈}
begin
s.top:=0;
end;
function sempty(s:stack):boolean; {判断是否为空栈}
begin
sempty:=(s.top=0);
end;
procedure instack(var s:stack; k:integer); {进栈}
begin
inc(s.top);
s.data[s.top]:=k;
end;
procedure pop(var s:stack); {抛栈}
begin
if not sempty(s) then dec(s.top);
end;
function gettop(s:stack):integer; {取栈顶元素}
begin
gettop:=s.data[s.top];
end;
{深度搜索,非递归算法}
procedure dfs(var g:graph; i:integer);
var j,t:integer; flag:boolean; s:stack;
begin
clears(s);
write(f,g.v[i]); {访问处理结点i}
g.visited[i]:=true;
instack(s,i); {i入栈}
while not sempty(s) do begin
flag:=false;
t:=gettop(s);
for j:=1 to g.length do if g.e[t,j]<>0 and not g.visited[j] then
begin{找未访问的邻结点}
flag:=true; {有未访问的邻结点}
break;
end else pop(s); {无满足要求的结点,抛栈}
if flag then begin
write(f,g.v[j]); {访问处理}
g.visited[j]:=true;
instack(s,j); {入栈}
end;
end;
end;
procedure traverd(var g:graph); {全面搜索}
var i:integer;
begin
for i:=1 to g.length do if not g.visited[i] then dfs(g,i);
end;
{广度搜索}
procedure bfs(var g:graph;i:integer);
var j,t:integer; q:queue;
begin
clear(q);
write(f,g.v[i]); {访问处理}
g.visited[i]:=true;
inqueue(q,i); {入队}
while not isempty(q) do begin
t:=gethead(q); {取队头}
outqueue(q); {出队}
for j:=1 to g.length do begin
if g.e[t,j]<>0 and not g.visited[j] then begin
write(f,g.v[j]); {访问未访问的邻接点}
g.visited[j]:=true;
inqueue(q,j); {入队}
end;
end;
end;
end;
procedure traverb(var g:graph); {全面搜索}
var i:integer;
begin
fillchar(g.visited,sizeof(g.visited),false);
for i:=1 to g.length do if not g.visited[i] then bfs(g,i);
end;
{主程序}
begin
assign(f,'graph.in');
reset(f);
gcreat(g);
close(f);
assign(f,'dfs.out');
rewrite(f);
traverd(g);
close(f);
assign(f,'bfs.out');
rewrite(f);
traverb(g);
close(f);
end.