PROGRAM Monticulos;
CONST
TAM = 10;
TYPE
TPrioridad = Integer;
TElem = RECORD
elm : String;
pri : TPrioridad;
END;
Indice = 1..TAM;
Tamanyo = 0..TAM;
TMont = RECORD
tam: Tamanyo;
mnt: ARRAY[Indice] OF TElem;
END;
TMonticulo = ^Tmont;
(* Lee un elemento *)
PROCEDURE LeeElem(VAR E: TElem);
BEGIN
Write('úIntroduce NOMBRE : '); Readln(E.elm);
REPEAT
Write('úIntroduce PRIORIDAD (1..10) : '); Readln(E.pri);
UNTIL (E.pri <= 10) AND (E.pri >= 1)
END;
(* Intercambia dos nodos en un Mont¡culo *)
PROCEDURE Intercambiar(VAR M : TMonticulo; Padre, Hijo: Integer);
VAR
Aux : TElem;
BEGIN
Aux := M^.mnt[Padre];
M^.mnt[Padre] := M^.mnt[Hijo];
M^.mnt[Hijo] := Aux
END;
(* Inserta un nodo en un mont¡culo *)
PROCEDURE Insertar(VAR M : TMonticulo; E: TElem);
VAR
I : Integer;
BEGIN
IF M^.tam >= TAM THEN
Writeln('--> El elemento no ha sido insertado, la cola est llena.')
ELSE BEGIN
M^.tam := M^.tam + 1;
I := M^.tam;
M^.mnt[I] := E;
WHILE ((I DIV 2) <> 0) AND (M^.mnt[I].pri < M^.mnt[I DIV 2].pri) DO BEGIN
Intercambiar(M, I, I DIV 2);
I := I DIV 2
END;
Writeln('--> Elemento insertado. ')
END;
Writeln;
END;
(* Borra el elemento de la raiz y la reorganiza *)
PROCEDURE Borrar(VAR M: TMonticulo);
VAR
I : Integer;
BEGIN
IF M^.tam = 0 THEN
Writeln('--> La cola est vac¡a. ')
ELSE BEGIN
Intercambiar(M, 1, M^.tam);
M^.tam := M^.tam - 1;
I := 1;
WHILE (I * 2) < M^.tam DO BEGIN
IF M^.mnt[I].pri > M^.mnt[I * 2].pri THEN
Intercambiar(M, I, I * 2);
IF M^.mnt[I].pri > M^.mnt[I * 2 + 1].pri THEN
Intercambiar(M, I, I * 2 + 1);
I := I * 2
END;
Writeln('--> Elemento borrado. ')
END;
Writeln
END;
(* Imprime una cola de prioridades *)
PROCEDURE Imprimir(M : TMonticulo);
VAR
I : Integer;
BEGIN
IF M^.tam = 0 THEN BEGIN
Writeln('--> La cola est vac¡a. ');
Writeln
END ELSE BEGIN
Writeln(' NOMBRE ------------- PRIORIDAD ');
FOR I:=1 TO M^.tam DO
Writeln(M^.mnt[I].elm,' ==> ', M^.mnt[I].pri)
END;
Writeln
END;
VAR
Opcion : Integer;
M : TMonticulo;
E : TElem;
BEGIN
New(M);
M^.tam := 0;
REPEAT
Writeln('----------MENé-----------');
Writeln('1) Insertar un elemento. ');
Writeln('2) Sacar un elemento. ');
Writeln('3) Ver el contenido. ');
Writeln('4) SALIR. ');
Write(' ESCOGE UNA OPCIàN : '); Readln(Opcion);
Writeln;
CASE Opcion OF
1 : BEGIN
LeeElem(E);
Insertar(M, E);
Writeln
END;
2 : Borrar(M);
3 : Imprimir(M);
4 : BEGIN
Writeln('<<< FIN DEL PROGRAMA >>>');
Dispose(M)
END
END
UNTIL (Opcion = 4);
Readln
END.