{-- 25/abr/2010 --}
program TestaOperadoresTADGrafo;
const MAXNUMVERTICES = 100;
      MAXNUMARESTAS  = 4500;
type
  TipoValorVertice = 0..MAXNUMVERTICES;
  TipoPeso         = integer;
  TipoItem         = record
                       Vertice: TipoValorVertice;
                       Peso   : TipoPeso;
                     end;
  TipoApontador    = ^TipoCelula;
  TipoCelula       = record
                       Item: TipoItem;
                       Prox: TipoApontador;
                     end;
  TipoLista        = record
                       Primeiro: TipoApontador;
                       Ultimo: TipoApontador;
                     end;
  TipoGrafo        = record
                      Adj        : array[TipoValorVertice] of TipoLista;
                      NumVertices: TipoValorVertice;
                      NumArestas : 0..MAXNUMARESTAS;
                     end;
var
  Aux         : TipoApontador;
  i           : integer;
  V1, V2, Adj : TipoValorVertice;
  Peso        : TipoPeso;
  Grafo,GrafoT: TipoGrafo;
  NVertices   : TipoValorVertice;
  NArestas    : 0..MAXNUMARESTAS;
  FimListaAdj : boolean;

{--Entram aqui os operadores do Programa 3.4--}
procedure FLVazia (var Lista: TipoLista);
begin
  new (Lista.Primeiro);
  Lista.Ultimo := Lista.Primeiro;
  Lista.Primeiro^.Prox := nil
end; { FLVazia }

function Vazia (Lista: TipoLista): boolean;
begin
  Vazia := Lista.Primeiro = Lista.Ultimo
end; { Vazia }

procedure Insere (var x: TipoItem; var Lista: TipoLista);
{-- Insere depois do ultimo item da lista --}
begin
  new (Lista.Ultimo^.Prox);
  Lista.Ultimo := Lista.Ultimo^.Prox;
  Lista.Ultimo^.Item := x;
  Lista.Ultimo^.Prox := nil
end; { Insere }
{-- Fim operadores do Programa 2.4 --}

procedure FGVazio (var Grafo: TipoGrafo);
var i: integer;
begin
  for i := 0 to Grafo.NumVertices-1 do FLVazia (Grafo.Adj[i]);
end; { FGVazio }

procedure InsereAresta (V1, V2    : TipoValorVertice;
                        Peso      : TipoPeso;
                        var Grafo : TipoGrafo);
var x    : TipoItem;
begin
  x.Vertice := V2;
  x.Peso    := Peso;
  Insere (x, Grafo.Adj[V1]);
end; { InsereAresta }

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

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

function PrimeiroListaAdj (Vertice: TipoValorVertice;
                           var Grafo: TipoGrafo): TipoApontador;
begin
  PrimeiroListaAdj := Grafo.Adj[Vertice].Primeiro^.Prox;
end; { PrimeiroListaAdj }

procedure ProxAdj (Vertice         : TipoValorVertice;
                   var Grafo       : TipoGrafo;
                   var Adj         : TipoValorVertice;
                   var Peso        : TipoPeso;
                   var Prox        : TipoApontador;
                   var FimListaAdj : boolean);
{ --Retorna Adj e Peso do Item apontado por Prox--}
begin
  Adj    := Prox^.Item.Vertice;
  Peso   := Prox^.Item.Peso;
  Prox   := Prox^.Prox;
  if Prox = nil then FimListaAdj := true;
end; { ProxAdj- }

procedure RetiraAresta (V1, V2: TipoValorVertice;
                        var Peso  : TipoPeso; var Grafo : TipoGrafo);
var AuxAnterior, Aux: TipoApontador;
    EncontrouAresta: boolean; x: TipoItem;

  procedure Retira (p: TipoApontador;
                    var Lista: TipoLista;
                    var Item: TipoItem);
  {--Obs.: item a ser retirado e o seguinte ao apontado por p--}
  var q: TipoApontador;
  begin
    if Vazia (Lista) or (p = nil) or (p^.Prox = nil)
    then writeln ('Erro: Lista vazia ou posicao nao existe')
    else begin
         q := p^.Prox;
         Item := q^.Item;
         p^.Prox := q^.Prox;
         if p^.Prox = nil then Lista.Ultimo := p;
         dispose (q)
         end;
  end; { Retira }
begin { RetiraAresta }
  AuxAnterior := Grafo.Adj[V1].Primeiro;
  Aux := Grafo.Adj[V1].Primeiro^.Prox;
  EncontrouAresta := false;
  while (Aux <> nil) and (EncontrouAresta = false) do
    begin
    if V2 = Aux^.Item.Vertice
    then begin
         Retira (AuxAnterior, Grafo.Adj[V1], x);
         Grafo.NumArestas := Grafo.NumArestas - 1;
         EncontrouAresta := true;
         end;
    AuxAnterior := Aux;  Aux := Aux^.Prox;
    end;
end; { RetiraAresta }

procedure LiberaGrafo (var Grafo: TipoGrafo);
var AuxAnterior, Aux: TipoApontador;
begin
for i:= 0 to Grafo.NumVertices-1 do
  begin
  Aux := Grafo.Adj[i].Primeiro^.Prox;
  dispose (Grafo.Adj[i].Primeiro); {Libera celula cabeca}
  while Aux <> nil do
    begin
    AuxAnterior := Aux;  Aux := Aux^.Prox;  dispose (AuxAnterior);
    end;
  end;
end; { LiberaGrafo }

procedure ImprimeGrafo (var Grafo : TipoGrafo);
var i: integer;  Aux: TipoApontador;
begin
  for i:= 0 to Grafo.NumVertices-1 do
    begin
    write ('Vertice', i:2,':');
    if not Vazia (Grafo.Adj[i]) 
    then begin
         Aux := Grafo.Adj[i].Primeiro^.Prox;
         while Aux <> nil do 
           begin
           write (Aux^.Item.Vertice:3,' (',Aux^.Item.Peso,')');
           Aux := Aux^.Prox;
           end;
         end;
    writeln;
    end;
end; { ImprimeGrafo }

procedure GrafoTransposto (var Grafo, GrafoT: TipoGrafo);
var v, Adj: TipoValorVertice;  i: integer;
    Peso  : TipoPeso;
    Aux   : TipoApontador;

  procedure ImprimeLista (Lista: TipoLista);
  var Aux: TipoApontador;
  begin
    Aux := Lista.Primeiro^.Prox;
    while Aux <> nil do begin
      write (Aux^.Item.Vertice:3,' (',Aux^.Item.Peso,')');
      Aux := Aux^.Prox;
    end;
  end; { ImprimeLista }

begin
  GrafoT.NumVertices := Grafo.NumVertices;
  GrafoT.NumArestas  := Grafo.NumArestas;
  FGVazio (GrafoT);
  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;
  writeln ('Grafo transposto:');
  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.