These programs are not perfect and very coarcenes but I think it understandable for who are new to learning Graph Theory. I will point directly each problem by using example code. Any questions or idea please post here. Thank you.
Here are my programs, we will start with a basic problem:
1) Depth-first Search (DFS) without using marking array.
In this program, I used record "point" for demonstrate Adjacency List of the Graph.
program DFS;
const
fi='DFS.ip';
fo='DFS.op';
ma=100;
type
point=record //each point mean a vertex of the Graph
cn:array[1..ma] of byte; //connected vertices with "point"
deg,def:byte; //deg: degree of "point", def: name of "point" (ordinal number of "point")
end;
var
n,s,e:byte; //n: number of vertices, s: start vertex, e: end vertex
f:text;
peak:array[1..ma] of point; //vertices of the Graph
trace:array[1..ma] of shortint; //use this to save path from s to e
procedure input;
var
i,j:byte;
begin
assign(f,fi); reset(f);
readln(f,n,s,e);
for i:=1 to n do begin
j:=0;
with peak[i] do begin
repeat
inc(j);
read(f,cn[j]);
until cn[j]=0; //depend on input scheme
deg:=j-1; //because the last thing cn[j] read is "0", so remove it from count
def:=i;
end;
end;
close(f);
fillchar(trace,n,0); //use this array directly to follow the free vertices
trace[s]:=-1; //mark the start vertex
end;
procedure attempt(a:point);
var
i:byte;
begin
for i:=1 to a.deg do //check all vertices which are connected to "a" vertex.
if trace[a.cn[i]]=0 then begin //trace[...]=0 mean this is free vertex (we haven't done anythings to this vertex yet)
trace[a.cn[i]]:=a.def; //previous vertex of "peak[a.cn[i]]" is "a", this procedure use for tracking the path.
attempt(peak[a.cn[i]]); //repeat the process, go on until all vertices are pass though (those "trace" are <>0)
end;
end;
procedure output;
var
i:byte;
begin
assign(f,fo); rewrite(f);
if trace[e]=0 then
writeln(f,'No solution')
else begin
writeln(f,'Reachable peaks from ',s,':');
for i:=1 to n do
if trace[i]<>0 then //trace[i]<>0 mean we have already visit this vertex
write(f,i,' ');
writeln(f);
writeln(f,'The path from ',s,' to ',e,':');
while s<>e do begin
write(f,e,'<-');
e:=trace[e];
end;
writeln(f,s);
end;
close(f);
end;
begin
input;
attempt(peak[s]); //start with the start vertex
output;
end.
Example:
DFS.ip //Simple Graph without weight
8 1 8
2 3 0
1 3 4 0
1 2 4 0
2 3 5 6 0
4 0
4 8 0
0
6 0
DFS.op
Reachable peaks from 1:
1 2 3 4 5 6 8
The path from 1 to 8:
8<-6<-4<-3<-2<-1
2) Find the shortest path from an start vertex to all vertices of the Graph using Bellman-Ford method
This case I will use Adjacency Matrix to perform the Graph, I thinks matrix is useful with this method.
program FordBellman;
const
fi='FordBellman.ip';
fo='FordBellman.op';
ma=100;
inf=30000;
var
c:array[1..ma,1..ma] of integer; //Adjacency Matrix to perform the Graph
d:array[1..ma] of integer; //save the min cost from it to the start vertex (ex: with s=1, d[5] mean min cost form 1 to 5)
trace,r:array[1..ma] of byte; //trace is use for save the path
n:byte; //number of vertices
f:text;
procedure LoadGraph;
var
i,m,u,v:byte;
begin
assign(f,fi); reset(f);
readln(f,n,m); //m is the number of edges
for u:=1 to n do
for v:=1 to n do
if u=v then
c[u,v]:=0 //if u=v that mean it lie on the main diagonal of matrix
else
c[u,v]:=inf; //at the beginning, anythings else set the weight of (u,v) edge to infinity
for i:=1 to m do begin
readln(f,u,v,c[u,v]); //now read the weight of each (u,v) edge
c[v,u]:=c[u,v]; //because this method require a greedy check, plus, we using scalar graph
end;
close(f);
end;
procedure Init;
var
i:byte;
begin
for i:=1 to n do
d[i]:=inf;
d[1]:=0; I default the start vertex is vertex 1, so set it cost (mean min cost from it to start vertex) to 0
end;
procedure Process;
var
u,v,i:byte;
stop:boolean;
begin
for i:=1 to n-1 do begin //this method just require at most n-1 repeat time
stop:=true;
for u:=1 to n do
for v:=1 to n do
if d[v]>d[u]+c[u,v] then begin //this repeater will fix all d[...] to the minimum value that they can reach
d[v]:=d[u]+c[u,v];
trace[v]:=u; //saving the min path by tracking the previous vertex
stop:=false; //this mean if still vertex then the procedure will not be quit
end;
if stop then //this mean we are reach all reachable vertical
break;
end;
end;
procedure PrintResult;
var
i,j:byte;
begin
assign(f,fo); rewrite(f);
for i:=2 to n do
if d[i]<>inf then begin
r:=trace;
j:=i;
write(f,'The min path from 1 to ',i,': ');
while j<>1 do begin
write(f,j,'<-');
j:=r[j];
end;
writeln(f,1);
writeln(f,' with cost: ',d[i]);
end;
close(f);
end;
begin
LoadGraph;
Init;
Process;
PrintResult;
end.
3) The same problem with "2)" but with the Dijsktra method
program Dijsktra;
const
fi='Dijsktra.ip';
fo='Dijsktra.op';
ma=100;
inf=30000;
var
n:byte;
f:text;
c:array[1..ma,1..ma] of integer;
d:array[1..ma] of integer;
trace:array[1..ma] of byte;
free:array[1..ma] of boolean;
procedure LoadGraph;
var
i,u,v,m:byte;
begin
assign(f,fi); reset(f);
readln(f,n,m);
for u:=1 to n do
for v:=1 to n do
if u=v then
c[u,v]:=0
else
c[u,v]:=inf;
for i:=1 to m do
readln(f,u,v,c[u,v]); //KE CA CO HUONG LAN VO HUONG
close(f);
end;
procedure Init;
var
i:byte;
begin
for i:=1 to n do
d[i]:=inf;
d[1]:=0;
fillchar(free,n,true);
end;
procedure Process;
var
u,v,i:byte;
min:integer;
begin
repeat
u:=0; min:=inf;
for i:=1 to n do
if (free[i])and(d[i]<min) then begin
u:=i;
min:=d[i];
end;
if (u=0)or(u=n) then
break;
free[u]:=false;
for v:=1 to n do
if (free[v])and(d[v]>d[u]+c[u,v]) then begin
d[v]:=d[u]+c[u,v];
trace[v]:=u;
end;
until false;
end;
procedure PrintResult;
var
i,j:byte;
r:array[1..ma] of byte;
begin
assign(f,fo); rewrite(f);
for i:=2 to n do
if d[i]<>inf then begin
j:=i;
r:=trace;
write(f,'The min path from 1 to ',i,': ');
while j<>1 do begin
write(f,j,'<-');
j:=r[j];
end;
writeln(f,1);
writeln(f,' with cost: ',d[i]);
end;
close(f);
end;
begin
LoadGraph;
Init;
Process;
PrintResult;
end.
4) Find the shortest path between 2 vertices but must though a define vertex by Dijsktra method
program GraphPlus;
const
fi='D:\GP.inp';
fo='D:\GP.out';
ma=1000;
inf=15000;
var
n,s,e,t:integer;
f:text;
c:array[1..ma,1..ma] of integer;
d,trace,r1,r2:array[1..ma] of integer;
free:array[1..ma] of boolean;
procedure LoadGraph;
var
i,u,v,m:integer;
begin
assign(f,fi); reset(f);
readln(f,n,m,s,e,t);
for u:=1 to n do
for v:=1 to n do
if u=v then
c[u,v]:=0
else
c[u,v]:=inf;
for i:=1 to m do begin
readln(f,u,v,c[u,v]);
c[v,u]:=c[u,v]; //do thi vo huong
end;
close(f);
end;
procedure Process;
var
x:integer;
//-----------------------------------------------------
procedure Init(a:integer);
var
i:integer;
begin
for i:=1 to n do begin
d[i]:=inf;
free[i]:=true;
end;
d[a]:=0;
end;
procedure ShortestPath(a:integer);
var
i,u,v,min:integer;
begin
repeat
u:=0;
min:=inf;
for i:=1 to n do
if (free[i])and(d[i]<min) then begin
u:=i;
min:=d[i];
end;
if (u=0)or(u=a) then
break;
free[u]:=false;
for v:=1 to n do
if (free[v])and(d[v]>d[u]+c[u,v]) then begin
d[v]:=d[u]+c[u,v];
trace[v]:=u;
end;
until false;
end;
//-----------------------------------------------------
begin
Init(s);
ShortestPath(t);
x:=d[t];
r1:=trace;
Init(t);
ShortestPath(e);
d[e]:=x+d[e];
r2:=trace;
end;
procedure PrintResult;
var
i:integer;
begin
assign(f,fo); rewrite(f);
if d[e]>=inf then
write(f,'No solution!')
else begin
i:=d[e];
write(f,'Min path from ',s,' to ',e,' though ',t,': ');
while e<>t do begin
write(f,e,'<-');
e:=r2[e];
end;
While t<>s do begin
write(f,t,'<-');
t:=r1[t];
end;
writeln(f,s);
write(f,'With cost: ',i);
end;
close(f);
end;
begin
LoadGraph;
Process;
PrintResult;
end.