with unchecked_deallocation;
package body Brackets is
-- AUXILIARY OPERATION :
procedure Swap ( v : in out Standard_Natural_Vectors.Vector;
i,j : in natural ) is
-- DESCRIPTION :
-- Swaps the i-th and j-th entry in the vector v.
tmp : natural := v(i);
begin
v(i) := v(j); v(j) := tmp;
end Swap;
-- CONSTRUCTORS :
procedure Create ( v : in Standard_Natural_Vectors.Vector;
b : out Bracket; sign : out integer ) is
sig : integer := +1;
min,ind : natural;
bb : Bracket(v'range) := Bracket(v);
begin
for i in bb'first..bb'last-1 loop
min := bb(i);
ind := i;
for j in i+1..bb'last loop
if bb(j) < min
then ind := j;
min := bb(j);
end if;
end loop;
if ind /= i
then Swap(Standard_Natural_Vectors.Vector(bb),i,ind);
sig := -sig;
end if;
end loop;
b := bb;
sign := sig;
end Create;
procedure Create ( v : in Standard_Natural_Vectors.Vector;
perm : out Standard_Natural_Vectors.Vector;
b : out Bracket; sign : out integer ) is
sig : integer := +1;
min,ind : natural;
bb : Bracket(v'range) := Bracket(v);
pp : Standard_Natural_Vectors.Vector(v'range);
begin
for i in pp'range loop
pp(i) := i;
end loop;
for i in bb'first..bb'last-1 loop
min := bb(i);
ind := i;
for j in i+1..bb'last loop
if bb(j) < min
then ind := j;
min := bb(j);
end if;
end loop;
if ind /= i
then Swap(Standard_Natural_Vectors.Vector(bb),i,ind);
Swap(pp,i,ind);
sig := -sig;
end if;
end loop;
perm := pp;
b := bb;
sign := sig;
end Create;
function Modulo ( b : Bracket; n : natural ) return Bracket is
res : Bracket(b'range);
modvec : Standard_Natural_Vectors.Vector(b'range);
sig : integer;
begin
for i in b'range loop
modvec(i) := b(i) mod n;
if modvec(i) = 0
then modvec(i) := n;
end if;
end loop;
Create(modvec,res,sig);
return res;
end Modulo;
procedure Modulo ( b : in Bracket; n : in natural;
perm : out Standard_Natural_Vectors.Vector;
mb : out Bracket ) is
res : Bracket(b'range);
modvec : Standard_Natural_Vectors.Vector(b'range);
sig : integer;
begin
for i in b'range loop
modvec(i) := b(i) mod n;
if modvec(i) = 0
then modvec(i) := n;
end if;
end loop;
Create(modvec,perm,res,sig);
mb := res;
end Modulo;
-- SELECTORS :
function Is_Zero ( b : Bracket ) return boolean is
begin
for i in b'first..b'last-1 loop
if b(i) = b(i+1)
then return true;
end if;
end loop;
return false;
end Is_Zero;
function Is_Equal ( b1,b2 : Bracket ) return boolean is
use Standard_Natural_Vectors;
begin
if b1'length /= b2'length
then return false;
else return Equal(Vector(b1),Vector(b2));
end if;
end Is_Equal;
function "<" ( b1,b2 : Bracket ) return boolean is
begin
for i in b1'range loop
if b1(i) < b2(i)
then return true;
elsif b1(i) > b2(i)
then return false;
end if;
end loop;
return false;
end "<";
function ">" ( b1,b2 : Bracket ) return boolean is
begin
for i in b1'range loop
if b1(i) > b2(i)
then return true;
elsif b1(i) < b2(i)
then return false;
end if;
end loop;
return false;
end ">";
function Is_Standard ( b1,b2 : Bracket ) return natural is
begin
for i in b1'range loop
if b1(i) > b2(i)
then return i;
end if;
end loop;
return 0;
end Is_Standard;
-- DESTRUCTOR :
procedure Clear ( lb : in out Link_to_Bracket ) is
procedure free is new unchecked_deallocation(Bracket,Link_to_Bracket);
begin
free(lb);
end Clear;
end Brackets;