Annotation of OpenXM_contrib/PHC/Ada/Schubert/bracket_polynomials.adb, Revision 1.1
1.1 ! maekawa 1: package body Bracket_Polynomials is
! 2:
! 3: -- CONSTRUCTORS :
! 4:
! 5: function Create ( m : Bracket_Monomial ) return Bracket_Polynomial is
! 6:
! 7: t : Bracket_Term;
! 8:
! 9: begin
! 10: t.coeff := Create(1.0);
! 11: t.monom := m;
! 12: return Create(t);
! 13: end Create;
! 14:
! 15: function Create ( t : Bracket_Term ) return Bracket_Polynomial is
! 16:
! 17: p : Bracket_Polynomial;
! 18:
! 19: begin
! 20: Construct(t,p);
! 21: return p;
! 22: end Create;
! 23:
! 24: procedure Copy ( t1 : in Bracket_Term; t2 : in out Bracket_Term ) is
! 25: begin
! 26: t2.coeff := t1.coeff;
! 27: Copy(t1.monom,t2.monom);
! 28: end Copy;
! 29:
! 30: procedure Copy ( p : in Bracket_Polynomial; q : in out Bracket_Polynomial ) is
! 31:
! 32: tmp : Bracket_Polynomial := p;
! 33:
! 34: begin
! 35: Clear(q);
! 36: while not Is_Null(tmp) loop
! 37: Add(q,Head_Of(tmp));
! 38: end loop;
! 39: end Copy;
! 40:
! 41: -- COMPARISON OPERATIONS :
! 42:
! 43: function Is_Equal ( t1,t2 : Bracket_Term ) return boolean is
! 44: begin
! 45: return (t1.coeff = t2.coeff and then Is_Equal(t1.monom,t2.monom));
! 46: end Is_Equal;
! 47:
! 48: function Is_Equal ( p,q : Bracket_Polynomial ) return boolean is
! 49:
! 50: tmp1 : Bracket_Polynomial := p;
! 51: tmp2 : Bracket_Polynomial := q;
! 52:
! 53: begin
! 54: while not Is_Null(tmp1) and not Is_Null(tmp2) loop
! 55: if not Is_Equal(Head_Of(tmp1),Head_Of(tmp2))
! 56: then return false;
! 57: else tmp1 := Tail_Of(tmp1); tmp2 := Tail_Of(tmp2);
! 58: end if;
! 59: end loop;
! 60: if Is_Null(tmp1) and Is_Null(tmp2)
! 61: then return true;
! 62: else return false;
! 63: end if;
! 64: end Is_Equal;
! 65:
! 66: function "<" ( t1,t2 : Bracket_Term ) return boolean is
! 67: begin
! 68: return t1.monom < t2.monom;
! 69: end "<";
! 70:
! 71: function ">" ( t1,t2 : Bracket_Term ) return boolean is
! 72: begin
! 73: return t1.monom > t2.monom;
! 74: end ">";
! 75:
! 76: -- ARITHMETIC OPERATIONS :
! 77:
! 78: function "+" ( t : Bracket_Term; p : Bracket_Polynomial )
! 79: return Bracket_Polynomial is
! 80:
! 81: res : Bracket_Polynomial;
! 82:
! 83: begin
! 84: Copy(p,res);
! 85: Add(res,t);
! 86: return res;
! 87: end "+";
! 88:
! 89: function "+" ( p : Bracket_Polynomial; t : Bracket_Term )
! 90: return Bracket_Polynomial is
! 91:
! 92: res : Bracket_Polynomial;
! 93:
! 94: begin
! 95: Copy(p,res);
! 96: Add(res,t);
! 97: return res;
! 98: end "+";
! 99:
! 100: procedure Add ( p : in out Bracket_Polynomial; t : in Bracket_Term ) is
! 101:
! 102: tt : Bracket_Term;
! 103:
! 104: begin
! 105: Copy(t,tt);
! 106: if Is_Null(p)
! 107: then p := Create(tt);
! 108: else declare
! 109: first,second : Bracket_Polynomial;
! 110: t1,t2 : Bracket_Term;
! 111: begin
! 112: first := p; second := Tail_Of(p);
! 113: t1 := Head_Of(first);
! 114: if t > t1
! 115: then Construct(tt,p);
! 116: elsif Is_Equal(t.monom,t1.monom)
! 117: then t1.coeff := t1.coeff + t.coeff;
! 118: if t1.coeff = Create(0.0)
! 119: then Clear(t1);
! 120: p := Tail_Of(p);
! 121: else Set_Head(p,t1);
! 122: end if;
! 123: else while not Is_Null(second) loop -- merge term in list
! 124: t1 := Head_Of(second);
! 125: if t > t1
! 126: then Construct(tt,second);
! 127: Swap_Tail(first,second);
! 128: exit;
! 129: elsif Is_Equal(t.monom,t1.monom)
! 130: then t1.coeff := t1.coeff + t.coeff;
! 131: if t1.coeff = Create(0.0)
! 132: then Clear(t1);
! 133: Swap_Tail(first,second);
! 134: else Set_Head(second,t1);
! 135: end if;
! 136: exit;
! 137: end if;
! 138: first := Tail_Of(first);
! 139: second := Tail_Of(second);
! 140: end loop;
! 141: if Is_Null(second) -- then first points to last
! 142: then Append(p,first,tt); -- element of the list p
! 143: end if;
! 144: end if;
! 145: end;
! 146: end if;
! 147: end Add;
! 148:
! 149: procedure Frontal_Add ( p : in out Bracket_Polynomial;
! 150: t : in Bracket_Term ) is
! 151:
! 152: tt : Bracket_Term;
! 153:
! 154: begin
! 155: Copy(t,tt);
! 156: Construct(tt,p);
! 157: end Frontal_Add;
! 158:
! 159: procedure Frontal_Min ( p : in out Bracket_Polynomial;
! 160: t : in Bracket_Term ) is
! 161:
! 162: mt : Bracket_Term := -t;
! 163:
! 164: begin
! 165: Construct(mt,p);
! 166: end Frontal_Min;
! 167:
! 168: function "+" ( p,q : Bracket_Polynomial ) return Bracket_Polynomial is
! 169:
! 170: res : Bracket_Polynomial;
! 171:
! 172: begin
! 173: Copy(p,res);
! 174: Add(res,q);
! 175: return res;
! 176: end "+";
! 177:
! 178: procedure Add ( p : in out Bracket_Polynomial; q : in Bracket_Polynomial ) is
! 179:
! 180: tmp : Bracket_Polynomial := q;
! 181:
! 182: begin
! 183: while not Is_Null(tmp) loop
! 184: Add(p,Head_Of(tmp));
! 185: tmp := Tail_Of(tmp);
! 186: end loop;
! 187: end Add;
! 188:
! 189: function "-" ( t : Bracket_Term ) return Bracket_Term is
! 190:
! 191: res : Bracket_Term;
! 192:
! 193: begin
! 194: Copy(t.monom,res.monom);
! 195: res.coeff := -t.coeff;
! 196: return res;
! 197: end "-";
! 198:
! 199: procedure Min ( t : in out Bracket_Term ) is
! 200: begin
! 201: t.coeff := -t.coeff;
! 202: end Min;
! 203:
! 204: function "-" ( p : Bracket_Polynomial ) return Bracket_Polynomial is
! 205:
! 206: res : Bracket_Polynomial;
! 207:
! 208: begin
! 209: Copy(p,res);
! 210: Min(res);
! 211: return res;
! 212: end "-";
! 213:
! 214: procedure Min ( p : in out Bracket_Polynomial ) is
! 215:
! 216: tmp : Bracket_Polynomial := p;
! 217:
! 218: begin
! 219: while not Is_Null(tmp) loop
! 220: declare
! 221: bt : Bracket_Term := Head_Of(tmp);
! 222: begin
! 223: Min(bt);
! 224: Set_Head(tmp,bt);
! 225: end;
! 226: tmp := Tail_Of(tmp);
! 227: end loop;
! 228: end Min;
! 229:
! 230: function "-" ( t : Bracket_Term; p : Bracket_Polynomial )
! 231: return Bracket_Polynomial is
! 232:
! 233: mp : Bracket_Polynomial := -p;
! 234: res : Bracket_Polynomial := t+mp;
! 235:
! 236: begin
! 237: Clear(mp);
! 238: return res;
! 239: end "-";
! 240:
! 241: function "-" ( p : Bracket_Polynomial; t : Bracket_Term )
! 242: return Bracket_Polynomial is
! 243:
! 244: mt : Bracket_Term := -t;
! 245: res : Bracket_Polynomial := p+mt;
! 246:
! 247: begin
! 248: Clear(mt);
! 249: return res;
! 250: end "-";
! 251:
! 252: procedure Min ( p : in out Bracket_Polynomial; t : in Bracket_Term ) is
! 253:
! 254: mt : Bracket_Term := -t;
! 255:
! 256: begin
! 257: Add(p,mt);
! 258: end Min;
! 259:
! 260: function "-" ( p,q : Bracket_Polynomial ) return Bracket_Polynomial is
! 261:
! 262: mq : Bracket_Polynomial := -q;
! 263: res : Bracket_Polynomial := p+mq;
! 264:
! 265: begin
! 266: Clear(mq);
! 267: return res;
! 268: end "-";
! 269:
! 270: procedure Min ( p : in out Bracket_Polynomial; q : in Bracket_Polynomial ) is
! 271:
! 272: mq : Bracket_Polynomial := -q;
! 273:
! 274: begin
! 275: Add(p,mq);
! 276: end Min;
! 277:
! 278: -- ITERATORS OVER MONOMIALS :
! 279:
! 280: function Number_of_Monomials ( p : Bracket_Polynomial ) return natural is
! 281: begin
! 282: return Length_Of(p);
! 283: end Number_of_Monomials;
! 284:
! 285: procedure Enumerate_Terms ( p : in Bracket_Polynomial ) is
! 286:
! 287: tmp : Bracket_Polynomial := p;
! 288: continue : boolean := true;
! 289:
! 290: begin
! 291: while not Is_Null(tmp) loop
! 292: Process(Head_Of(tmp),continue);
! 293: exit when not continue;
! 294: tmp := Tail_Of(tmp);
! 295: end loop;
! 296: end Enumerate_Terms;
! 297:
! 298: -- DESTRUCTOR :
! 299:
! 300: procedure Clear ( t : in out Bracket_Term ) is
! 301: begin
! 302: Clear(t.monom);
! 303: end Clear;
! 304:
! 305: procedure Clear ( p : in out Bracket_Polynomial ) is
! 306:
! 307: tmp : Bracket_Polynomial := p;
! 308:
! 309: begin
! 310: while not Is_Null(tmp) loop
! 311: declare
! 312: t : Bracket_Term := Head_Of(tmp);
! 313: begin
! 314: Clear(t);
! 315: end;
! 316: tmp := Tail_Of(tmp);
! 317: end loop;
! 318: Lists_of_Bracket_Terms.Clear(Lists_of_Bracket_Terms.List(p));
! 319: end Clear;
! 320:
! 321: end Bracket_Polynomials;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to bracket_polynomials.adb CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / PHC / Ada / Schubert