Ir ao conteúdo
  • Cadastre-se

Fazer um algoritmo em pascal do grafo chamado caminho e no final do programa mostrar a mensagem "sair".


Posts recomendados

Eu implementei o algoritmo de Dijkstra, que busca o Menor Caminho em Grafos, mas não sei se está correto.

{-- 26/Outubro/2015 --}program DijkstraMatriz;const MAXNUMVERTICES = 100;      MAXNUMARESTAS  = 4500;      INFINITO       = MAXINT;type  TipoValorVertice = 0..MAXNUMVERTICES;  TipoPeso         = integer;  TipoGrafo        = record                       Mat:array[TipoValorVertice,TipoValorVertice]                            of TipoPeso;                       NumVertices: 0..MaxNumvertices;                       NumArestas : 0..MAXNUMARESTAS;                     end;  TipoApontador    = TipoValorVertice;  TipoIndice       = TipoValorVertice;  TipoItem         = record                       Chave: TipoPeso;                     end;  TipoVetor        = array[TipoIndice] of TipoItem;var  Aux        : TipoApontador;  i          : integer;  V1, V2, Adj: TipoValorVertice;  Peso       : TipoPeso;  Grafo      : TipoGrafo;  NVertices  : TipoValorVertice;  NArestas   : 0..MAXNUMARESTAS;  FimListaAdj: boolean;  n          : TipoIndice; {Tamanho do heap}  Raiz       : TipoValorVertice;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 (var V1, V2: TipoValorVertice;                        var 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 (var 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 (var 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 (var 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 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 Dijkstra (var Grafo: TipoGrafo; var Raiz: TipoValorVertice);var Antecessor: array[TipoValorVertice] of integer;    P         : array[TipoValorVertice] of TipoPeso;    Itensheap : array[TipoValorVertice] of boolean;    Pos       : array[TipoValorVertice] of TipoValorVertice;    A         : TipoVetor;    u, v      : TipovalorVertice;        procedure RefazInd (Esq, Dir: TipoIndice; var A: TipoVetor);label 999;var i: TipoIndice;  j: integer;  x: TipoItem;begin  i := Esq;  j := 2 * i;  x := A[i];  while j <= Dir do    begin    if j < Dir    then if p[A[j].Chave] > p[A[j + 1].Chave] then j := j + 1;    if p[x.Chave] <= p[A[j].Chave] then goto 999;    A[i] := A[j];  Pos[A[j].Chave] := i;    i := j;  j := 2 * i;    end;  999: A[i] := x;  Pos[x.Chave] := i;end; { RefazInd }procedure Constroi (var A: TipoVetor);var Esq: TipoIndice;begin  Esq := n div 2 + 1;  while Esq > 1 do    begin    Esq := Esq - 1;    RefazInd (Esq, n, A);    end;end; { Constroi }function RetiraMinInd (var A: TipoVetor): TipoItem;begin  if n < 1  then writeln ('Erro: heap vazio')  else begin       RetiraMinInd := A[1];       A[1] := A[n];  Pos[A[n].chave] := 1;       n := n - 1;       RefazInd (1, n, A);       end;end; { RetiraMinInd }procedure DiminuiChaveInd (i: TipoIndice; ChaveNova: TipoPeso; var A: TipoVetor);var x: TipoItem;begin  if ChaveNova > p[A[i].Chave]  then writeln ('Erro: ChaveNova maior que a chave atual')  else begin       p[A[i].Chave] := ChaveNova;       while (i>1) and (p[A[i div 2].Chave] > p[A[i].Chave])         do begin            x := A[i div 2];            A[i div 2] := A[i];  Pos[A[i].Chave] := i div 2;            A[i] := x;  Pos[x.Chave] := i;            i := i div 2;            end;       end;end; { DiminuiChaveInd }begin { Dijkstra }  for u := 0 to Grafo.NumVertices do    begin {Constroi o heap com todos os valores igual a INFINITO}    Antecessor[u] := -1;      p[u] := INFINITO;    A[u+1].Chave := u; {Heap a ser construido}    ItensHeap[u] := true;      Pos[u] := u+1;    end;  n := Grafo.NumVertices;  p[Raiz] := 0;  Constroi (A);  while n >= 1 do {enquanto heap nao vazio}    begin    u := RetiraMinInd(A).Chave;    ItensHeap[u] := false;    if not ListaAdjVazia (u,Grafo)       then begin            Aux := PrimeiroListaAdj (u,Grafo);          FimListaAdj := false;            while not FimListaAdj do              begin              ProxAdj (u, Grafo, v, Peso, Aux, FimListaAdj);              if p[v] > p[u] + Peso              then begin                   p[v] := p[u] + Peso;                   Antecessor[v] := u;                   DiminuiChaveInd (Pos[v],p[v],A);                   write ('Caminho: v[',v,'] v[',Antecessor[v],']',                         ' d[',p[v],']');readln;                   end;              end;            end;    end;end; { Dijkstra }{ ============================================================= }begin {-- Programa principal --}{ -- NumVertices: definido antes da leitura das arestas --}{ -- NumArestas: inicializado com zero e incrementado a --}{ -- cada chamada de InsereAresta                       --}  writeln (' vertices:');  readln (NVertices);  writeln (' arestas:');  readln (NArestas);  Grafo.NumVertices := NVertices;  Grafo.NumArestas := 0;  FGVazio (Grafo);{  for i := 0 to NArestas-1 do    begin    write ('Insere V1 -- V2 -- Aresta:');    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 nao-direcionado} {    end;}    V1 := 0; V2 := 1; Peso := 1;    Grafo.NumArestas := Grafo.NumArestas + 1;    InsereAresta (V1, V2, Peso, Grafo); {1 chamada : G direcionado}   {InsereAresta (V2, V1, Peso, Grafo);}{2 chamadas: G nao-direcionado}    V1 := 0; V2 := 3; Peso := 3;    Grafo.NumArestas := Grafo.NumArestas + 1;    InsereAresta (V1, V2, Peso, Grafo); {1 chamada : G direcionado}   {InsereAresta (V2, V1, Peso, Grafo);}{2 chamadas: G nao-direcionado}    V1 := 0; V2 := 4; Peso := 10;    Grafo.NumArestas := Grafo.NumArestas + 1;    InsereAresta (V1, V2, Peso, Grafo); {1 chamada : G direcionado}   {InsereAresta (V2, V1, Peso, Grafo);}{2 chamadas: G nao-direcionado}    V1 := 1; V2 := 2; Peso := 5;    Grafo.NumArestas := Grafo.NumArestas + 1;    InsereAresta (V1, V2, Peso, Grafo); {1 chamada : G direcionado}   {InsereAresta (V2, V1, Peso, Grafo);}{2 chamadas: G nao-direcionado}    V1 := 2; V2 := 4; Peso := 1;    Grafo.NumArestas := Grafo.NumArestas + 1;    InsereAresta (V1, V2, Peso, Grafo); {1 chamada : G direcionado}   {InsereAresta (V2, V1, Peso, Grafo);}{2 chamadas: G nao-direcionado}    V1 := 3; V2 := 2; Peso := 2;    Grafo.NumArestas := Grafo.NumArestas + 1;    InsereAresta (V1, V2, Peso, Grafo); {1 chamada : G direcionado}   {InsereAresta (V2, V1, Peso, Grafo);}{2 chamadas: G nao-direcionado}    V1 := 3; V2 := 4; Peso := 6;    Grafo.NumArestas := Grafo.NumArestas + 1;    InsereAresta (V1, V2, Peso, Grafo); {1 chamada : G direcionado}   {InsereAresta (V2, V1, Peso, Grafo);}{2 chamadas: G nao-direcionado}  ImprimeGrafo (Grafo);  readln;  write ('Raiz:'); readln (Raiz);  Dijkstra (Grafo, Raiz);end.
Link para o comentário
Compartilhar em outros sites

  • Membro VIP

Olá.

Alguém por gentileza poderia me ajudar a fazer um programa em pascal usando procedure e function.

Converter fahrenheit em celcius. Estou iniciando o curso e preciso de uma ajuda. desde já agradeço.

Sim. Por favor, crie um tópico novo e aguarde o suporte.

 

Abraços


Olá Rafael Souza_737449,já conseguiu resolver? qual a sua dúvida?

 

No aguardo.

Link para o comentário
Compartilhar em outros sites


{-- 27/Outubro/2015 - O programar não é para pergunta a quantidade de vertice e ném de aresta.Somente o nome do arquivo e a raiz.}

program DijkstraMatriz;//ALGORITMO DE DIJKSTRA -> SERVER PARA ENCONTRAR O MENOR CAMINHO.

uses crt, DOS;//BIBLIOTECA DO COMANDO LIMPA TELA E DE CORES;

const MAXNUMVERTICES = 100;//É A QUANTIDADE MAXIMA DOS VERTICES OU SEJA O LIMITE DE VERTICES.

      MAXNUMARESTAS  = 4500;//É A QUANTIDADE MAXIMA DAS ARESTAS OU SEJA O LIMITE DE ARESTAS.

      INFINITO       = MAXINT;{É USADO PARA OS VERTICES NÃO LIGADOS PARA NÃO ATRAPALHAR O ALGORITMO.}

type//REGISTRO    

  //A ESTRUTURA DO REGISTRO COM SEUS CAMPOS.

  TipoValorVertice = 0..MAXNUMVERTICES;

  TipoPeso         = integer;

  TipoGrafo        = record

                       Mat:array[TipoValorVertice,TipoValorVertice]of TipoPeso;

                      NumVertices: 0..MaxNumvertices;

                      NumArestas: 0..MAXNUMARESTAS;

                     end;

  TipoApontador    = TipoValorVertice;

  TipoIndice       = TipoValorVertice;

  TipoItem         = record

                       Chave: TipoPeso;

                     end;

  TipoVetor        = array[TipoIndice] of TipoItem;

var

MAdjacencia : Array [1..100,1..100] of integer; {Matriz de Adjacencia do Grafo}

n,m         : Integer;      {Quantidade de Vertices e de Arestas direcionadas do Grafo}

arquivo     : Text;         {Arquivo texto onde esta o Grafo}

arqok       : Boolean;      {Arquivo encontrado ou nao}

nomedoarquivo: String;       {Nome do arquivo a ser utilizado}

Auxarq      : Char;         {Auxiliar para colocar os dados do arquivo na matriz}

Snumero     : String;       {Numero do arquivo em formato String}

Inumero     : Integer;      {Numero do arquivo em formato inteiro}

I, J        : Integer;      {Auxiliares para varrer a matriz}

erro        : Integer;      {Erro na transformacao de String para Inteiro}

{============ VARIAVEIS DOS ALUNOS =============}

  Aux        : TipoApontador;

  //i          : integer;

  V1, V2, Adj: TipoValorVertice;

  Peso       : TipoPeso;

  Grafo      : TipoGrafo;

  //NVertices  : TipoValorVertice;

  //NArestas   : 0..MAXNUMARESTAS;

  FimListaAdj: boolean;

  t          : TipoIndice; {Tamanho do heap}

  Raiz       : TipoValorVertice;

{======= FIM DAS VARIAVEIS DOS ALUNOS ==========}

begin

     textbackground(1);

     clrscr;

     arqok := false;

     writeln('Pressione Enter para o Programa Iniciar ');

     readln;

     clrscr;

     while not arqok do         {Verificando a existencia do arquivo}

     begin

          //É PARA LIMPA A TELA.

  textbackground(black);//É PARA COLOCAR A TELA DE FUNDO NA COR PRETA.

  textcolor(green);

          write('Digite o nome do arquivo: ');

          readln (nomedoarquivo);

          if Fsearch (nomedoarquivo,'') <> '' then

          begin

               arqok := true;

               writeln('Arquivo localizado com sucesso!');

               readkey;

               clrscr;

          end

          else

          begin

               writeln ('Arquivo inexistente, tente novamente!')

          end;

     end;

     for i := 1 to 100 do

     for j := 1 to 100 do

     MAdjacencia [i,j] := 0;

     writeln('Trabalhos dos alunos: x,y,z ');

     {Substituir o X, Y e Z pelo nome dos componentes da equipe e excluir esse comentario}

     writeln(' ');

     writeln('Matriz de Adjacencia do Grafo no arquivo:');

     writeln(' ');

     assign (arquivo, nomedoarquivo);

     reset (arquivo);

     snumero := '';

     i := 1;    {Preenchimento inicial na linha  1 }

     j := 1;    {Preenchimento inicial na coluna 1 }

     m := 0;

     While not eof (arquivo) do         {Preenchimento da Matriz de Adjacencia do Grafo}

     begin

          read(arquivo, auxarq);

          if (auxarq <> ' ') and (auxarq <> chr(13)) and (auxarq <> chr(10)) then

          begin

               snumero := concat (snumero,auxarq);

          end

          else

          begin

               val (snumero,inumero,erro);

               if (erro <> 0) and (auxarq <> chr(10)) then

               begin

                    Writeln('Erro: ', erro,'. Arquivo nao possui um grafo');

                    readkey;

                    halt;

               end;

               snumero := '';

               MAdjacencia [i,j] := inumero;

               if inumero <> 0 then

               m := m + 1; {Definindo a quantidade de Arestas Dirigidas em digrafos}

               if auxarq = ' ' then

               begin

                    write (MAdjacencia [i,j], ' ');

                    j := j + 1;

               end

               else

               begin

                    if (auxarq <> chr(10)) then

                    begin

                         writeln (MAdjacencia [i,j], ' ');

                         i := i + 1;

                         j := 1;

                    end;

               end;

          end;          {do if}

     end;               {do while eof}

          val (snumero,inumero,erro);

          if (erro <> 0) and (auxarq <> chr(10)) then

               begin

                    Writeln('Erro: ', erro,'. Arquivo nao possui um grafo');

                    readkey;

                    halt;

               end;

          MAdjacencia [i,j] := inumero;

          if inumero <> 0 then

          m := m + 1; {Definindo a quantidade de Arestas Dirigidas em digrafos}

     writeln (MAdjacencia [i,j], ' ');

     m := m div 2; {descomente essa linha para grafos}

     n := i;

     writeln('');

     writeln('');

     writeln('n= ',n, ' e m= ', m);

     close(arquivo);

     readkey;

{=== CODIGOS DEVEM SER IMPLEMENTADOS A PARTIR DESTA LINHA ====}

{

procedure FGVazio (var Grafo: TipoGrafo);//INICIALIZAÇÃO DO GRAFO

var i, j: integer;

begin

  for i := 0 to Grafo.NumVertices do //É UMA MATRIZ QUE VAI PERCORRE OS VERTICES

    for j := 0 to Grafo.NumVertices do

      Grafo.mat[i, j] := 0;//VAI INICIALIZAR A MATRIZ DO GRAFO

end;

}

procedure InsereAresta (var V1, V2: TipoValorVertice;var Peso  : TipoPeso;var Grafo : TipoGrafo);//ESSE PROCEDIMENTO VAI INSERIR ARESTAS.

begin

  Grafo.Mat[V1, V2] := peso;

end;

function ExisteAresta (Vertice1, Vertice2: TipoValorVertice;var Grafo: TipoGrafo): boolean;//É UMA FUNÇÃO PARA SABER SE A ARESTA VAI EXISTE NAQUELE GRAFO

begin

  ExisteAresta := Grafo.Mat[vertice1, Vertice2] > 0;

end;  ExisteAresta

{-- Operadores para obter a lista de adjacentes --}

function ListaAdjVazia (var Vertice: TipoValorVertice;var Grafo: TipoGrafo): boolean;

var

Aux       : TipoApontador;//O TIPO APONTADOR É O QUE RECEBE O TIPO  VALOR DO VERTICE QUE TAMBÉM VAI SER RECEBIDO PELO AUX.

ListaVazia: boolean;//LISTA VAZIA É DO TIPO BOOLEAN PORQUE VAI MIM RETORNA VERDADEIRO OU FALSO.

begin

  ListaVazia := true;//INICIALIZAÇÃO DA VARIAVEL LISTAVAZIA.

  Aux := 0;//INICIALIZAÇÃO DO AUX.

  while (Aux < Grafo.NumVertices) and (ListaVazia) do//A CONDIÇÃO DO LOOP ENQUANTO O AUX FOR MENOR QUE O NUMERO DE VERTICES E A LISTA ESTEVE VAZIA.

    if (Grafo.Mat[Vertice, Aux] > 0) then

    ListaVazia := false

    else

    Aux := Aux + 1;//O INCREMENTO DO AUX.PARA ELE IR POR PRÓXIMO ADJACENTE.

  ListaAdjVazia := ListaVazia = true;

end;  ListaAdjVazia

function PrimeiroListaAdj (var Vertice: TipoValorVertice;var Grafo: TipoGrafo): TipoApontador;

var

Aux       : TipoApontador;

Listavazia: boolean;

begin

  ListaVazia := true;

  Aux := 0;

  while (Aux < Grafo.n) and (ListaVazia) do

    if (Grafo.Mat[Vertice, Aux] > 0)then

    begin

         PrimeiroListaAdj := Aux;

         ListaVazia := false;

         end

    else

    Aux := Aux + 1;

  if (Aux = Grafo.n) then//PARA SEREM ADJACENTES TEM QUE POSSUIREM VERTICES DIFERENTES.

  writeln ('Erro: Lista adjacencia vazia (PrimeiroListaAdj)');

end;  PRIMEIRA LISTA DE ADJACENTES

}

//PROCEDIMENTO PROXADJ -> VAI PARA O PRÓXIMO ADJACENTE DO GRAFO.

procedure ProxAdj (var 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.n) and (Grafo.Mat[Vertice, Prox] = 0) do

    Prox := Prox + 1;//INCLEMENTO DO PROX -> É PARA IR POR PRÓXIMO ELEMENTO.

  if (Prox = Grafo.n) then //SE O PRÓXIMO ADJACENTE FOR IGUAL AO VERTICE então FIM DA LISTA.

  FimListaAdj := true;

end;  ProxAdj-

}

//O PROCEDIMENTO IMPRIMEGRAFO -> É PARA MOSTRAR O GRAFO.

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 Dijkstra (var Grafo: TipoGrafo; var Raiz: TipoValorVertice);

var Antecessor: array[TipoValorVertice] of integer;

    P         : array[TipoValorVertice] of TipoPeso;

    Itensheap : array[TipoValorVertice] of boolean;

    Pos       : array[TipoValorVertice] of TipoValorVertice;

    A         : TipoVetor;

    u, v      : TipovalorVertice;

        

procedure RefazInd (Esq, Dir: TipoIndice; var A: TipoVetor);

label 999;

var i: TipoIndice;  j: integer;  x: TipoItem;

begin

  i := Esq;  j := 2 * i;  x := A;

  while (j <= Dir) do

    begin

    if (j < Dir)then

    if (p[A[j].Chave] > p[A[j + 1].Chave]) then

    j := j + 1;

    if (p[x.Chave] <= p[A[j].Chave]) then goto 999;//O COMANDO GOTO É PARA SALTAR.

    A := A[j];  Pos[A[j].Chave] := i;

    i := j;

    j := 2 * i;

    end;

  999: A := x;  Pos[x.Chave] := i;//ELE VAI SALTAR PARA CÁ.

end;  RefazInd

}

procedure Constroi (var A: TipoVetor);

var Esq: TipoIndice;

begin

  Esq := t div 2 + 1;

  while (Esq > 1) do

    begin

    Esq := Esq - 1;

    RefazInd (Esq, t, A);

    end;

end;  CONSTROI O HEAP QUE É A ORDENAÇÃO

}

