{-- 25/abr/2010 --}
program TestaOperadoresTADGrafo;
const MAXNUMVERTICES = 100;
      MAXNUMARESTAS  = 4500;
      MAXTAM         = MAXNUMVERTICES + 2 * MAXNUMARESTAS;
type
  TipoValorVertice = 0..MAXNUMVERTICES;
  TipoPeso         = integer;
  TipoTam          = 0..MAXTAM;
  TipoGrafo        = record
                       Cab           : array[TipoTam] of TipoTam;
                       Prox          : array[TipoTam] of TipoTam;
                       Peso          : array[TipoTam] of TipoTam;
                       ProxDisponivel: TipoTam;
                       NumVertices   : 0..MAXNUMVERTICES;
                       NumArestas    : 0..MAXNUMARESTAS;
                     end;
  TipoApontador    = TipoTam;
var
  Aux         : TipoApontador;
  i           : integer;
  V1, V2, Adj : TipoValorVertice;
  Peso        : TipoPeso;
  Grafo,GrafoT: TipoGrafo;
  NVertices   : TipoValorVertice;
  NArestas    : 0..MAXNUMARESTAS;
  FimListaAdj : boolean;

procedure FGVazio(var Grafo: TipoGrafo);
var i: integer;
begin
  for i := 0 to Grafo.NumVertices do
    begin
    Grafo.Prox[i] := 0;  Grafo.Cab[i] := i;
    Grafo.ProxDisponivel := Grafo.NumVertices;
    end;
end;

procedure InsereAresta (V1, V2    : TipoValorVertice;
                        Peso      : TipoPeso;
                        var Grafo : TipoGrafo);
var Pos: integer;
begin
  Pos:= Grafo.ProxDisponivel;
  if Grafo.ProxDisponivel = MAXTAM
  then writeln('nao ha espaco disponivel para a aresta')
  else begin
       Grafo.ProxDisponivel := Grafo.ProxDisponivel + 1;
       Grafo.Prox[Grafo.Cab[V1]] := Pos;
       Grafo.Cab[Pos]:= V2;   Grafo.Cab[V1] := Pos;
       Grafo.Prox[Pos] := 0;  Grafo.Peso[Pos] := Peso;
       end;
end; {InsereAresta }

function ExisteAresta (Vertice1, Vertice2: TipoValorVertice;
                       var Grafo: TipoGrafo): boolean;
var Aux: TipoApontador;  EncontrouAresta: boolean;
begin
  Aux := Grafo.Prox[Vertice1];  EncontrouAresta := false;
  while (Aux <> 0) and (EncontrouAresta = false) do
    begin
    if Vertice2 = Grafo.Cab[Aux] then EncontrouAresta := true;
    Aux := Grafo.Prox[Aux];
    end;
  ExisteAresta := EncontrouAresta;
end; { ExisteAresta }

{-- Operadores para obter a lista de adjacentes --}
function ListaAdjVazia (Vertice: TipoValorVertice;
                        var Grafo: TipoGrafo): boolean;
begin ListaAdjVazia := Grafo.Prox[Vertice] = 0; end; 

function PrimeiroListaAdj (Vertice: TipoValorVertice;
                           var Grafo: TipoGrafo): TipoApontador;
begin PrimeiroListaAdj := Grafo.Prox[Vertice]; end; 

procedure ProxAdj (Vertice: TipoValorVertice; var Grafo: TipoGrafo;
                   var Adj: TipoValorVertice; var Peso: TipoPeso;
                   var Prox: TipoApontador; var FimListaAdj: boolean);
{ --Retorna Adj apontado por Prox--}
begin
  Adj    := Grafo.Cab[Prox];
  Peso   := Grafo.Peso[Prox];
  Prox   := Grafo.Prox[Prox];
  if Prox = 0 then FimListaAdj := true;
end; { ProxAdj- }

procedure RetiraAresta (V1, V2: TipoValorVertice;
                        var Peso: TipoPeso; var Grafo: TipoGrafo);
var Aux, AuxAnterior: TipoApontador;  EncontrouAresta : boolean;
begin
  AuxAnterior := V1; Aux := Grafo.Prox[V1]; EncontrouAresta := false;
  while (Aux <> 0) and (EncontrouAresta = false) do
    begin
    if V2 = Grafo.Cab[Aux] 
    then EncontrouAresta := true
    else begin AuxAnterior := Aux;  Aux := Grafo.Prox[Aux]; end;
    end;
  if EncontrouAresta {-- Apenas marca como retirado --}
  then Grafo.Cab[Aux] := MAXNUMVERTICES + 2*MAXNUMARESTAS
  else writeln('Aresta nao existe');
