ipq.pas

类似文明的游戏源代码。

{$INCLUDE switches}

unit IPQ;

interface

type
TList=array[0..99999999] of integer;

TIPQ=class
  constructor Create(max: integer);
  destructor Destroy; override;
  function Put(Item, Value: integer): boolean;
  function Get(var Item, Value: integer): boolean;
private
  n,fmax: integer;
  ix,fi,fv: ^TList;
  end;

implementation

constructor TIPQ.Create(max: integer);
begin
inherited Create;
fmax:=max;
GetMem(ix,4*fmax);
GetMem(fi,4*fmax);
GetMem(fv,4*fmax);
FillChar(ix^,4*fmax,255); {-1}
n:=0;
end;

destructor TIPQ.Destroy;
begin
FreeMem(ix,4*fmax);
FreeMem(fi,4*fmax);
FreeMem(fv,4*fmax);
inherited Destroy;
end;

function TIPQ.Put(Item, Value: integer): boolean;
var
Root, full, used, iswap, vswap, Next, a: integer;
begin
if ix[Item]<0 then
  begin{add}
  full:=1;
  while full shl 1<=n+1 do full:=full shl 1;
  used:=n+1-full;
  Root:=0;
  while full>1 do
    begin
    if Value<fv[Root] then
      begin
      ix[Item]:=Root;
      iswap:=fi[Root];
      fi[Root]:=Item;
      Item:=iswap;
      vswap:=fv[Root];
      fv[Root]:=Value;
      Value:=vswap
      end;
    full:=full shr 1;
    Next:=Byte(used>=full);
    if Next>0 then used:=used-full;
    a:=2*Root+2-Next;
    if (a<n) and (Value<fv[a]) then
      begin
      ix[Item]:=a;
      iswap:=fi[a];
      fi[a]:=Item;
      Item:=iswap;
      vswap:=fv[a];
      fv[a]:=Value;
      Value:=vswap
      end;
    Root:=2*Root+1+Next
    end;
  fi[Root]:=Item;
  fv[Root]:=Value;
  ix[Item]:=Root;
  inc(n);
  result:=true
  end
else if Value<fv[ix[Item]] then
  begin {already contained, change value only}
  Root:=ix[Item];
  a:=(Root-1) shr 1;
  while (Root>0) and (fv[a]>Value) do
    begin
    fi[Root]:=fi[a];
    fv[Root]:=fv[a];
    ix[fi[Root]]:=Root;
    Root:=a;
    a:=(Root-1) shr 1;
    end;
  fi[Root]:=Item;
  fv[Root]:=Value;
  ix[Item]:=Root;
  result:=true
  end
else result:=false
end;

function TIPQ.Get(var Item, Value: integer): boolean;
var
Root, ilast, vlast, a, b, e: integer;
begin
if n=0 then begin result:=false; exit end;
Item:=fi[0];
Value:=fv[0];
ix[Item]:=-1;
ilast:=fi[n-1];
vlast:=fv[n-1];
dec(n);
Root:=0;
while 2*Root+1<n do
  begin
  a:=2*Root+1+Byte((2*Root+2<=n) and (fv[2*Root+1]>fv[2*Root+2]));
  if vlast<=fv[a] then Break
  else
    begin
    fi[Root]:=fi[a];
    fv[Root]:=fv[a];
    ix[fi[Root]]:=Root;
    e:=4*Root+3;
    if e<n then
      begin
      b:=e;
      inc(e); //e:=4*Root+4
      if e<n then
        begin
        if fv[e]<fv[b] then b:=e;
        inc(e); //e:=4*Root+5
        if e<n then
          begin
          if fv[e]<fv[b] then b:=e;
          inc(e); //e:=4*Root+6
          if (e<n) and (fv[e]<fv[b]) then b:=e;
          end
        end;
      b:=1+(b-3) shr 1;
      if a<>b then
        begin
        fi[a]:=fi[b];
        fv[a]:=fv[b];
        ix[fi[a]]:=a
        end;
      Root:=b;
      end
    else Root:=a;
    end
  end;
fi[Root]:=ilast;
fv[Root]:=vlast;
ix[ilast]:=Root;
result:=true
end;

end.