Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Implift/transforming_laurent_systems.adb, Revision 1.1
1.1 ! maekawa 1: with Standard_Complex_Numbers; use Standard_Complex_Numbers;
! 2: with Integer_Vectors_Utilities; use Integer_Vectors_Utilities;
! 3:
! 4: package body Transforming_Laurent_Systems is
! 5:
! 6: function Initial_Link_to_Vector ( p : Poly ) return Link_to_Vector is
! 7:
! 8: -- DESCRIPTION :
! 9: -- Returns the initial degrees of the polynomial p.
! 10:
! 11: init : Link_to_Vector;
! 12:
! 13: procedure Init_Term ( t : in Term; cont : out boolean ) is
! 14: begin
! 15: init := new Standard_Integer_Vectors.Vector'(t.dg.all);
! 16: cont := false;
! 17: end Init_Term;
! 18: procedure Initial_Term is new Visiting_Iterator (Init_Term);
! 19:
! 20: begin
! 21: Initial_Term(p);
! 22: return init;
! 23: end Initial_Link_to_Vector;
! 24:
! 25: procedure Shift ( p : in out Poly ) is
! 26:
! 27: init : Link_to_Vector := Initial_Link_to_Vector(p);
! 28:
! 29: procedure Shift_Term ( t : in out Term; cont : out boolean ) is
! 30: begin
! 31: Sub(Link_to_Vector(t.dg),init);
! 32: cont := true;
! 33: end Shift_Term;
! 34: procedure Shift_Terms is new Changing_Iterator (Shift_Term);
! 35:
! 36: begin
! 37: if p /= Null_Poly
! 38: then Shift_Terms(p);
! 39: end if;
! 40: Clear(init);
! 41: end Shift;
! 42:
! 43: function Shift ( p : Poly ) return Poly is
! 44:
! 45: res : Poly := Null_Poly;
! 46: init : Link_to_Vector := Initial_Link_to_Vector(p);
! 47:
! 48: procedure Shift_Term ( t : in Term; cont : out boolean ) is
! 49: rt : Term;
! 50: begin
! 51: rt.cf := t.cf;
! 52: rt.dg := t.dg - Degrees(init);
! 53: Add(res,rt);
! 54: Clear(rt);
! 55: cont := true;
! 56: end Shift_Term;
! 57: procedure Shift_Terms is new Visiting_Iterator (Shift_Term);
! 58:
! 59: begin
! 60: if p /= Null_Poly
! 61: then Shift_Terms(p);
! 62: end if;
! 63: Clear(init);
! 64: return res;
! 65: end Shift;
! 66:
! 67: procedure Shift ( l : in out Laur_Sys ) is
! 68: begin
! 69: for k in l'range loop
! 70: Shift(l(k));
! 71: end loop;
! 72: end Shift;
! 73:
! 74: function Shift ( l : Laur_Sys ) return Laur_Sys is
! 75:
! 76: res : Laur_Sys (l'range);
! 77:
! 78: begin
! 79: for k in l'range loop
! 80: res(k) := Shift(l(k));
! 81: end loop;
! 82: return res;
! 83: end Shift;
! 84:
! 85: procedure Transform ( t : in Transfo; p : in out Poly ) is
! 86:
! 87: procedure Transform_Term ( tt : in out Term; cont : out boolean ) is
! 88: begin
! 89: Apply(t,Link_to_Vector(tt.dg));
! 90: cont := true;
! 91: end Transform_Term;
! 92: procedure Transform_Terms is new Changing_Iterator (Transform_Term);
! 93:
! 94: begin
! 95: Transform_Terms(p);
! 96: end Transform;
! 97:
! 98: function Transform ( t : Transfo; p : Poly ) return Poly is
! 99:
! 100: res : Poly;
! 101:
! 102: begin
! 103: Copy(p,res);
! 104: Transform(t,res);
! 105: return res;
! 106: end Transform;
! 107:
! 108: function Transform2 ( t : Transfo; p : Poly ) return Poly is
! 109:
! 110: -- IMPORTANT : This function might change the term order !
! 111:
! 112: res : Poly := Null_Poly;
! 113:
! 114: procedure Transform_Term ( tt : in Term; cont : out boolean ) is
! 115: rt : Term;
! 116: begin
! 117: rt.cf := tt.cf;
! 118: rt.dg := Degrees(t*Link_to_Vector(tt.dg));
! 119: Add(res,rt);
! 120: Clear(rt);
! 121: cont := true;
! 122: end Transform_Term;
! 123: procedure Transform_Terms is new Visiting_Iterator (Transform_Term);
! 124:
! 125: begin
! 126: Transform_Terms(p);
! 127: return res;
! 128: end Transform2;
! 129:
! 130: procedure Transform ( t : in Transfo; l : in out Laur_Sys ) is
! 131: begin
! 132: for i in l'range loop
! 133: Transform(t,l(i));
! 134: end loop;
! 135: end Transform;
! 136:
! 137: function Transform ( t : Transfo; l : Laur_Sys ) return Laur_Sys is
! 138:
! 139: res : Laur_Sys(l'range);
! 140:
! 141: begin
! 142: for i in l'range loop
! 143: res(i) := Transform(t,l(i));
! 144: end loop;
! 145: return res;
! 146: end Transform;
! 147:
! 148: function Maximal_Support ( p : Poly; v : Vector ) return integer is
! 149:
! 150: res : integer;
! 151: first : boolean := true;
! 152:
! 153: procedure Scan_Term ( t : in Term; cont : out boolean ) is
! 154:
! 155: sp : integer := t.dg.all*v;
! 156:
! 157: begin
! 158: if first
! 159: then res := sp; first := false;
! 160: elsif sp > res
! 161: then res := sp;
! 162: end if;
! 163: cont := true;
! 164: end Scan_Term;
! 165: procedure Scan_Terms is new Visiting_Iterator (Scan_Term);
! 166:
! 167: begin
! 168: Scan_Terms(p);
! 169: return res;
! 170: end Maximal_Support;
! 171:
! 172: function Maximal_Support ( p : Poly; v : Link_to_Vector ) return integer is
! 173: begin
! 174: return Maximal_Support(p,v.all);
! 175: end Maximal_Support;
! 176:
! 177: procedure Face ( i,m : in integer; p : in out Poly ) is
! 178:
! 179: procedure Face_Term ( t : in out Term; cont : out boolean ) is
! 180: begin
! 181: if t.dg(i) /= m
! 182: then t.cf := Create(0.0);
! 183: end if;
! 184: cont := true;
! 185: end Face_Term;
! 186: procedure Face_Terms is new Changing_Iterator(Face_Term);
! 187:
! 188: begin
! 189: Face_Terms(p);
! 190: end Face;
! 191:
! 192: function Face ( i,m : integer; p : Poly ) return Poly is
! 193:
! 194: res : Poly;
! 195:
! 196: begin
! 197: Copy(p,res);
! 198: Face(i,m,res);
! 199: return res;
! 200: end Face;
! 201:
! 202: function Face2 ( i,m : integer; p : Poly ) return Poly is
! 203:
! 204: -- IMPORTANT : This function might change the term order !
! 205:
! 206: res : Poly := Null_Poly;
! 207:
! 208: procedure Face_Term ( t : in Term; cont : out boolean ) is
! 209: begin
! 210: if t.dg(i) = m
! 211: then Add(res,t);
! 212: end if;
! 213: cont := true;
! 214: end Face_Term;
! 215: procedure Face_Terms is new Visiting_Iterator(Face_Term);
! 216:
! 217: begin
! 218: Face_Terms(p);
! 219: return res;
! 220: end Face2;
! 221:
! 222: procedure Face ( i,m : in integer; l : in out Laur_Sys ) is
! 223: begin
! 224: for j in l'range loop
! 225: Face(i,m,l(j));
! 226: end loop;
! 227: end Face;
! 228:
! 229: function Face ( i,m : integer; l : Laur_Sys ) return Laur_Sys is
! 230:
! 231: res : Laur_Sys(l'range);
! 232:
! 233: begin
! 234: for j in l'range loop
! 235: res(j) := Face(i,m,l(j));
! 236: end loop;
! 237: return res;
! 238: end Face;
! 239:
! 240: procedure Face ( v : in Vector; m : in integer; p : in out Poly ) is
! 241:
! 242: procedure Face_Term ( t : in out Term; cont : out boolean ) is
! 243: begin
! 244: if t.dg.all*v /= m
! 245: then t.cf := Create(0.0);
! 246: end if;
! 247: cont := true;
! 248: end Face_Term;
! 249: procedure Face_Terms is new Changing_Iterator(Face_Term);
! 250:
! 251: begin
! 252: Face_Terms(p);
! 253: end Face;
! 254:
! 255: function Face ( v : Vector; m : integer; p : Poly ) return Poly is
! 256:
! 257: res : Poly;
! 258:
! 259: begin
! 260: Copy(p,res);
! 261: Face(v,m,res);
! 262: return res;
! 263: end Face;
! 264:
! 265: function Face2 ( v : Vector; m : integer; p : Poly ) return Poly is
! 266:
! 267: -- IMPORTANT : This procedure might change the term order !
! 268:
! 269: res : Poly := Null_Poly;
! 270:
! 271: procedure Face_Term ( t : in Term; cont : out boolean ) is
! 272: begin
! 273: if t.dg.all*v = m
! 274: then Add(res,t);
! 275: end if;
! 276: cont := true;
! 277: end Face_Term;
! 278: procedure Face_Terms is new Visiting_Iterator(Face_Term);
! 279:
! 280: begin
! 281: Face_Terms(p);
! 282: return res;
! 283: end Face2;
! 284:
! 285: procedure Face ( v,m : in Vector; l : in out Laur_Sys ) is
! 286: begin
! 287: for i in l'range loop
! 288: Face(v,m(i),l(i));
! 289: end loop;
! 290: end Face;
! 291:
! 292: function Face ( v,m : Vector; l : Laur_Sys ) return Laur_Sys is
! 293:
! 294: res : Laur_Sys(l'range);
! 295:
! 296: begin
! 297: for i in l'range loop
! 298: res(i) := Face(v,m(i),l(i));
! 299: end loop;
! 300: return res;
! 301: end Face;
! 302:
! 303: procedure Reduce ( i : in integer; p : in out Poly ) is
! 304:
! 305: procedure Reduce_Term ( t : in out Term; cont : out boolean ) is
! 306: begin
! 307: Reduce(Link_to_Vector(t.dg),i);
! 308: cont := true;
! 309: end Reduce_Term;
! 310: procedure Reduce_Terms is new Changing_Iterator (Reduce_Term);
! 311:
! 312: begin
! 313: Reduce_Terms(p);
! 314: end Reduce;
! 315:
! 316: function Reduce ( i : integer; p : Poly ) return Poly is
! 317: res : Poly;
! 318: begin
! 319: Copy(p,res);
! 320: Reduce(i,res);
! 321: return res;
! 322: end Reduce;
! 323:
! 324: function Reduce2 ( i : integer; p : Poly ) return Poly is
! 325:
! 326: -- IMPORTANT : This function might change the term order !
! 327:
! 328: res : Poly := Null_Poly;
! 329:
! 330: procedure Reduce_Term ( t : in Term; cont : out boolean ) is
! 331: rt : Term;
! 332: begin
! 333: rt.cf := t.cf;
! 334: rt.dg := Degrees(Reduce(Link_to_Vector(t.dg),i));
! 335: Add(res,rt);
! 336: Clear(rt);
! 337: cont := true;
! 338: end Reduce_Term;
! 339: procedure Reduce_Terms is new Visiting_Iterator (Reduce_Term);
! 340:
! 341: begin
! 342: Reduce_Terms(p);
! 343: return res;
! 344: end Reduce2;
! 345:
! 346: procedure Reduce ( i : in integer; l : in out Laur_Sys ) is
! 347: begin
! 348: for j in l'range loop
! 349: Reduce(i,l(j));
! 350: end loop;
! 351: end Reduce;
! 352:
! 353: function Reduce ( i : integer; l : Laur_Sys ) return Laur_Sys is
! 354: res : Laur_Sys(l'range);
! 355: begin
! 356: for j in l'range loop
! 357: res(j) := Reduce(i,l(j));
! 358: end loop;
! 359: return res;
! 360: end Reduce;
! 361:
! 362: procedure Insert ( i,d : in integer; p : in out Poly ) is
! 363:
! 364: procedure Insert_Term ( t : in out Term; cont : out boolean ) is
! 365: begin
! 366: Insert(Link_to_Vector(t.dg),i,d);
! 367: cont := true;
! 368: end Insert_Term;
! 369: procedure Insert_Terms is new Changing_Iterator (Insert_Term);
! 370:
! 371: begin
! 372: Insert_Terms(p);
! 373: end Insert;
! 374:
! 375: function Insert ( i,d : integer; p : Poly ) return Poly is
! 376: res : Poly;
! 377: begin
! 378: Copy(p,res);
! 379: Insert(i,d,res);
! 380: return res;
! 381: end Insert;
! 382:
! 383: function Insert2 ( i,d : integer; p : Poly ) return Poly is
! 384:
! 385: -- IMPORTANT : This function might change the term order !
! 386:
! 387: res : Poly := Null_Poly;
! 388:
! 389: procedure Insert_Term ( t : in Term; cont : out boolean ) is
! 390: rt : Term;
! 391: begin
! 392: rt.cf := t.cf;
! 393: rt.dg := Degrees(Insert(Link_to_Vector(t.dg),i,d));
! 394: Add(res,rt);
! 395: Clear(rt);
! 396: cont := true;
! 397: end Insert_Term;
! 398: procedure Insert_Terms is new Visiting_Iterator (Insert_Term);
! 399:
! 400: begin
! 401: Insert_Terms(p);
! 402: return res;
! 403: end Insert2;
! 404:
! 405: procedure Insert ( i,d : in integer; l : in out Laur_Sys ) is
! 406: begin
! 407: for j in l'range loop
! 408: Insert(i,d,l(j));
! 409: end loop;
! 410: end Insert;
! 411:
! 412: function Insert ( i,d : integer; l : Laur_Sys ) return Laur_Sys is
! 413: res : Laur_Sys(l'range);
! 414: begin
! 415: for j in l'range loop
! 416: res(j) := Insert(i,d,l(j));
! 417: end loop;
! 418: return res;
! 419: end Insert;
! 420:
! 421: end Transforming_Laurent_Systems;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to transforming_laurent_systems.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 / Implift