unit Ord_Pas;
 (* contents of file ord_pas.pas, *)
 (* pascal only version of file ordinals.pas *)
 (* by Uros Boltin *)

 { Calculates ordinal numbers of combinations and vice versa. }
 { Numbers can be in range [1..32]. }

interface

const
   MaxN: integer = 32;

type
   Set31 = set of 0..31;
   LotMap = LongInt;
    { Type LotMap is used for binary bitmaps of combinations. }
    { Use Set31 type conversion to access numbers. It's zero-based! }
    { E.g.: ...  if (x-1) in Set31(Lot) then ... }
    { Here, 0 stands for 1, 1 for 2 etc. until 31 for 32 }
    { Warning: set of 1..32 won't work! It's shifted and takes 5 bytes. }
   TPascalTriangle = array[ 1..32, -1..30 ] of LongInt;
   PPascalTriangle = ^TPascalTriangle;

const
   Triangle: PPascalTriangle = nil;

procedure MakeTriangle;
procedure FreeTriangle;
function Binomial( n,r:integer ): LongInt;

function Backwards( Lot:LotMap; n:integer ): LotMap;
function LotIndex( Lot:LotMap ): LongInt;
function LotAt( Index:LongInt; r:integer ): LotMap;

{ Functions LotIndex and LotAt are the ones which actually do the job. }
{ They work with zero-based absolute ordinals. }
{ The following four functions are simple wrappers around them. }
{ These work with the usual ordinals, starting 1,2,3... }

function AbsoluteOrdinal( Lot:LotMap ): LongInt;
function RelativeOrdinal( Lot:LotMap; n,r:integer ): LongInt;
function FromAbsolute( Index:LongInt; r:integer ): LotMap;
function FromRelative( Index:LongInt; n,r:integer ): LotMap;



implementation


procedure MakeTriangle;
   { initialization before any other function can be called }
   var
      i,j: integer;
   begin
      if Triangle<>nil then Exit;
      New( Triangle );
      for i := 1 to 32 do Triangle^[i,-1] := 0;
      for j := 0 to 30 do Triangle^[1,j] := j+1;
      for i := 2 to 32 do
        for j := 0 to 32-i do
          Triangle^[i,j] := Triangle^[i-1,j] + Triangle^[i,j-1];
   end;

procedure FreeTriangle;
   { cleanup before end of program }
   begin
      if Triangle<>nil then Dispose( Triangle );
      Triangle := nil;
   end;

function Binomial( n,r:integer ): LongInt;
   begin
      case r of
         0: Binomial := 1;
         1: Binomial := n;
      else Binomial := Triangle^[r,n-r];
      end;
   end;


function Backwards( Lot:LotMap; n:integer ): LotMap;
   var
      x:integer;
      Result: Set31;
   begin
      Result := [];
      for x:=0 to n-1 do
         if x in Set31(Lot) then Include( Result, n-1-x );
         { if it were 1-based, not 0-based, it would be x --> n+1-x }
      Backwards := LotMap(Result);
   end;

function LotIndex( Lot:LotMap ): LongInt;
   var
      i,j,x: integer;
      Index: LongInt;
   begin
      i := 1;
      j := -1;
      Index := 0;
      for x:=0 to MaxN-1 do
         if x in Set31(Lot) then begin
            Index := Index + Triangle^[i,j];
            Inc(i);
           end
         else Inc(j);
      LotIndex := Index;
   end;

function LotAt( Index:LongInt; r:integer ): LotMap;
   var
      i,j,x: integer;
      Lot: Set31;
   begin
      Lot := [];
      i := r;
      j := MaxN-1-r;
      x := MaxN-1;
      while r>0 do begin
         if Index < Triangle^[i,j] then Dec(j)
         else begin
            Include( Lot, x );
            Index := Index - Triangle^[i,j];
            Dec(i);
            Dec(r);
           end;
         Dec(x);
        end;
      LotAt := LotMap(Lot);
   end;


function AbsoluteOrdinal( Lot:LotMap ): LongInt;
   begin
      if Lot=0 then AbsoluteOrdinal := 0
      else AbsoluteOrdinal := LotIndex(Lot) + 1;
   end;

function RelativeOrdinal( Lot:LotMap; n,r:integer ): LongInt;
   begin
      if Lot=0 then RelativeOrdinal := 0
      else RelativeOrdinal := Binomial(n,r) - LotIndex( Backwards(Lot,n) );
   end;

function FromAbsolute( Index:LongInt; r:integer ): LotMap;
   begin
      if Index=0 then FromAbsolute := 0
      else FromAbsolute := LotAt( Index-1, r );
   end;

function FromRelative( Index:LongInt; n,r:integer ): LotMap;
   begin
      if Index=0 then FromRelative := 0
      else FromRelative := Backwards( LotAt( Binomial(n,r)-Index, r ), n );
   end;

end.