Implementación TAD Pila.

Type

Telem:....;

Tpila=^Nodo

Nodo=record

elem:Telem;

sig:Tpila

end;

Procedure Crearpila(var pila:Tpila);

begin

pila:=nil

end;

Function Pilavacia(pila:Tpila):boolean;

begin

Pilavacia:=pila=nil

end;

Procedure Apilar(var pila:Tpila;elem:Telem);

var aux:Tpila;

begin

if not Pilavacia(pila) then

begin

new(aux);

aux^.elem:=elem;

aux^.sig:=pila;

pila:=aux

end

else

writeln (�pila vacia')

end;

Procedure Desapilar(var pila:Tpila);

var aux:Tpila;

begin

if not Pilavacia(pila) then

begin

aux:=pila;

pila:=pila^.sig;

dispose(aux)

end

else

writeln(� pila vacia')

end;

Procedure Cima(pila:Tpila;var elem:Telem);

begin

if not Pilavacia(pila) then

elem:=pila^.elem

else

writeln (�pila vacia')

end;

Problemas

* Contar los elementos de una pila de forma iterativa

Procedure Elementos(var pila:Tpila;var ne:integer);

var paux:Tpila;

elem: Telem;

begin

new(paux); ne:=0;

while not Pilavacia(pila) do

begin

Cima(pila,elem);

Desapilar(pila);

Apilar(paux,elem);

ne:=ne+1

end;

while not Pilavacia(paux) do

begin

Cima(paux,elem);

Desapilar(paux);

Apilar(pila,elem)

End

end;

* Contar los elementos de una pila de forma recursiva

Function Elementos(var pila:Tpila):integer;

var elem:Telem;

begin

if not Pilavacia(pila) then

begin

Cima(pila,elem);

Desapilar(pila);

Elementos:=Elementos(pila)+1;

Apilar(pila,elem)

end

else

Elementos:=0

end;

Procedure Elementos(var pila:Tpila; var ne:integer);

var elem:Telem;

begin

if not Pilavacia(pila) then

begin

Cima(pila,elem);

Desapilar(pila);

ne:=ne+1;

Elementos(pila,ne);

Apilar(pila,elem)

end

else

writeln (�pila vacia')

end;

* Insertar un elemento en el fondo de una pila

Procedure Insertarfondo(var pila:Tpila;elem:Telem);

var aux:telem;

begin

if not Pilavacia(pila) then

begin

Cima(pila,aux);

Desapilar(pila);

Insertarfondo(pila,elem);

Apilar(pila,aux)

end

else

Apilar(pila,elem)

end;

* Invertir los elementos de una pila

Procedure Invertir(var pila:Tpila);

var elem:Telem;

begin

if not Pilavacia(pila) then

begin

Cima(pila,elem);

Desapilar(pila);

Invertir(pila);

Insertarfondo(pila,elem)

end

end;

* Procedimiento que elimine y devuelva el último elemento de una pila

Procedure Borrarultimo(var pila:Tpila;var elem:Telem; var ultimo:boolean);

var aux:Telem;

begin

if not Pilavacia(pila) then

begin

Cima(pila,aux);

Desapilar(pila);

Borrarultimo(pila,elem,ultimo);

if ultimo then

begin

elem:=aux;

ultimo:=false

end

else

Apilar(pila,aux)

end

else

ultimo:=true

end;

* Función que indique si dos pilas son iguales

Function Iguales(var P1,P2:Tpila):Boolean;

var aux1,aux2:Telem;

resultado:boolean;

begin

if Pilavacia(P1) and Pilavacia(P2) then

resultado:=true

else

if Pilavacia(P1) or Pilavacia(P2) then

resultado:=false

else

begin

Cima(P1,aux1);

Cima(P2,aux2);

Desapilar(P1);

Desapilar(P2);

if aux1=aux2 then

Iguales:=Iguales(P1,P2)

else

resultado:=false;

Apilar(P1,aux1);

Apilar(P2,aux2)

end

Iguales:=resultado

end;

2� práctica 97/98 aptdo.3

Dados una pila y cola con el mismo número de elementos comprobar si los elementos de la pila constituyen la imagen especular de los elementos de la cola.

Function Imagenespecular(var pila:Tpila;var cola:Tcola):boolean;

var auxpila,auxcola:Telem;

resultado:boolean;

begin

if not Pilavacia(pila) then

begin

Cima(pila,auxpila);

Desapilar(pila);

Imagenespecular:=Imagenespecular(pila,cola);

Primero(cola,auxcola);

Desencolar(cola);

If not auxpila=auxcola then

resultado:=false ;

Encolar(cola,auxcola);

Apilar(pila,auxpila)

end

else

resultado:=true;

Imagenespecular:=resultado

end;

3� práctica 97/98 aptdo.4 ( no corregido )

* Dadas 2 pilas ordenadas ascendentemente obtener una pila con los elementos ordenados descendentemente de las pilas 1 y 2.

Procedure Fusionar(var p1,p2,p3:Tpila);

var aux1,aux2:Telem;

begin

if not Pilavacia(p1) and not Pilavacia(p2) then

begin

Desapilar(p1,aux1);

Desapilar(p2,aux2);

Insertar(aux1,aux2,p3);

Fusionar(p1,p2,p3);

Apilar(p1,aux1);

Apilar(p2,aux2)

end

end;