Estrutura de dados - lista
Publicado por Jose Ribeiro 06/08/2009
[ Hits: 6.730 ]
Homepage: https://serviceup.com.br/
Um exemplo de lista utilizando apontadores.
program ed;
uses crt;
type
apontador = ^celula;
celula = record
item:integer;
prox:apontador;
end;
tipolista = record
primeiro:apontador;
ultimo:apontador;
end;
procedure inicialista(var lista:tipolista);
var
aux:apontador;
begin
new (aux);
lista.primeiro:=aux;
lista.ultimo:=lista.primeiro;
lista.ultimo^.prox :=nil;
end;
function vazia(lista:tipolista):boolean;
begin
vazia:=lista.primeiro = lista.ultimo;
end;
procedure inserirf(x:integer;var lista:tipolista);
var aux:apontador;
begin
new (aux);
lista.ultimo^.prox:=aux;
aux^.prox := nil;
aux^.item :=x;
lista.ultimo := aux;
end;
procedure imprimir(lista:tipolista);
var aux:apontador;
begin
aux := lista.primeiro^.prox;
while ( aux <> nil ) do begin
writeln(aux^.item);
aux:=aux^.prox;
end;
end;
procedure inseriri(x:integer; var lista:tipolista);
var
aux:apontador;
begin
if(vazia(lista)) then
inserirf(x,lista)
else
begin
new(aux);
aux^.item := x;
aux^.prox:=lista.primeiro^.prox;
lista.primeiro^.prox := aux;
end;
end;
procedure retirai(var x:integer; var lista:tipolista);
var
aux:apontador;
begin
aux:=lista.primeiro^.prox;
x:=aux^.item;
lista.primeiro^.prox := aux^.prox;
if (lista.primeiro^.prox = nil ) then lista.ultimo := lista.primeiro;
dispose(aux);
end;
procedure retirarf(var x:integer; var lista:tipolista);
var
aux:apontador;
begin
if ( lista.primeiro^.prox^.prox = nil ) then
retirai(x,lista)
else
begin
aux:=lista.primeiro^.prox;
while ( aux^.prox <> lista.ultimo) do
aux := aux^.prox;
lista.ultimo := aux;
aux:=aux^.prox;
x:=aux^.item;
lista.ultimo^.prox:=nil;
dispose(aux);
end;
end;
procedure retiral( var x:integer; var lista:tipolista; n:integer);
var
aux,aux1:apontador;
i:integer;
begin
aux:=lista.primeiro;
for i:=1 to n-1 do
begin
x:=aux^.prox^.item;
end;
aux1:= aux^.prox;
aux^.prox := aux1^.prox;
dispose(aux1);
end;
procedure media(l:tipolista; var media:real);
var
aux:apontador;
b:integer;
begin
aux:=l.primeiro;
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 somapar(l:tipolista; var sp:integer);
var
aux:apontador;
begin
aux:=l.primeiro;
sp:=0;
while (aux^.prox <> nil) do begin
aux:=aux^.prox;
if (aux^.item mod 2) = 0 then
begin
sp:=sp+aux^.item;
end;
end;
end;
procedure retira2(var lista:tipolista; x:integer);
var auxR,aux:apontador;
cont,i:integer;
begin
i:=0;
aux:=lista.primeiro;
while (aux^.item <> x) do begin
aux:= aux^.prox;
i:=i+1;
end;
auxR := lista.primeiro;
for cont:=1 to i-3 do auxR:=auxR^.prox;
aux:=auxR^.prox;
auxR^.prox := aux^.prox;
dispose(aux);
end;
procedure exer3daprova(l:tipolista);
var
mediam:real;
aux:apontador;
i,multi,somap:integer;
begin
i:=0;
multi:=1;
aux:=l.primeiro^.prox;
while ( aux <> nil ) do begin
i:=i+1;
if (aux^.item mod 2 = 1 ) then
multi := multi * aux^.item;
if ( i mod 2 = 0 ) then
somap:=somap + aux^.item;
end;
mediam := multi / i;
writeln(mediam);
writeln(somap);
end;
procedure inserirantes( var l:tipolista; x:integer; elem:integer);
var
aux,aux1:apontador;
begin
aux:=l.primeiro^.prox;
while ( aux^.prox^.item <> elem ) do begin
aux^.prox;
end;
new (aux1);
aux1^.prox := aux^.prox;
aux^.prox := aux1;
aux1^.item := x;
end;
var
l:tipolista;
opc:char;
elem:integer;
n:integer;
soma:integer;
m:real;
{ Programa principal }
begin
inicialista(l);
repeat
writeln(' 1 - Insere in¡cio ');
writeln(' 2 - Insere Fim ');
writeln(' 3 - Retira in¡cio ');
writeln(' 4 - Retira fim ');
writeln(' 5 - Imprimir ');
writeln(' 6 - retirar elemtento em posi‡Æo X ');
writeln(' 7 - Media ');
writeln(' 8 - soma dos elementos pares ');
writeln(' a - Retirar 2§ elemento antes de X ');
writeln(' b - media arit dos elementos impares, e soma dos elem que estÆo nas posi‡äes pares');
writeln(' c - inserir um elemento antes de um determinado elemento');
writeln(' 9 - Sair');
writeln(' 0 - limpar a tela');
opc:=readkey;
{ clrscr; }
case opc of
'1':begin
writeln('Entre com o elemento a ser inserido');
readln(elem);
inseriri(elem,l);
end;
'2' :begin
writeln('Entre com o elemento a ser inserido no final');
readln(elem);
inserirf(elem,l);
end;
'3' :begin
if vazia(l) then writeln('A lista est vazia, impossivel retirar elemento !')
else begin
retirai(elem,l);
writeln('O elemento', elem , 'foi removido do inicio da lista');
end;
end;
'4' :begin
if vazia(l) then writeln('A lista est vazia, impossivel retirar elemento !')
else begin
retirarf(elem,l);
writeln('O elemento', elem , 'foi removido do inicio da lista');
end;
end;
'5':begin
writeln('Elementos do lista');
imprimir(l);
end;
'6' :begin
if not vazia(l) then
writeln('Entre com a posi‡Æo do elemtento a ser removido');
readln(n);
retiral(elem,l,n);
end;
'7' :begin
media(l,m);
writeln('A media ‚ ',m:3:2);
end;
'8' :begin
somapar(l,soma);
writeln('a soma dos elementos pares ‚',soma)
end;
'9':writeln('Saindo do programa');
'0':clrscr;
'a' :begin
writeln('Elemento');
readln(elem);
retira2(l,elem);
end;
'b' :exer3daprova(l);
end;
until(opc='9');
readkey;
end.
Ordenando um vetor sem utilização de variáveis de contagem ou auxiliar
Nenhum comentário foi encontrado.
Cirurgia para acelerar o openSUSE em HD externo via USB
Void Server como Domain Control
Modo Simples de Baixar e Usar o bash-completion
Monitorando o Preço do Bitcoin ou sua Cripto Favorita em Tempo Real com um Widget Flutuante
Jogar games da Battle.net no Linux com Faugus Launcher
Como fazer a Instalação de aplicativos para acesso remoto ao Linux
Como fazer a instalação do Samba
Como fazer a conversão binária e aplicar as restrições no Linux
Duas Pasta Pessoal Aparecendo no Ubuntu 24.04.3 LTS (22)
Formas seguras de instalar Debian Sid (13)
Malware encontrado em extensões do Firefox. (0)
Fiz uma pergunta no fórum mas não consigo localizar [RESOLVIDO] (21)









