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);
for i:=1 to n do begin
j:=0;
with peak[i] do begin
repeat
inc(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;
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;

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
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;

var
i,u,v,m:byte;
begin
assign(f,fi); reset(f);
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
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;

var
i,u,v,m:integer;
begin
assign(f,fi); reset(f);
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
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
Process;
PrintResult;
end.
``````

Good to see some activity here, so thumbs up for posting this. Should it be under Tutorials?

One suggestion I would make is to use more meaningful variable names. The code would be much easier to scan and you would not need comments to explain what your variables are for. Rather than:

`````` n,s,e:byte; //n: number of vertices, s: start vertex, e: end vertex
``````

Consider something like:

``````VertexCount : byte;
StartVertex : byte;
EndVertex : byte;
``````

`````` readln(f,n,s,e);
``````

You might have:

`````` readln(SourceFile, VertexCount, StartVertex, EndVertex);
``````

Some people dislike long variable names so you might choose shorter names than my suggestions, but you need a good compromise between brevity and clarity. EG:

`````` readln(InFile, VCount, VStart, VEnd);
``````

Just a suggestion, not trying to pick holes.

commented: Thanks for your suggest, sorry for being long to visit here. +0
Be a part of the DaniWeb community

We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.