Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Stalift/integer_lifting_utilities.adb, Revision 1.1
1.1 ! maekawa 1: with Integer_Vectors_Utilities; use Integer_Vectors_Utilities;
! 2: -- with Power_Lists; use Power_Lists;
! 3:
! 4: package body Integer_Lifting_Utilities is
! 5:
! 6: function Adaptive_Lifting ( l : Array_of_Lists ) return Vector is
! 7:
! 8: res : Vector(l'range);
! 9: fac : constant natural := 3; -- multiplication factor
! 10: max : constant natural := 23; -- upper bound for lifting
! 11:
! 12: begin
! 13: for i in l'range loop
! 14: res(i) := fac*Length_Of(l(i));
! 15: if res(i) > max
! 16: then res(i) := max;
! 17: end if;
! 18: end loop;
! 19: return res;
! 20: end Adaptive_Lifting;
! 21:
! 22: -- function Select_Subsystem ( p : Laur_Sys; mix : Vector; mic : Mixed_Cell )
! 23: -- return Laur_Sys is
! 24: --
! 25: -- res : Laur_Sys(p'range);
! 26: -- cnt : natural := 0;
! 27: --
! 28: -- begin
! 29: -- for k in mix'range loop
! 30: -- for l in 1..mix(k) loop
! 31: -- cnt := cnt + 1;
! 32: -- res(cnt) := Select_Terms(p(cnt),mic.pts(k));
! 33: -- end loop;
! 34: -- end loop;
! 35: -- return res;
! 36: -- end Select_Subsystem;
! 37:
! 38: function Perform_Lifting ( n : natural; l : List; p : Poly ) return Poly is
! 39:
! 40: res : Poly := Null_Poly;
! 41: tmp : List := l;
! 42:
! 43: begin
! 44: while not Is_Null(tmp) loop
! 45: declare
! 46: d : Link_to_Vector := Head_Of(tmp);
! 47: dr : Link_to_Vector := Reduce(d,n+1);
! 48: t : Term;
! 49: begin
! 50: t.cf := Coeff(p,Degrees(dr));
! 51: t.dg := Degrees(d);
! 52: Add(res,t);
! 53: Clear(dr);
! 54: end;
! 55: tmp := Tail_Of(tmp);
! 56: end loop;
! 57: return res;
! 58: end Perform_Lifting;
! 59:
! 60: function Perform_Lifting
! 61: ( n : natural; mix : Vector; lifted : Array_of_Lists;
! 62: p : Laur_Sys ) return Laur_Sys is
! 63:
! 64: res : Laur_Sys(p'range);
! 65: cnt : natural := 1;
! 66:
! 67: begin
! 68: for k in mix'range loop
! 69: for l in 1..mix(k) loop
! 70: res(cnt) := Perform_Lifting(n,lifted(k),p(cnt));
! 71: cnt := cnt+1;
! 72: end loop;
! 73: end loop;
! 74: return res;
! 75: end Perform_Lifting;
! 76:
! 77: function Copy_Lifting ( lifted : List; pt : Link_to_Vector )
! 78: return Link_to_Vector is
! 79:
! 80: -- DESCRIPTION :
! 81: -- Searches the correspoinding point in the list lifted and returns
! 82: -- the lifted point. If the corresponding point has not been found,
! 83: -- then the original point pt will be returned.
! 84:
! 85: tmp : List := lifted;
! 86: lpt,res : Link_to_Vector;
! 87:
! 88: begin
! 89: while not Is_Null(tmp) loop
! 90: lpt := Head_Of(tmp);
! 91: if Equal(lpt(pt'range),pt.all)
! 92: then res := new Standard_Integer_Vectors.Vector'(lpt.all);
! 93: return res;
! 94: else tmp := Tail_Of(tmp);
! 95: end if;
! 96: end loop;
! 97: return pt;
! 98: end Copy_Lifting;
! 99:
! 100: function Copy_Lifting ( lifted,pts : List ) return List is
! 101:
! 102: -- DESCRIPTION :
! 103: -- Copies the lifting on the points lifted to the points in pts,
! 104: -- i.e., each point in pts will get the same lifting as the corresponding
! 105: -- lifted point in the list lifted.
! 106:
! 107: res : List;
! 108: tmp : List := pts;
! 109:
! 110: begin
! 111: while not Is_Null(tmp) loop
! 112: Construct(Copy_Lifting(lifted,Head_Of(tmp)),res);
! 113: tmp := Tail_Of(tmp);
! 114: end loop;
! 115: return res;
! 116: end Copy_Lifting;
! 117:
! 118: procedure Search_Lifting ( l : in List; pt : in Vector;
! 119: found : out boolean; lif : out integer ) is
! 120:
! 121: tmp : List := l;
! 122: lpt : Link_to_Vector;
! 123:
! 124: begin
! 125: found := false;
! 126: while not Is_Null(tmp) loop
! 127: lpt := Head_Of(tmp);
! 128: if Equal(lpt(pt'range),pt)
! 129: then found := true;
! 130: lif := lpt(lpt'last);
! 131: exit;
! 132: else tmp := Tail_Of(tmp);
! 133: end if;
! 134: end loop;
! 135: end Search_Lifting;
! 136:
! 137: function Search_and_Lift ( l : List; pt : Vector ) return Vector is
! 138:
! 139: tmp : List := l;
! 140: lpt : Link_to_Vector;
! 141:
! 142: begin
! 143: while not Is_Null(tmp) loop
! 144: lpt := Head_Of(tmp);
! 145: if Equal(lpt(pt'range),pt)
! 146: then return lpt.all;
! 147: else tmp := Tail_Of(tmp);
! 148: end if;
! 149: end loop;
! 150: return pt;
! 151: end Search_and_Lift;
! 152:
! 153: function Search_and_Lift ( mic : Mixed_Cell; k : natural; pt : Vector )
! 154: return Vector is
! 155: begin
! 156: return Search_and_Lift(mic.pts(k),pt);
! 157: end Search_and_Lift;
! 158:
! 159: function Induced_Lifting ( mixsub : Mixed_Subdivision; k : natural;
! 160: pt : Vector ) return Vector is
! 161:
! 162: tmp : Mixed_Subdivision := mixsub;
! 163: res : Vector(pt'first..pt'last+1);
! 164:
! 165: begin
! 166: while not Is_Null(tmp) loop
! 167: declare
! 168: mic : Mixed_Cell := Head_Of(tmp);
! 169: lpt : constant Vector := Search_and_Lift(mic,k,pt);
! 170: begin
! 171: if lpt'length = pt'length+1
! 172: then return lpt;
! 173: else tmp := Tail_Of(tmp);
! 174: end if;
! 175: end;
! 176: end loop;
! 177: res(pt'range) := pt;
! 178: res(res'last) := 1;
! 179: res(res'last) := Conservative_Lifting(mixsub,k,res);
! 180: return res;
! 181: end Induced_Lifting;
! 182:
! 183: function Induced_Lifting
! 184: ( n : natural; mix : Vector; points : Array_of_Lists;
! 185: mixsub : Mixed_Subdivision ) return Array_of_Lists is
! 186:
! 187: res,res_last : Array_of_Lists(mix'range);
! 188: cnt : natural := 1;
! 189: tmp : List;
! 190:
! 191: begin
! 192: for k in mix'range loop
! 193: res_last(k) := res(k);
! 194: tmp := points(cnt);
! 195: while not Is_Null(tmp) loop
! 196: declare
! 197: pt : Link_to_Vector := Head_Of(tmp);
! 198: lpt : constant Vector := Induced_Lifting(mixsub,k,pt.all);
! 199: begin
! 200: Append(res(k),res_last(k),lpt);
! 201: end;
! 202: tmp := Tail_Of(tmp);
! 203: end loop;
! 204: cnt := cnt + mix(k);
! 205: end loop;
! 206: return res;
! 207: end Induced_Lifting;
! 208:
! 209: procedure Constant_Lifting
! 210: ( l : in List; liftval : in natural;
! 211: lifted,lifted_last : in out List ) is
! 212:
! 213: tmp : List := l;
! 214: pt : Link_to_Vector;
! 215:
! 216: begin
! 217: while not Is_Null(tmp) loop
! 218: pt := Head_Of(tmp);
! 219: declare
! 220: lpt : Link_to_Vector := new Vector(pt'first..pt'last+1);
! 221: begin
! 222: lpt(pt'range) := pt.all;
! 223: lpt(lpt'last) := liftval;
! 224: Append(lifted,lifted_last,lpt);
! 225: end;
! 226: tmp := Tail_Of(tmp);
! 227: end loop;
! 228: end Constant_Lifting;
! 229:
! 230: procedure Constant_Lifting
! 231: ( al : in Array_of_Lists; liftval : in natural;
! 232: lifted,lifted_last : in out Array_of_Lists ) is
! 233: begin
! 234: for i in al'range loop
! 235: Constant_Lifting(al(i),liftval,lifted(i),lifted_last(i));
! 236: end loop;
! 237: end Constant_Lifting;
! 238:
! 239: function Conservative_Lifting
! 240: ( mic : Mixed_Cell; k : natural; point : Vector )
! 241: return integer is
! 242:
! 243: sp : integer := mic.nor*Head_Of(mic.pts(k));
! 244: spp : integer := mic.nor.all*point;
! 245: res : integer;
! 246:
! 247: begin
! 248: if sp < spp
! 249: then return point(point'last);
! 250: else if mic.nor(mic.nor'last) = 0
! 251: then res := point(point'last);
! 252: else spp := spp - point(point'last)*mic.nor(mic.nor'last);
! 253: res := (sp - spp)/mic.nor(mic.nor'last) + 1;
! 254: end if;
! 255: return res;
! 256: end if;
! 257: end Conservative_Lifting;
! 258:
! 259: function Conservative_Lifting ( mixsub : Mixed_Subdivision; k : natural;
! 260: point : Vector ) return integer is
! 261:
! 262: tmp : Mixed_Subdivision := mixsub;
! 263: pt : Vector(point'range) := point;
! 264: res : integer;
! 265:
! 266: begin
! 267: while not Is_Null(tmp) loop
! 268: pt(pt'last) := Conservative_Lifting(Head_Of(tmp),k,pt);
! 269: tmp := Tail_Of(tmp);
! 270: end loop;
! 271: res := pt(pt'last);
! 272: Clear(pt);
! 273: return res;
! 274: end Conservative_Lifting;
! 275:
! 276: function Lower_Lifting ( mic : Mixed_Cell; k : natural; point : Vector )
! 277: return integer is
! 278: begin
! 279: if Is_In(mic.pts(k),point)
! 280: then return 0;
! 281: else declare
! 282: pt : Vector(point'range) := point;
! 283: begin
! 284: pt(pt'last) := 0;
! 285: return Conservative_Lifting(mic,k,pt);
! 286: end;
! 287: end if;
! 288: end Lower_Lifting;
! 289:
! 290: function Lower_Lifting ( mixsub : Mixed_Subdivision; k : natural;
! 291: point : Vector ) return integer is
! 292:
! 293: lif : integer := point(point'last);
! 294: tmp : Mixed_Subdivision := mixsub;
! 295: max : integer := 0;
! 296:
! 297: begin
! 298: while not Is_Null(tmp) loop
! 299: lif := Lower_Lifting(Head_Of(tmp),k,point);
! 300: if lif > max
! 301: then max := lif;
! 302: end if;
! 303: exit when max = point(point'last);
! 304: tmp := Tail_Of(tmp);
! 305: end loop;
! 306: return max;
! 307: end Lower_Lifting;
! 308:
! 309: end Integer_Lifting_Utilities;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to integer_lifting_utilities.adb CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / PHC / Ada / Root_Counts / Stalift