with Integer_Vectors_Utilities; use Integer_Vectors_Utilities; -- with Power_Lists; use Power_Lists; package body Integer_Lifting_Utilities is function Adaptive_Lifting ( l : Array_of_Lists ) return Vector is res : Vector(l'range); fac : constant natural := 3; -- multiplication factor max : constant natural := 23; -- upper bound for lifting begin for i in l'range loop res(i) := fac*Length_Of(l(i)); if res(i) > max then res(i) := max; end if; end loop; return res; end Adaptive_Lifting; -- function Select_Subsystem ( p : Laur_Sys; mix : Vector; mic : Mixed_Cell ) -- return Laur_Sys is -- -- res : Laur_Sys(p'range); -- cnt : natural := 0; -- -- begin -- for k in mix'range loop -- for l in 1..mix(k) loop -- cnt := cnt + 1; -- res(cnt) := Select_Terms(p(cnt),mic.pts(k)); -- end loop; -- end loop; -- return res; -- end Select_Subsystem; function Perform_Lifting ( n : natural; l : List; p : Poly ) return Poly is res : Poly := Null_Poly; tmp : List := l; begin while not Is_Null(tmp) loop declare d : Link_to_Vector := Head_Of(tmp); dr : Link_to_Vector := Reduce(d,n+1); t : Term; begin t.cf := Coeff(p,Degrees(dr)); t.dg := Degrees(d); Add(res,t); Clear(dr); end; tmp := Tail_Of(tmp); end loop; return res; end Perform_Lifting; function Perform_Lifting ( n : natural; mix : Vector; lifted : Array_of_Lists; p : Laur_Sys ) return Laur_Sys is res : Laur_Sys(p'range); cnt : natural := 1; begin for k in mix'range loop for l in 1..mix(k) loop res(cnt) := Perform_Lifting(n,lifted(k),p(cnt)); cnt := cnt+1; end loop; end loop; return res; end Perform_Lifting; function Copy_Lifting ( lifted : List; pt : Link_to_Vector ) return Link_to_Vector is -- DESCRIPTION : -- Searches the correspoinding point in the list lifted and returns -- the lifted point. If the corresponding point has not been found, -- then the original point pt will be returned. tmp : List := lifted; lpt,res : Link_to_Vector; begin while not Is_Null(tmp) loop lpt := Head_Of(tmp); if Equal(lpt(pt'range),pt.all) then res := new Standard_Integer_Vectors.Vector'(lpt.all); return res; else tmp := Tail_Of(tmp); end if; end loop; return pt; end Copy_Lifting; function Copy_Lifting ( lifted,pts : List ) return List is -- DESCRIPTION : -- Copies the lifting on the points lifted to the points in pts, -- i.e., each point in pts will get the same lifting as the corresponding -- lifted point in the list lifted. res : List; tmp : List := pts; begin while not Is_Null(tmp) loop Construct(Copy_Lifting(lifted,Head_Of(tmp)),res); tmp := Tail_Of(tmp); end loop; return res; end Copy_Lifting; procedure Search_Lifting ( l : in List; pt : in Vector; found : out boolean; lif : out integer ) is tmp : List := l; lpt : Link_to_Vector; begin found := false; while not Is_Null(tmp) loop lpt := Head_Of(tmp); if Equal(lpt(pt'range),pt) then found := true; lif := lpt(lpt'last); exit; else tmp := Tail_Of(tmp); end if; end loop; end Search_Lifting; function Search_and_Lift ( l : List; pt : Vector ) return Vector is tmp : List := l; lpt : Link_to_Vector; begin while not Is_Null(tmp) loop lpt := Head_Of(tmp); if Equal(lpt(pt'range),pt) then return lpt.all; else tmp := Tail_Of(tmp); end if; end loop; return pt; end Search_and_Lift; function Search_and_Lift ( mic : Mixed_Cell; k : natural; pt : Vector ) return Vector is begin return Search_and_Lift(mic.pts(k),pt); end Search_and_Lift; function Induced_Lifting ( mixsub : Mixed_Subdivision; k : natural; pt : Vector ) return Vector is tmp : Mixed_Subdivision := mixsub; res : Vector(pt'first..pt'last+1); begin while not Is_Null(tmp) loop declare mic : Mixed_Cell := Head_Of(tmp); lpt : constant Vector := Search_and_Lift(mic,k,pt); begin if lpt'length = pt'length+1 then return lpt; else tmp := Tail_Of(tmp); end if; end; end loop; res(pt'range) := pt; res(res'last) := 1; res(res'last) := Conservative_Lifting(mixsub,k,res); return res; end Induced_Lifting; function Induced_Lifting ( n : natural; mix : Vector; points : Array_of_Lists; mixsub : Mixed_Subdivision ) return Array_of_Lists is res,res_last : Array_of_Lists(mix'range); cnt : natural := 1; tmp : List; begin for k in mix'range loop res_last(k) := res(k); tmp := points(cnt); while not Is_Null(tmp) loop declare pt : Link_to_Vector := Head_Of(tmp); lpt : constant Vector := Induced_Lifting(mixsub,k,pt.all); begin Append(res(k),res_last(k),lpt); end; tmp := Tail_Of(tmp); end loop; cnt := cnt + mix(k); end loop; return res; end Induced_Lifting; procedure Constant_Lifting ( l : in List; liftval : in natural; lifted,lifted_last : in out List ) is tmp : List := l; pt : Link_to_Vector; begin while not Is_Null(tmp) loop pt := Head_Of(tmp); declare lpt : Link_to_Vector := new Vector(pt'first..pt'last+1); begin lpt(pt'range) := pt.all; lpt(lpt'last) := liftval; Append(lifted,lifted_last,lpt); end; tmp := Tail_Of(tmp); end loop; end Constant_Lifting; procedure Constant_Lifting ( al : in Array_of_Lists; liftval : in natural; lifted,lifted_last : in out Array_of_Lists ) is begin for i in al'range loop Constant_Lifting(al(i),liftval,lifted(i),lifted_last(i)); end loop; end Constant_Lifting; function Conservative_Lifting ( mic : Mixed_Cell; k : natural; point : Vector ) return integer is sp : integer := mic.nor*Head_Of(mic.pts(k)); spp : integer := mic.nor.all*point; res : integer; begin if sp < spp then return point(point'last); else if mic.nor(mic.nor'last) = 0 then res := point(point'last); else spp := spp - point(point'last)*mic.nor(mic.nor'last); res := (sp - spp)/mic.nor(mic.nor'last) + 1; end if; return res; end if; end Conservative_Lifting; function Conservative_Lifting ( mixsub : Mixed_Subdivision; k : natural; point : Vector ) return integer is tmp : Mixed_Subdivision := mixsub; pt : Vector(point'range) := point; res : integer; begin while not Is_Null(tmp) loop pt(pt'last) := Conservative_Lifting(Head_Of(tmp),k,pt); tmp := Tail_Of(tmp); end loop; res := pt(pt'last); Clear(pt); return res; end Conservative_Lifting; function Lower_Lifting ( mic : Mixed_Cell; k : natural; point : Vector ) return integer is begin if Is_In(mic.pts(k),point) then return 0; else declare pt : Vector(point'range) := point; begin pt(pt'last) := 0; return Conservative_Lifting(mic,k,pt); end; end if; end Lower_Lifting; function Lower_Lifting ( mixsub : Mixed_Subdivision; k : natural; point : Vector ) return integer is lif : integer := point(point'last); tmp : Mixed_Subdivision := mixsub; max : integer := 0; begin while not Is_Null(tmp) loop lif := Lower_Lifting(Head_Of(tmp),k,point); if lif > max then max := lif; end if; exit when max = point(point'last); tmp := Tail_Of(tmp); end loop; return max; end Lower_Lifting; end Integer_Lifting_Utilities;