function RetiraMinInd (var A: TipoVetor): TipoItem;

begin

  if (t < 1) then

  writeln ('Erro: heap vazio')

  else

  begin

       RetiraMinInd := A[1];

       A[1] := A[t];  Pos[A[t].chave] := 1;

       t := t - 1;

       RefazInd (1, t, A);

       end;

end;  RetiraMinInd

}

begin  Dijkstra

  for u := 0 to Grafo.NumVertices do

    begin Constroi o heap com todos os valores igual a INFINITO

    Antecessor := -1;

    p := INFINITO;

    A[u+1].Chave := u; Heap a ser construido

    ItensHeap := true;

    Pos := u+1;

    end;

  t := Grafo.NumVertices;

  p[Raiz] := 0;

  Constroi (A);

  while (t >= 10) do enquanto heap nao vazio

    begin

    u := RetiraMinInd(A).Chave;

    ItensHeap := false;

    if (not ListaAdjVazia (u,Grafo))then

    begin

     Aux := PrimeiroListaAdj (u,Grafo);

        FimListaAdj := false;

            while (not FimListaAdj) do

              begin

              ProxAdj (u, Grafo, v, Peso, Aux, FimListaAdj);

              if (p[v] > p + Peso) then

              begin

                   p[v] := p + Peso;

                   Antecessor[v] := u;

                   writeln ('Caminho mais curto: VERTICE[',v,'] ANTECESSOR:v[',Antecessor[v],']',' DISTANCIA[',p[v],']');

                   readln;

                   end;

              end;

            end;

    end;

