{-- 25/abr/2010 --}
program TestaOperadoresTADGrafo;
const MAXNUMVERTICES = 100;
      MAXNUMARESTAS  = 4500;
type
  TipoValorVertice = 0..MAXNUMVERTICES;
  TipoPeso         = integer;
  TipoGrafo        = record
                       Mat: array[TipoValorVertice,TipoValorVertice] 
                            of TipoPeso;
                       NumVertices: 0..MAXNUMVERTICES;
                       NumArestas : 0..MAXNUMARESTAS;
                     end;
  TipoApontador    = TipoValorVertice;
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, j: integer;
begin
  for i := 0 to Grafo.NumVertices do
    for j := 0 to Grafo.NumVertices do
      Grafo.mat[i, j] := 0;
end;

procedure InsereAresta (V1, V2: TipoValorVertice;
                        Peso  : TipoPeso;
                        var Grafo : TipoGrafo);
begin
  Grafo.Mat[V1, V2] := peso;
end;

function ExisteAresta (Vertice1, Vertice2: TipoValorVertice;
                       var Grafo: TipoGrafo): boolean;
begin
  ExisteAresta := Grafo.Mat[Vertice1, Vertice2] > 0;
end; { ExisteAresta }

{-- Operadores para obter a lista de adjacentes --}
function ListaAdjVazia (Vertice: TipoValorVertice;
                        var Grafo: TipoGrafo): boolean;
var Aux: TipoApontador;  ListaVazia: boolean;
begin
  ListaVazia := true;  Aux := 0;
  while (Aux < Grafo.NumVertices) and ListaVazia do
    if Grafo.Mat[Vertice, Aux] > 0
    then ListaVazia := false
    else Aux := Aux + 1;
  ListaAdjVazia := ListaVazia = true;
end; { ListaAdjVazia }

function PrimeiroListaAdj (Vertice: TipoValorVertice;
                           var Grafo: TipoGrafo): TipoApontador;
var Aux: TipoApontador;  ListaVazia: boolean;
begin
  ListaVazia := true;  Aux := 0;
  while (Aux < Grafo.NumVertices) and ListaVazia do
    if Grafo.Mat[Vertice, Aux] > 0
    then begin PrimeiroListaAdj := Aux; ListaVazia := false; end
    else Aux := Aux + 1;
  if Aux = Grafo.NumVertices 
  then writeln ('Erro: Lista adjacencia vazia (PrimeiroListaAdj)');
end; { PrimeiroListaAdj }

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 := Prox; Peso := Grafo.Mat[Vertice, Prox]; Prox := Prox + 1;
  while (Prox < Grafo.NumVertices) and (Grafo.Mat[Vertice,Prox] = 0) do
    Prox := Prox + 1;
  if Prox = Grafo.NumVertices then FimListaAdj := true;
end; { ProxAdj }

procedure RetiraAresta (V1, V2: TipoValorVertice;
                        var Peso: TipoPeso; var Grafo: TipoGrafo);
begin
  if Grafo.Mat[V1, V2] = 0
  then writeln ('Aresta nao existe')
  else begin Peso := Grafo.Mat[V1, V2]; Grafo.Mat[V1, V2] := 0; end;
end; { RetiraAresta }

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

procedure ImprimeGrafo (var Grafo : TipoGrafo);
var i, j: integer;
begin
  write ('   ');
  for i := 0 to Grafo.NumVertices-1 do write (i:3); writeln;
  for i := 0 to Grafo.NumVertices-1 do
    begin
    write (i:3);
    for j := 0 to Grafo.NumVertices-1 do write (Grafo.mat[i, j]:3);
    writeln;
    end;
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;
  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.

