Ir ao conteúdo
  • Cadastre-se

Rafael Souza_737449

Membro Júnior
  • Posts

    17
  • Cadastrado em

  • Última visita

Reputação

3
  1. 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.
  2. {-- 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.
  3. 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.
  4. Minha dúvida, é saber se este algoritmo está de acordo com o algoritmo do menor caminho de Dijkstrak?
  5. 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.
  6. 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 .
  7. 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.
  8. 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.
  9. 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;
  10. 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
  11. 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)

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...