Estrutura de dados - lista
Publicado por Jose Ribeiro 06/08/2009
[ Hits: 6.469 ]
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
Script em Pascal/Kylix para controle de Locadoras sem salvar arquivos em disco
Nenhum comentário foi encontrado.
Passkeys: A Evolução da Autenticação Digital
Instalação de distro Linux em computadores, netbooks, etc, em rede com o Clonezilla
Título: Descobrindo o IP externo da VPN no Linux
Armazenando a senha de sua carteira Bitcoin de forma segura no Linux
Enviar mensagem ao usuário trabalhando com as opções do php.ini
Instalando Brave Browser no Linux Mint 22
vídeo pra quem quer saber como funciona Proteção de Memória:
Encontre seus arquivos facilmente com o Drill
Mouse Logitech MX Ergo Advanced Wireless Trackball no Linux
Compartilhamento de Rede com samba em modo Público/Anônimo de forma simples, rápido e fácil
PC não liga no filtro de linha (3)
Desde que seja DDR3, posso colocar qualquer memória? (3)
Instalar sem formatar, pergunta meio boba. [RESOLVIDO] (7)
Curso gratuito Defesa de redes 10ª Maratona CiberEducação Cisco Brasil... (0)