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.

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;

Then instead of:

 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.