QBHEAP - Hàng đợi có độ ưu tiên

Tác giả: RR

Ngôn ngữ: Pascal

{$MODE OBJFPC}
var
  i,cnt,save,tmp,hsize,u:longint;
  a,h:array[1..30111] of longint;
  c:char;

procedure swap(var a,b:longint);
    var
      tmp:longint;
    begin
      tmp:=a; a:=b; b:=tmp;
    end;

procedure down(i:longint);
    var
      j:longint;
    begin
      j:=i shl 1;
      while (j<=hsize) do
        begin
          if (j<hsize) and (h[j+1]>h[j]) then inc(j);
          if h[j]>h[i] then
            begin
              swap(h[i],h[j]);
              i:=j; j:=i shl 1;
            end
          else exit;
        end;
    end;

procedure up(i:longint);
    var
      j:longint;
    begin
      j:=i shr 1;
      while (i>1) and (h[i]>h[j]) do
        begin
          swap(h[i],h[j]);
          i:=j; j:=i shr 1;
        end;
    end;

procedure push(u:longint);
    begin
      inc(hsize);
      h[hsize]:=u;
      up(hsize);
    end;

function pop:longint;
    begin
      result:=h[1];
      swap(h[1],h[hsize]);
      dec(hsize);
      down(1);
    end;

begin
  while not eof do
    begin
      read(c);
      if c='+' then
        begin
          readln(u);
          if hsize<15000 then
              push(u);
        end
      else
        begin
          readln;
          if hsize>0 then
            begin
              u:=h[1];
              while (hsize>0) and (h[1]=u) do
                  tmp:=pop;
            end;
        end;
    end;

  save:=1000111000;

  while hsize>0 do
    begin
      u:=pop;
      if u<>save then
        begin
          inc(cnt);
          a[cnt]:=u;
          save:=u;
        end;
    end;

  writeln(cnt);
  for i:=1 to cnt do
    writeln(a[i]);
end.

Download