end; { RetiraAresta }

procedure LiberaGrafo (var Grafo: TipoGrafo);
begin 
  { Nao faz nada no caso de posicoes contiguas }
end; { LiberaGrafo }

procedure ImprimeGrafo (var Grafo: TipoGrafo);
var i: integer;
begin
  writeln('    Cab Prox Peso');
  for i := 0 to Grafo.NumVertices+2*Grafo.NumArestas-1 do
    writeln(i:2,Grafo.Cab[i]:4,Grafo.Prox[i]:4, Grafo.Peso[i]:4);
end; { ImprimeGrafo }

procedure GrafoTransposto (var Grafo, GrafoT: TipoGrafo);
var v, Adj: TipoValorVertice; i: integer;
    Peso  : TipoPeso;
    Aux   : TipoApontador;
begin
  FGVazio (GrafoT);
  GrafoT.NumVertices := Grafo.NumVertices;
  GrafoT.NumArestas  := Grafo.NumArestas;
  for i := 0 to Grafo.NumVertices-1 do
    begin
    v := i;
    if not ListaAdjVazia (v, Grafo)
    then begin
         Aux := PrimeiroListaAdj (v, Grafo);
         FimListaAdj := false;
         while not FimListaAdj do
           begin
           ProxAdj (v, Grafo, Adj, Peso, Aux, FimListaAdj);
           InsereAresta (Adj, v, Peso, GrafoT);
           end;
         end;
    end;
end; { GrafoTransposto }

{ ============================================================= }
begin {-- Programa principal --}
{ -- NumVertices: definido antes da leitura das arestas --}
{ -- NumArestas: inicializado com zero e incrementado a --}
{ -- cada chamada de InsereAresta                       --}
  write ('No. vertices:'); readln (NVertices);
  write ('No. arestas:');  readln (NArestas);
  Grafo.NumVertices := NVertices;  Grafo.NumArestas := 0;
  FGVazio (Grafo);
  for i := 0 to NArestas - 1 do
    begin
    write ('Insere V1 -- V2 -- Peso:');  readln (V1, V2, Peso);
    Grafo.NumArestas := Grafo.NumArestas + 1;
    InsereAresta (V1, V2, Peso, Grafo); { 1 chamada g-direcionado    }
    InsereAresta (V2, V1, Peso, Grafo); { 2 chamadas g-naodirecionado}
    end;
  ImprimeGrafo (Grafo);  readln;
  GrafoTransposto (Grafo, GrafoT);
  ImprimeGrafo (GrafoT); readln;
  write ('Insere V1 -- V2 -- Peso:');  readln (V1, V2, Peso);
  if ExisteAresta (V1, V2, Grafo)
  then writeln ('Aresta ja existe')
  else begin
       Grafo.NumArestas := Grafo.NumArestas + 1;
       InsereAresta (V1, V2, Peso, Grafo);
       InsereAresta (V2, V1, Peso, Grafo);
       end;
  ImprimeGrafo (Grafo);  readln;
  write ('Lista adjacentes de: ');  read (V1);
  if not ListaAdjVazia (V1, Grafo)
  then begin
       Aux := PrimeiroListaAdj (V1, Grafo);  FimListaAdj := false;
       while not FimListaAdj do
         begin
         ProxAdj (V1, Grafo, Adj, Peso, Aux, FimListaAdj);
         write (Adj:2, ' (', Peso, ')');
         end;
       writeln; readln;
       end;
  write ('Retira aresta V1 -- V2:');  readln (V1, V2);
  if ExisteAresta (V1, V2, Grafo)
  then begin
       Grafo.NumArestas := Grafo.NumArestas - 1;
       RetiraAresta (V1, V2, Peso, Grafo);
       RetiraAresta (V2, V1, Peso, Grafo); 
       end
  else writeln ('Aresta nao existe');
  ImprimeGrafo (Grafo);  readln;
  write ('Existe aresta V1 -- V2:');  readln (V1, V2);
  if ExisteAresta(V1, V2, Grafo) then writeln(' Sim') else writeln(' Nao');
  LiberaGrafo (Grafo); 
end.