end;  Dijkstra

}

{ ============================================================= }

begin {-- Programa principal --}

 textbackground(green);

{ -- NumVertices: definido antes da leitura das arestas --}

{ -- NumArestas: inicializado com zero e incrementado  --}

{ -- cada chamada de InsereAresta                       --}

  clrscr;//É PARA LIMPA A TELA.

  textbackground(black);//É PARA COLOCAR A TELA DE FUNDO NA COR PRETA.

  textcolor(green);//É PARA COLOCAR AS LETRAS NA COR VERDE.

  Grafo.NumVertices := NVertices;//É PARA ARMAZENAR O VERTICE NO GRAFO.

  Grafo.NumArestas := NArestas;//É PARA ARMAZENAR A ARESTA NO GRAFO.

 { FGVazio (Grafo);//É PARA SE O GRAFO ESTIVER VAZIO.RETURNA VAZIO.     }

    V1 := 0; V2 := 4; Peso := 10;

    Grafo.NumArestas := Grafo.NumArestas + 1;

   { InsereAresta (V1, V2, Peso, Grafo); 1 chamada : G direcionado}

   {InsereAresta (V2, V1, Peso, Grafo);}{2 chamadas: G nao-direcionado}

    V1 := 1; V2 := 2; Peso := 5;

    Grafo.NumArestas := Grafo.NumArestas + 1;

    {InsereAresta (V1, V2, Peso, Grafo); 1 chamada : G direcionado}

   {InsereAresta (V2, V1, Peso, Grafo);}{2 chamadas: G nao-direcionado}

    V1 := 2; V2 := 4; Peso := 1;

    Grafo.NumArestas := Grafo.NumArestas + 1;

    {InsereAresta (V1, V2, Peso, Grafo); 1 chamada : G direcionado}

   {InsereAresta (V2, V1, Peso, Grafo);}{2 chamadas: G nao-direcionado}

    V1 := 3; V2 := 2; Peso := 2;

    Grafo.NumArestas := Grafo.NumArestas + 1;

    {InsereAresta (V1, V2, Peso, Grafo); 1 chamada : G direcionado}

   {InsereAresta (V2, V1, Peso, Grafo);}{2 chamadas: G nao-direcionado}

    V1 := 3; V2 := 4; Peso := 6;

    Grafo.NumArestas := Grafo.NumArestas + 1;

    {InsereAresta (V1, V2, Peso, Grafo); 1 chamada : G direcionado}

   {InsereAresta (V2, V1, Peso, Grafo);}{2 chamadas: G nao-direcionado}

  ImprimeGrafo (Grafo);

  readln;

  write ('Raiz:');

  readln (Raiz);

  Dijkstra (Grafo, Raiz);

   textbackground(black);

  clrscr;

  textbackground(black);

  textcolor(red);

  writeln(' Pressione Enter para Sair do Programa ');

  readln;

 end;

end.

Link para o comentário
Compartilhar em outros sites

  • Membro VIP

Olá.

 

Seu código não está compilável... você postou o código correto?

 

Como está utilizando arquivos, por favor, poste como o conteúdo do arquivo deve ficar e um ou mais exemplos de conteúdos (para os arquivos) para testes...


PS: Já que está está utilizando arquivos, a primeira coisa que devem fazer a atestar que os dados estão sendo coletados corretamente. A partir daí, utilizar esses dados para fazer os cálculos e exibir uma resposta. Após, compara a resposta do programa com a resposta esperada (feita manualmente, por exemplo)

No aguardo.

Link para o comentário
Compartilhar em outros sites


program DijkstraMatriz;//ALGORITMO DE DIJKSTRA -> SERVER PARA ENCONTRAR O MENOR CAMINHO.

uses crt, DOS;//BIBLIOTECA DO COMANDO LIMPA TELA E DE CORES;

const MAXNUMVERTICES = 100;//É A QUANTIDADE MAXIMA DOS VERTICES OU SEJA O LIMITE DE VERTICES.

      MAXNUMARESTAS  = 4500;//É A QUANTIDADE MAXIMA DAS ARESTAS OU SEJA O LIMITE DE ARESTAS.

      INFINITO       = MAXINT;{É USADO PARA OS VERTICES NÃO LIGADOS PARA NÃO ATRAPALHAR O ALGORITMO.}

type//REGISTRO    

  //A ESTRUTURA DO REGISTRO COM SEUS CAMPOS.

  TipoValorVertice = 0..MAXNUMVERTICES;

  TipoPeso         = integer;

  TipoGrafo        = record

                       Mat:array[TipoValorVertice,TipoValorVertice]of TipoPeso;

                      NumVertices: 0..MaxNumvertices;

                      NumArestas: 0..MAXNUMARESTAS;

                     end;

  TipoApontador    = TipoValorVertice;

  TipoIndice       = TipoValorVertice;

  TipoItem         = record

                       Chave: TipoPeso;

                     end;

  TipoVetor        = array[TipoIndice] of TipoItem;

var

MAdjacencia : Array [1..100,1..100] of integer; {Matriz de Adjacencia do Grafo}

n,m         : Integer;      {Quantidade de Vertices e de Arestas direcionadas do Grafo}

arquivo     : text;         {Arquivo texto onde esta o Grafo}

arqok       : Boolean;      {Arquivo encontrado ou nao}

nomedoarquivo: String;       {Nome do arquivo a ser utilizado}

Auxarq      : Char;         {Auxiliar para colocar os dados do arquivo na matriz}

Snumero     : String;       {Numero do arquivo em formato String}

Inumero     : Integer;      {Numero do arquivo em formato inteiro}

I, J        : Integer;      {Auxiliares para varrer a matriz}

erro        : Integer;      {Erro na transformacao de String para Inteiro}

{============ VARIAVEIS DOS ALUNOS =============}

  Aux        : TipoApontador;//auxilar para ir por próximo adjacente

  //i          : integer;

  V1, V2, Adj: TipoValorVertice;

  Peso       : TipoPeso;

  Grafo      : TipoGrafo;

  //NVertices  : TipoValorVertice;

  //NArestas   : 0..MAXNUMARESTAS;

  FimListaAdj: boolean;

  t          : TipoIndice; {Tamanho do heap}

  Raiz       : TipoValorVertice;

{======= FIM DAS VARIAVEIS DOS ALUNOS ==========}

begin

     textbackground(1);

     clrscr;

     arqok := false;

     writeln('Pressione Enter para o Programa Iniciar ');

     readln;

     clrscr;

     while not arqok do         {Verificando a existencia do arquivo}

     begin

          //É PARA LIMPA A TELA.

  textbackground(black);//É PARA COLOCAR A TELA DE FUNDO NA COR PRETA.

  textcolor(green);

          write('Digite o nome do arquivo: ');

          readln (arquivo,nomedoarquivo);

          if Fsearch (nomedoarquivo,'caminho') <> '' then

          begin

               arqok := true;

               writeln('Arquivo localizado com sucesso!');

               readkey;

               clrscr;

          end

          else

          begin

               writeln ('Arquivo inexistente, tente novamente!')

          end;

     end;

     for i := 1 to 100 do

     for j := 1 to 100 do

     MAdjacencia [i,j] := 0;

     writeln('Trabalhos dos alunos: x,y,z ');

     {Substituir o X, Y e Z pelo nome dos componentes da equipe e excluir esse comentario}

     writeln(' ');

     writeln('Matriz de Adjacencia do Grafo no arquivo:');

     writeln(' ');

     assign (arquivo, 'OBA.TXT');

     reset (arquivo);

     snumero := '';

     i := 1;    {Preenchimento inicial na linha  1 }

     j := 1;    {Preenchimento inicial na coluna 1 }

     m := 0;

     While not eof (arquivo) do         {Preenchimento da Matriz de Adjacencia do Grafo}

     begin

          read(arquivo, auxarq);

          if (auxarq <> ' ') and (auxarq <> chr(13)) and (auxarq <> chr(10)) then

          begin

               snumero := concat (snumero,auxarq);

          end

          else

          begin

               val (snumero,inumero,erro);

               if (erro <> 0) and (auxarq <> chr(10)) then

               begin

                    Writeln('Erro: ', erro,'. Arquivo nao possui um grafo');

                    readkey;

                    halt;

               end;

               snumero := '';

               MAdjacencia [i,j] := inumero;

               if inumero <> 0 then

               m := m + 1; {Definindo a quantidade de Arestas Dirigidas em digrafos}

               if auxarq = ' ' then

               begin

                    write (MAdjacencia [i,j], ' ');

                    j := j + 1;

               end

               else

               begin

                    if (auxarq <> chr(10)) then

                    begin

                         writeln (MAdjacencia [i,j], ' ');

                         i := i + 1;

                         j := 1;

                    end;

               end;

          end;          {do if}

     end;               {do while eof}

 textbackground(black);

  clrscr;

  textbackground(black);

  textcolor(red);

  writeln(' Pressione Enter para Sair do Programa ');

  readln;

end.

Link para o comentário
Compartilhar em outros sites

Visitante
Este tópico está impedido de receber novas respostas.

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...