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

1

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);

2

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);

3

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

4

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

5

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

6

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); 7

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; 5/4

8