Rafael Souza_737449
-
Posts
17 -
Cadastrado em
-
Última visita
Tipo de conteúdo
Artigos
Selos
Fabricantes
Livros
Cursos
Análises
Fórum
posts postados por Rafael Souza_737449
-
-
Eu estou tentando corrigir o erro.
-
{-- 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.
-
Eu perguntei ao professor, ele mim disse que é para fazer um arquivo,no programa somente vai pergunta o nome do arquivo e a raiz.Ele vai mim dar o menor caminho.
-
Minha dúvida, é saber se este algoritmo está de acordo com o algoritmo do menor caminho de Dijkstrak?
-
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. -
Obrigado!! Eu vou corrigi ai depois eu posto.
-
Como eu faço para coloca a mensagem "Seja Bem-Vindo " antes de acessa o menu .
Como eu faço para coloca a mensagem "Seja Bem-Vindo " antes de acessa o menu .
-
program princi;
uses crt, Dos, listaencad;
var
L1:list;
a:produto;
opcao:integer;
op:string;
procedure menu;
begin
repeat
textcolor (lightred);
gotoxy(24,2);
//---------------------Menu Principaç--------------------------
gotoxy(35,2);
textcolor (lightgreen);
writeln ('MENU');
textcolor (lightred);
writeln;
gotoxy(30,4);
writeln ('ESCOLHA UMA OPCAO');
writeln;
gotoxy(23,6);
writeln ('1- Inserir ou cadastrar produto ');
gotoxy(23,7);
writeln ('2- Procurar produto por nome');
gotoxy (23,8);
writeln ('3- Procura produto por codigo');
gotoxy(23,9);
writeln ('4- Remover produto por codigo no sistema');
gotoxy(23,10);
writeln('5- Remover produto por nome no sistema');
gotoxy (23,11);
writeln ('6- Ver lista completa');
gotoxy (23,12);
writeln ('7- Gravar lista em arquivo');
gotoxy (23,13);
writeln ('8- SAIR');
gotoxy(23,16);
write ('Escolha uma opcao e Tecle [ENTER]: ');
readln(opcao);
if (opcao > 0) and (opcao <= 7) then
begin
case (opcao) of
1: begin //CADASTRO DE PRODUTO
clrscr;
//delay(1000);
writeln('CADASTRO DE PRODUTO');
write('Informe o codigo do Produto: ');
readln(a.codigo);
write('Informe o nome do Produto: ');
readln(a.nome);
write('Informe o preco do Produto: ');
readln(a.preco);
inserir(L1,a);
writeln(' Deseja Continuar sim ou nao [n] : ');
readln(op);
while( op='s')do
begin
clrscr;
writeln('CADASTRO DE PRODUTO');
write('Informe o codigo do Produto: ');
readln(a.codigo);
write('Informe o nome do Produto: ');
readln(a.nome);
write('Informe o preco do Produto: ');
readln(a.preco);
inserir(L1,a);
writeln(' Deseja Continuar sim ou nao [n] : ');
readln(op);
end;
write('Pressione uma tecla...');
readkey;
sound(100);
end;
2: begin // Pesquisa Nome;
clrscr;
//delay(1000);
writeln('PROCURA PRODUTO POR NOME');
write('Informe o nome do Produto: ');
read(a.nome);
buscar1(L1,a);
//delay(4000);
writeln();
write('Pressione uma tecla...');
readkey;
clrscr;
end;
3: begin // Pesquisar codigo
clrscr;
//delay(1000);
writeln('PROCURA PRODUTO POR CODIGO');
writeln('Informe o Codigo do produto : ');
read(a.codigo);
buscar2(L1,a);
//delay(4000);
writeln();
write('Pressione uma tecla...');
readkey;
clrscr;
end;
4: begin //REMOÇÃO DE PRODUTO
clrscr;
writeln('REMOCAO DE PRODUTO POR CODIGO');
write('Informe o Codigo do Produto: ');
readln(a.codigo);
remover1(L1,a);
writeln();
write('Pressione uma tecla...');
readkey;
clrscr;
//delay(1000);
end;
5: begin
clrscr;
writeln('REMOCAO DE PRODUTO POR NOME');
write('Informe o Nome do Produto: ');
readln(a.nome);
remover2(L1,a);
writeln();
write('Pressione uma tecla...');
readkey;
clrscr;
//delay(4000);//Para dar uma pausa.
end;
6: begin //LISTA DE PRODUTO
clrscr;
mostrar(L1);
writeln();
write('Pressione uma tecla...');
readkey;
//delay (4000);
end;
7 : begin
clrscr;
delay(4000);
textcolor(14);
end
else
// Erro se a opção for inválida
clrscr;
writeln;
writeln ('[OPCAO INVALIDA TENTE NOVAMENTE]');
readkey;
sound(100);
end;
end;
sound(100);
clrscr;
until (opcao = 8);
// menu;
textcolor (lightred);;
writeln;
writeln;
clrscr;
gotoxy(23,10);
writeln ('Tecle [ENTER] para sair');
sound(100);
end;
begin
menu;
readkey;
end.
-
unit listaencad;
interface
type produto = record
codigo : integer;
nome : string;
preco : real;
end;
List = ^no; //Lista é ponteiro.
no = record
obj : produto;
proximo : List;
end;
procedure criar (var L : List);
function vazia (L : list): boolean;
procedure inserir (var L : list; x : produto);
function Buscar1 (L : list; s : produto): list;
function Buscar2 (L : list; cod : produto): list;
procedure remover1 (var L : list; cod : produto);
function remover2 (var L : list; s : produto): boolean;
procedure mostrar (L : list);
implementation
procedure criar (var L : list); // Procedimento para criar list
begin
L := nil;
writeln ('lista iniciada...');
end;
function vazia (L : list): boolean; //Uma list Vazia é representada por um Ponteiro cujo valor é Nulo.
begin
if (l = nil) then
vazia := true
else
vazia := false;
end;
procedure inserir (var L : list; x : produto); // Procedimento para inserir um produto na list L
var
N, P : list; //N e P são Ponteiros.
begin
new(N); //Criar ponteiro
N^.obj := x;
if vazia (L) then //1º e 2ºCondição: 1ºSe a list Ordenada L esta vazia
begin //2ºSe o elemento s é menor ou igual ao primeiro elemento da list.
N^.proximo := L; //Nodo apontado por N passa a ser o primeiro da list L.
L := N; //Endereço do Nodo apontado por N deve ser copiado para a variavel L. Tal que ambos ponteiros apontem o mesmo nodo.
writeln (x.nome,' foi inserido(a) na lista!');
end
else
begin
P := L;
while (P^.proximo <> nil )do //3ºCondição e 4ºCondição: O elemento x é maior que o primeiro e existe outro que o supera
begin
P := P^.proximo;
end;
N^.proximo := P^.proximo;
P^.proximo := N;
writeln (x.nome, ' Elemento inserido(a) na lista!');
end;
// Final Da Ordenacao list Encadeada .
begin
writeln;
writeln (' [Cadastrada Com Sucesso]');
end;
end;
// Function Procurar Pelo Nome.
function Buscar1 (L : list; s : produto): list;
var
P : list;
begin
if vazia(L) then
writeln (' Impossivel Encontrar! Nao Tem produtos No Banco De Dados ! ')
else
begin
P := L;
while (P <> nil) and (s.nome <> P^.obj.nome) do
P := P^.proximo;
if (P <> nil) and (s.nome = P^.obj.nome) then
begin
writeln('[NOME] [CODIGO] [PRECO] ');
writeln(P^.obj.nome ,'-------------' , '--------------', P^.obj.codigo ,'-------------' , '-----------', P^.obj.preco:9:2 ,'--');
buscar1 := P
end
else
if (P = nil)then
begin
buscar1 := nil;
writeln;
writeln(' ',s.nome,' [Nao Encontrado]');
end;
end;
end;
// Function Procurar usando o codigo.
function Buscar2 (L : list; cod : produto): list;
var
P : list;
begin
if vazia(L) then
writeln (' Impossivel Encontrar! Nao Tem produtos No Banco De Dados ! ')
else
begin
P := L;
while (P <> nil) and (cod.codigo <> P^.obj.codigo) do
P:=P^.proximo;
if (P <> nil) and (cod.codigo = P^.obj.codigo) then
begin
writeln('[NOME] [CODIGO] [PRECO] ');
writeln(P^.obj.nome ,'-------------' , '--------------', cod.codigo ,'-------------' , '---------------',P^.obj.preco:9:2 ,'--------');
buscar2 := P;
end
else
if (P = nil)then
begin
buscar2 := nil;
writeln;
writeln(' ',cod.codigo,' [Nao Encontrado]');
end;
end;
end;
//Remover produto por codigo
procedure remover1 (var L : list; cod : produto);
var
P, Q : list;
begin
if vazia(L)then
writeln( 'lista vazia!')
else
if (L^.obj.codigo = cod.codigo) then
begin
P := L;
L := L^.proximo;
writeln (cod.codigo, ' foi removido(a) da lista!');
dispose(P);
end
else
begin
P:=L;
while((P^.proximo <> nil) and (cod.codigo <> P^.proximo^.obj.codigo )) do //4ºCondição : O elemento cod é diferente ao primeiro elemento de L.
begin
P := P^.proximo;
end;
if (P^.proximo <> nil) and (P^.proximo^.obj.codigo = cod.codigo )then
begin
Q := P^.proximo;
P^.proximo := Q^.proximo;
writeln (cod.codigo, ' foi removido(a) da lista!');
dispose(Q);
end
else
end;
end;
//remover um elemento da list por nome
function remover2 (var L : list; s : produto): boolean;
var
P, Q : list;
begin //O Primeiro elemento é o L^.obj
if vazia(L) or (s.nome < L^.obj.nome) then //1º e 2ºCondição: 1ºCondição : A list ordenada L está vazia
remover2 := false //2ºCondição : O elemento s é menor que o primeiro elemento da list ordenada L.
else
if (s.nome = L^.obj.nome) then //3ºCondição : O elemento s é igual ao primeiro elemento da list ordenada L.
begin
P := L;
L := L^.proximo;
writeln (s.nome, ' foi removido(a) da lista!');
dispose (P);
remover2 := true;
end
else
begin
P := L;
while (P^.proximo <> nil) and (s.nome > P^.proximo^.obj.nome) do //4ºCondição : O elemento s é maior que o primeiro elemento de L.
P := P^.proximo;
if (P^.proximo <> nil) and (s.nome = P^.proximo^.obj.nome) then
begin
Q := P^.proximo;
P^.proximo := Q^.proximo;
writeln (s.nome, ' foi removido(a) da lista!');
dispose (Q);
remover2 := true;
end
else
remover2 := false;
end;
end;
//Imprimindo list Ordenada.
procedure mostrar(L:list);
begin
if vazia (L) then
writeln (' A lista esta vazia ')
else
begin
writeln('[NOME] [CODIGO] [PRECO] ');
while (L <> nil) do
begin
writeln(L^.obj.nome ,'-------------' , '--------------', L^.obj.codigo ,'-------------' , '---------------',L^.obj.preco:9:2 ,'--------');
L := L^.proximo;
end;
end;
end;
begin
end.
-
E como ficaria o arquivo ?
-
-
Eu estou usando o Dev-pascal .Eu fiz as alterações que você mim falou,mas, continua dando erro só que dessa vez é no if(N^.nome<=N^.obj)then nessa condição do if.
O codigo do inserir ficou assim com as alterações :
procedure inserir (var L: LstOrd; produto:tPRODUTO); // Procedimento para inserir um produto na Lista L var N, P : LstOrd; //N e P são Ponteiros. begin new(N); //Criar ponteiro N^.preco:= N^.preco; N^.codigo:= N^.codigo; N^.obj:= N^.nome; if(vazia(L))or(N^.nome<=N^.obj)then //1º e 2ºCondição: 1ºSe a Lista Ordenada L esta vazia begin //2ºSe o elemento s é menor ou igual ao primeiro elemento da lista. N^.prox := L; //Nodo apontado por N passa a ser o primeiro da lista L. L := N; //Endereço do Nodo apontado por N deve ser copiado para a variavel L. Tal que ambos ponteiros apontem o mesmo nodo. end else begin P := L; while (P^.prox <> nil ) and (N^.nome>P^.prox^.obj) do //3ºCondição e 4ºCondição: O elemento nome é maior que o primeiro e //existe outro que o supera P := P^.prox; N^.prox := P^.prox; P^.prox := N; end;
-
1
-
-
unit listaencadeada;interface // registro que aponta para os campos // type Elem = string; LstOrd = ^Nodo; Nodo = record codigo: integer; preco : real; nome: Elem; obj:Elem; prox : LstOrd; end; // ponteiro que guarda informações e aponta para o proximo //Lista é ponteiro. var L : LstOrd; procedure criar (var L : LstOrd); function vazia (L : LstOrd): boolean; procedure inserir (var L : LstOrd; x:Elem; code:integer;prec:real); function Buscar1 (L : LstOrd; x : Elem): LstOrd; function Buscar2 (L : LstOrd; code : integer): LstOrd; //procedure print; function remover1 (var L : LstOrd; code : integer): boolean; function remover2 (var L : LstOrd; x : Elem): boolean; procedure show (nome:string; L:LstOrd); implementation procedure criar (var L : LstOrd); // Procedimento para criar Lista begin L := nil; writeln ('Lista iniciada...'); end; function vazia (L : LstOrd): boolean; //Uma Lista Vazia é representada por um Ponteiro cujo valor é Nulo. begin if (l = nil) then vazia := true else vazia := false; end; procedure inserir (var L : LstOrd; x:Elem;code:integer;prec:real); // Procedimento para inserir um produto na Lista L var N, P : LstOrd; //N e P são Ponteiros. begin new(N); //Criar ponteiro N^.obj.preco := prec; //O livro não diz que tem que coloca o nome depois do obj no inserir. N^.obj.nome:= x; N^.obj.codigo := code; if(vazia(L))or(x<L^.obj.nome)then //1º e 2ºCondição: 1ºSe a Lista Ordenada L esta vazia begin //2ºSe o elemento s é menor ou igual ao primeiro elemento da lista. N^.prox := L; //Nodo apontado por N passa a ser o primeiro da lista L. L := N; //Endereço do Nodo apontado por N deve ser copiado para a variavel L. Tal que ambos ponteiros apontem o mesmo nodo. end else begin P := L; while (P^.prox <> nil ) and (x>P^.prox^.obj.nome) do //3ºCondição e 4ºCondição: O elemento x é maior que o primeiro e existe outro que o supera P := P^.prox; N^.prox := P^.prox; P^.prox := N; end; // Final Da Ordenacao Lista Encadeada . begin writeln; writeln (' [Produto Cadastrado Com Sucesso] ... '); end; end; // Function Procurar Pelo Nome. function Buscar1 (L : LstOrd; x : Elem): LstOrd; var P : LstOrd; begin P:= L; while (P <> nil) and (x > P^.obj.nome) do P := P^.prox; if (P <> nil) and (x = P^.obj.nome) then Buscar1 :=P //print(P) else Buscar1:=nil; end; // Function Procurar usando o codigo. function Buscar2 (L : LstOrd; code : integer): LstOrd; var P : LstOrd; begin P := L; while (P <> nil) and (code > P^.obj.codigo) do P := P^.prox; if (P <> nil) and (code = P^.obj.codigo) then Buscar2:= P else Buscar2:=nil; end; // procedimento mostrar um // {procedure print; begin writeln ('Código ' , codigo); writeln ('Produto' , nome); writeln ('Preço: ' , preco); end;} //Remover produto por codigo function remover1 (var L : LstOrd; code : integer): boolean; var P, Q : LstOrd; begin if vazia(L) or (code < L^.obj.codigo)then //Quando coloca o obj.nome dar erro. remover1:=false else if (L^.obj.codigo = code) then begin P := L; L := L^.prox; writeln ('O produto foi removido! '); dispose(P); remover1:= true; end else begin P:=L; while((P^.prox <> nil) and (code > P^.prox^.obj.codigo )) do //4ºCondição : O elemento cod é diferente ao primeiro elemento de L. P := P^.prox; if (P^.prox <> nil) and (code = P^.prox^.obj.codigo )then begin Q := P^.prox; P^.prox := Q^.prox; writeln ('O produto foi removido(a)! '); dispose(Q); remover1:=true; end else remover1:=false;end; end; //Remover produto pelo nome function remover2 (var L : LstOrd; x : Elem): boolean; var P, Q : LstOrd; begin if vazia(L) or (x<L^.obj.nome)then remover2:=false else if (x = L^.obj.nome) then begin P := L; L := L^.prox; // writeln ('O produto foi removido! '); dispose(P); remover2:=true; end else begin P := L; while((P^.prox <> nil) and (x > P^.prox^.obj.nome )) do //4ºCondição : O elemento cod é diferente ao primeiro elemento de L. begin P := P^.prox; end; if (P^.prox <> nil) and (x = P^.prox^.obj.nome )then begin Q := P^.prox; P^.prox := Q^.prox; //writeln ('O produto foi removido(a)! '); dispose(Q); remover2:=true; end else remover2:=false;end; end; //Imprimindo Lista Ordenada. procedure show (nome:string; L:LstOrd); var P: LstOrd; begin P:=L; if vazia (L) then writeln (' A lista esta vazia ') else begin write(nome, ':['); while (P <> nil) do begin writeln(' Nome ' , P^.nome ); P := P^.prox; end; end; end;beginend.Esta dando erro no procedure inserir onde está n^.obj.nome
-
1
-
-
O programa deverá criar o tipo de dado abstrato de acordo com o assunto de cada equipe, inclusive as operações para manipular o tipo. A estrutura deverá armazenar os produtos de uma determinada empresa. O produto será um registro com os seguintes campos: código, descrição e preço. O programa deverá apresentar um menu ao usuário com, no mínimo, as seguintes opções:
1. Cadastrar Produto;
2. Pesquisar Produto (pelo código);
3. Pesquisar Produto (pela descrição);
4. Excluir Produto (pelo código);
5. Excluir Produto (pela descrição);
6. Exibir Lista;
7. Gravar Lista (em arquivo)
-
unit pilha;interfaceconst max=7;type pi = record dados:array[1..max]of integer; topo:integer; end;procedure init(var p:pi);function vazia(var p:pi):boolean;function cheia(var p:pi):boolean;procedure push(var p:pi; s:integer);function pop (var p:pi):integer;function top (var p:pi):integer;implementationprocedure init(var p:pi);beginp.topo:= 0;writeln('Inicializada');end;function vazia(var p:pi):boolean;beginif ( p.topo = 0)thenvazia:= trueelsevazia:=false;end;function cheia(var p:pi):boolean;beginif(p.topo = max)thencheia:= trueelsecheia:= false;end;procedure push(var p:pi;s:integer);beginif(not cheia(p) )thenbeginp.topo:= p.topo + 1;//Inclemento;p.dados[p.topo]:= s;//voce coloca o vetor e no indice do vetor voce coloca o inclemento dentro depois coloca para receber o tipo que voce quer que seja no seu vetor.end;end; //Conceito de pilha: O Primeiro Valor É O Que ENTRA E O ÚLTIMO Valor É O Primeiro Que Sai.function pop(var p:pi):integer;//Vai retira o último valor que está na pilha.beginif(p.topo <> 0)then//tem que testa para saber se não está vazia.Porque como ele vai retira uma coisa que esta vazia.beginpop:=p.dados[p.topo];p.topo:=p.topo - 1;endelsewriteln('Erro');end;function top(var p:pi):integer;beginif(p.topo <> 0)thenbegintop:= p.dados[p.topo];endelsewriteln('Erro ');end;end.unit pilha;interfaceconst max=7;type pi = record dados:array[1..max]of integer; topo:integer; end;procedure init(var p:pi);function vazia(var p:pi):boolean;function cheia(var p:pi):boolean;procedure push(var p:pi; s:integer);function pop (var p:pi):integer;function top (var p:pi):integer;implementationprocedure init(var p:pi);beginp.topo:= 0;writeln('Inicializada');end;function vazia(var p:pi):boolean;beginif ( p.topo = 0)thenvazia:= trueelsevazia:=false;end;function cheia(var p:pi):boolean;beginif(p.topo = max)thencheia:= trueelsecheia:= false;end;procedure push(var p:pi;s:integer);beginif(not cheia(p) )thenbeginp.topo:= p.topo + 1;p.dados[p.topo]:= s; end;end; function pop(var p:pi):integer;beginif(p.topo <> 0)thenbeginpop:=p.dados[p.topo];p.topo:=p.topo - 1;endelsewriteln('Erro');end;function top(var p:pi):integer;beginif(p.topo <> 0)thenbegintop:= p.dados[p.topo];endelsewriteln('Erro ');end;end.unit pilha;interfaceconst max=7;type pi = record dados:array[1..max]of integer; topo:integer; end;procedure init(var p:pi);function vazia(var p:pi):boolean;function cheia(var p:pi):boolean;procedure push(var p:pi; s:integer);function pop (var p:pi):integer;function top (var p:pi):integer;implementationprocedure init(var p:pi);beginp.topo:= 0;writeln('Inicializada');end;function vazia(var p:pi):boolean;beginif ( p.topo = 0)thenvazia:= trueelsevazia:=false;end;function cheia(var p:pi):boolean;beginif(p.topo = max)thencheia:= trueelsecheia:= false;end;procedure push(var p:pi;s:integer);beginif(not cheia(p) )thenbeginp.topo:= p.topo + 1;p.dados[p.topo]:= s;end;end; function pop(var p:pi):integer;beginif(p.topo <> 0)thenbeginpop:=p.dados[p.topo];p.topo:=p.topo - 1;endelsewriteln('Erro');end;function top(var p:pi):integer;beginif(p.topo <> 0)thenbegintop:= p.dados[p.topo];endelsewriteln('Erro ');end;end.Atividade é essa.
1.Faça um procedimento para verificar se um dado elemento se encontra em uma pilha.
2.Faça um procedimento que informe quantas vezes um dado elemento se encontra em uma pilha.
3.Faça um procedimento para esvaziar uma pilha.
4.Faça uma função que retorne quantos elementos possui uma pilha.
5.Faça um procedimento para imprimir todos os elementos de uma pilha.
-
Acrescente ao TDA ListaSeq as operações abaixo e implemente-as:Procedimento que informe quantos elementos existem na lista;Uma função que retorna o elemento de uma dada posição;Uma função que retorna a posição de um dado elemento;Um procedimento que esvazie a lista.
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
Fazer um algoritmo em pascal do grafo chamado caminho e no final do programa mostrar a mensagem "sair".
em Programação - outros
Postado
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.