program fila;
uses crt;
type
apontador = ^celula;
celula = record
item:integer;
prox:apontador;
end;
tipofila=record
frente:apontador;
tras:apontador;
end;
procedure iniciafila(var fila:tipofila);
var
aux:apontador;
begin
new (aux);
fila.frente:=aux;
fila.tras:=fila.frente;
fila.tras^.prox :=nil;
end;
function vazia(fila:tipofila):boolean;
begin
vazia:=fila.frente = fila.tras;
end;
procedure inserir(x:integer;var fila:tipofila);
var aux:apontador;
begin
new (aux);
fila.tras^.prox:=aux;
aux^.prox := nil;
aux^.item :=x;
fila.tras := aux;
end;
procedure imprimir(fila:tipofila);
var aux:apontador;
begin
aux := fila.frente^.prox;
while ( aux <> nil ) do begin
writeln(aux^.item);
aux:=aux^.prox;
end;
end;
procedure retirar(var x:integer; var fila:tipofila);
var
aux:apontador;
begin
aux:=fila.frente^.prox;
x:=aux^.item;
fila.frente^.prox := aux^.prox;
if (fila.frente^.prox = nil ) then fila.tras := fila.frente;
dispose(aux);
end;
procedure media(l:tipofila; var media:real);
var
aux:apontador;
b:integer;
begin
aux:=l.frente;
media:=0;
b:=0;
while aux^.prox <> nil do begin
aux:=aux^.prox;
media:=media+aux^.item;
b:=b+1;
end;
media:=media/b;
end;
procedure quantidade(l:tipofila; var qtde:integer);
var
aux:apontador;
b:integer;
begin
aux:=l.frente;
while aux^.prox <> nil do begin
aux:=aux^.prox;
qtde:=qtde+1;
end;
end;
var
elem:integer;
f:tipofila;
qtde:integer;
opc:integer;
n:integer;
soma:integer;
m:real;
{ Programa principal }
begin
iniciafila(f);
repeat
writeln(' 1 - Inserir ');
writeln(' 2 - Retirar ');
writeln(' 3 - Imprimir ');
writeln(' 4 - Media Aritim‚tica ');
writeln(' 5 - Quantidade de elementos ');
writeln(' 6 - Sair');
writeln(' 0 - limpar a tela');
readln(opc);
case opc of
1 :begin
writeln('Entre com o elemento a ser inserido');
readln(elem);
inserir(elem,f);
end;
2 :begin
if vazia(f) then writeln('A fila est vazia, impossivel retirar elemento !')
else begin
retirar(elem,f);
writeln('O elemento', elem , 'foi removido da fila');
end;
end;
3:begin
writeln('Elementos do fila');
imprimir(f);
end;
4 :begin
media(f,m);
writeln('A media ‚ ',m:3:2);
end;
5 :begin
quantidade(f,qtde);
writeln('A quantidade de elementos ‚:', qtde );
end;
6: writeln('Saindo do programa');
0:clrscr;
end;
until opc=6;
end.
[1] Comentário enviado por mbmaciel em 05/10/2009 - 10:07h
Para funcionar corretamente um pequeno ajuste, depois da linha repeat.
...
repeat
qtde:=0;
writeln(' 1 - Inserir ');
...
Assim o procedure que calcula a media vai funcionar corretamente.
Abraço!
[2] Comentário enviado por joserribeirojuni em 05/10/2009 - 10:51h
Nos testes que eu fiz aqui, isso não foi necessário, mas se fosse pra zerar "qtde" poderia colocar fora do repeat senão fica atribuindo, sem necessidade, enquanto passar pelo laço.
Procedure Cria_lista(Var Lista: tp_lista);
Begin
new(Lista.primeiro);
Lista.ultimo:=Lista.primeiro;
Lista.ultimo^.prox:=nil;
End;
{Verifica se a lista esta vazia}
Function Vazia(Lista: tp_lista): boolean;
Begin
If Lista.ultimo=Lista.primeiro then
Vazia:=true
else
Vazia:=false;
End;
{Insere item na lista}
Procedure Insere (x: tp_pessoa; var Lista: tp_lista);
Begin
new(Lista.ultimo^.prox);
Lista.ultimo:=Lista.ultimo^.prox;
Lista.ultimo^:=x;
Lista.ultimo^.prox:=nil;
End;
{Encontra o endereco de um item a partir do seu codigo}
Function Localiza (cod: integer; Lista: tp_lista): ponteiro;
Var
paux: ponteiro; {ou paux: ^tp_pessoa;}
Begin
paux:=Lista.primeiro;
while ((paux^.prox<>nil)and(paux^.prox^.chave<>cod)) do
paux:=paux^.prox;
Localiza:=paux;
End;
{ Remove item da lista
Obs.: o item a ser retirado e o seguinte ao apontado por p }
Procedure Remove (p: ponteiro; Var Lista: tp_lista);
Var
q: ^tp_pessoa;
Begin
if ((Vazia(Lista)) or (p^.prox=nil)) then
writeln ('Erro: lista vazia ou item inexistente.')
else
begin
q:=p^.prox;
p^.prox:=q^.prox;
if (p^.prox=nil) then
Lista.ultimo:=p;
dispose(q);
end;
End;
{ Imprime os itens da lista }
Procedure Imprime (Lista: tp_lista);
Var
aux: ponteiro; {ou aux: ^tp_pessoa;}
i: integer;
Begin
i:=1;
aux:=Lista.primeiro^.prox;
while (aux<>nil) do
begin
writeln ('Codigo do item ',i,': ',aux^.chave);
writeln ('Nome do item ',i,': ',aux^.nome);
writeln ('Idade do item ',i,': ',aux^.idade);
i:=i+1;
aux:=aux^.prox;
writeln;
end;
End;
Begin
clrscr;
Cria_lista(Lista_real);
repeat
writeln ('Escolha uma opcao: ');
writeln (' 1 - Verifica se a lista esta vazia;');
writeln (' 2 - Insere item na lista;');
writeln (' 3 - Remove itens da lista;');
writeln (' 4 - Imprime itens da lista;');
writeln (' 0 - Sair;');
readln(op);
case op of
'1': begin
if Vazia(Lista_real) then
writeln ('Lista vazia!')
else
writeln ('Lista nao vazia!');
end;
'2': begin
write ('Digite um codigo para a pessoa: ');
readln(pessoa_aux.chave);
write ('Digite o nome da pessoa: ');
readln(pessoa_aux.nome);
write ('Digite a idade da pessoa: ');
readln(pessoa_aux.idade);
Insere(pessoa_aux, Lista_real);
end;
'3': begin
write ('Remoção com sucesso: ');
readln (codigo);
y:=Lista_real.Primeiro^.prox^.prox;
z:=y;
Lista_real.ultimo^.prox:=z;
codigo:=Lista_real.Primeiro^.chave;
p:=Localiza(codigo, Lista_real);
if p=nil then
writeln ('Remocao impossivel, codigo nao cadastrado!')
else
Remove(p, Lista_real);
end;
'4': begin
Imprime(Lista_real);
end;
else writeln ('Opcao invalida.');
end;
until op='0';
end.
Procedure Cria_lista(Var Lista: tp_lista);
Begin
new(Lista.primeiro);
Lista.ultimo:=Lista.primeiro;
Lista.ultimo^.prox:=nil;
End;
{Verifica se a lista esta vazia}
Function Vazia(Lista: tp_lista): boolean;
Begin
If Lista.ultimo=Lista.primeiro then
Vazia:=true
else
Vazia:=false;
End;
{Insere item na lista}
Procedure Insere (x: tp_pessoa; var Lista: tp_lista);
Begin
new(Lista.ultimo^.prox);
Lista.ultimo:=Lista.ultimo^.prox;
Lista.ultimo^:=x;
Lista.ultimo^.prox:=nil;
End;
{Encontra o endereco de um item a partir do seu codigo}
Function Localiza (cod: integer; Lista: tp_lista): ponteiro;
Var
paux: ponteiro; {ou paux: ^tp_pessoa;}
Begin
paux:=Lista.primeiro;
while ((paux^.prox<>nil)and(paux^.prox^.chave<>cod)) do
paux:=paux^.prox;
Localiza:=paux;
End;
{ Remove item da lista
Obs.: o item a ser retirado e o seguinte ao apontado por p }
Procedure Remove (p: ponteiro; Var Lista: tp_lista);
Var
q: ^tp_pessoa;
Begin
if ((Vazia(Lista)) or (p^.prox=nil)) then
writeln ('Erro: lista vazia ou item inexistente.')
else
begin
q:=p^.prox;
p^.prox:=q^.prox;
if (p^.prox=nil) then
Lista.ultimo:=p;
dispose(q);
end;
End;
{ Imprime os itens da lista }
Procedure Imprime (Lista: tp_lista);
Var
aux: ponteiro; {ou aux: ^tp_pessoa;}
i: integer;
Begin
i:=1;
aux:=Lista.primeiro^.prox;
while (aux<>nil) do
begin
writeln ('Codigo do item ',i,': ',aux^.chave);
writeln ('Nome do item ',i,': ',aux^.nome);
writeln ('Idade do item ',i,': ',aux^.idade);
i:=i+1;
aux:=aux^.prox;
writeln;
end;
End;
Begin
clrscr;
Cria_lista(Lista_real);
repeat
writeln ('Escolha uma opcao: ');
writeln (' 1 - Verifica se a lista esta vazia;');
writeln (' 2 - Insere item na lista;');
writeln (' 3 - Remove itens da lista;');
writeln (' 4 - Imprime itens da lista;');
writeln (' 0 - Sair;');
readln(op);
case op of
'1': begin
if Vazia(Lista_real) then
writeln ('Lista vazia!')
else
writeln ('Lista nao vazia!');
end;
'2': begin
write ('Digite um codigo para a pessoa: ');
readln(pessoa_aux.chave);
write ('Digite o nome da pessoa: ');
readln(pessoa_aux.nome);
write ('Digite a idade da pessoa: ');
readln(pessoa_aux.idade);
Insere(pessoa_aux, Lista_real);
end;
'3': begin
write ('Remoção com sucesso: ');
readln (codigo);
y:=Lista_real.Primeiro^.prox^.prox;
z:=y;
Lista_real.ultimo^.prox:=z;
codigo:=Lista_real.Primeiro^.chave;
p:=Localiza(codigo, Lista_real);
if p=nil then
writeln ('Remocao impossivel, codigo nao cadastrado!')
else
Remove(p, Lista_real);
end;
'4': begin
Imprime(Lista_real);
end;
else writeln ('Opcao invalida.');
end;
until op='0';
end.
Eu postei esse programa enquanto fazia faculdade, faz muito tempo, infelizmente não consigo te ajudar com isso hoje.