tpu/u_prique.pas

{ ppc386 -va -vh *.pas }
{ COMIENZO DE DESCRIPCION

  Colas de prioridad por monticulos. keywords: cola de prioridad

FIN DE DESCRIPCION }
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
{ $Id: u_prique.pas 2002/05/21 21:33 mstorti Exp mstorti $  }

unit u_prique ;

interface

const
   tam_max = 1000;
	     
type
   tipo_elemento = integer;

COLA_DE_PRORIDAD = object
   private	    
   contenido : array [1..tam_max] of tipo_elemento;
   ult: integer;
   public
   procedure ANULA;
   procedure INSERTA (x : tipo_elemento);
   function  SUPRIME_MIN : tipo_elemento;
   procedure IMPRIME (s : string) ;
   function  VACIA : boolean;
end;			     
   
procedure ERROR (s : string);

implementation

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure ERROR (s: string);
begin
  write ('error: ');
  writeln (s);
  halt;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure COLA_DE_PRORIDAD.ANULA;
begin
  ult := 0;
end; { COLA_DE_PRORIDAD.ANULA }

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function COLA_DE_PRORIDAD.VACIA : boolean;
begin
  VACIA := ult=0;
end; { COLA_DE_PRORIDAD.VACIA }

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure COLA_DE_PRORIDAD.INSERTA (x : tipo_elemento);
var
  i    : integer;
  temp : tipo_elemento;
begin
  if ult >= tam_max then begin
     ERROR ('La cola de prioridad esta llena...')
  end ; {if}
  ult := ult+1;
  contenido [ult] := x;
  i := ult;
  while (i>1) and (contenido[i] < contenido[i div 2]) do begin
    {sube `x' en el arbol y lo intercambia}
    temp := contenido [i];  {con su padre de mayor prioridad }
    contenido [i] := contenido [i div 2];
    contenido [i div 2] := temp;
    i := i div 2;
  end;
end; { COLA_DE_PRORIDAD.INSERTA }

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure COLA_DE_PRORIDAD.IMPRIME (s: string);
var
  i : integer;
begin
  write (s,' ');
  for i:=1 to ult do write (contenido [i],' ');
  writeln;
end; { COLA_DE_PRORIDAD.IMPRIME }
      
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function COLA_DE_PRORIDAD.SUPRIME_MIN : tipo_elemento;
var
  i, j : integer;
  temp : tipo_elemento;
begin 
  if VACIA then ERROR ('La cola de prioridad esta vacia.');
  SUPRIME_MIN := contenido [1];
  contenido [1] := contenido [ult]; { Sube ultimo elemento }
  ult := ult - 1;		      { actualiza cursor }
  i   := 1;
  while i<= ult div 2 do begin
    {Lleva el elemento hacia abajo en el arbol }
    if   (contenido [2*i] < contenido [2*i + 1])
      or (ult = 2*i) then
      j:=2*i
    else begin
      j := 2*i +1
    end ; {if}
    if (contenido [i] > contenido [j]) then
       begin
       temp := contenido [i];
       contenido [i] := contenido[j];
       contenido [j] := temp;
       i := j;
       end
    else begin
       break
    end ; {if}
 end ; {while}
end; { COLA_DE_PRORIDAD.SUPRIME_MIN }
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}

end.
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}