Estrutura de dados - lista
Publicado por Jose Ribeiro 06/08/2009
[ Hits: 6.443 ]
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.
Script em Pascal/Kylix para controle de Locadoras sem salvar arquivos em disco
Ordenando um vetor sem utilização de variáveis de contagem ou auxiliar
Nenhum comentário foi encontrado.
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
Meu Fork do Plugin de Integração do CVS para o KDevelop
Compartilhando a tela do Computador no Celular via Deskreen
Como Configurar um Túnel SSH Reverso para Acessar Sua Máquina Local a Partir de uma Máquina Remota
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
Cups: Mapear/listar todas as impressoras de outro Servidor CUPS de forma rápida e fácil
Problema para iniciar sistema (5)
Não consigo atualizar para LinuxMint 22 com o Mintupdate (1)
Meu notebook não reconhece monitor secundário (6)
Instalação da Imagem ISO do Tails (7)
erro nos dos pacotes de driver da placa de video nvidia por remoção (d... (18)