![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to bracket_monomials.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|
Return to bracket_monomials.adb CVS log | Up to [local] / OpenXM_contrib / PHC / Ada / Schubert |
1.1 maekawa 1: package body Bracket_Monomials is
2:
3: -- INTERNAL SORTING ROUTINE TO MAINTAIN ORDER :
4:
5: procedure Swap_Heads ( bm1,bm2 : in out Bracket_Monomial;
6: lb1,lb2 : in out Link_to_Bracket ) is
7:
8: b1 : Bracket(lb1'range) := lb1.all;
9: b2 : Bracket(lb2'range) := lb2.all;
10:
11: begin
12: Clear(lb2); lb2 := new Bracket'(b1);
13: Clear(lb1); lb1 := new Bracket'(b2);
14: Set_Head(bm1,lb1);
15: Set_Head(bm2,lb2);
16: end Swap_Heads;
17:
18: procedure Sort ( bm : in out Bracket_Monomial ) is
19:
20: tmp1 : Bracket_Monomial := bm;
21:
22: begin
23: while not Is_Null(tmp1) loop
24: declare
25: lb1 : Link_to_Bracket := Head_Of(tmp1);
26: min : Link_to_Bracket := lb1;
27: mintmp : Bracket_Monomial := tmp1;
28: tmp2 : Bracket_Monomial := Tail_Of(tmp1);
29: begin
30: while not Is_Null(tmp2) loop
31: if Head_Of(tmp2).all < min.all
32: then min := Head_Of(tmp2);
33: mintmp := tmp2;
34: end if;
35: tmp2 := Tail_Of(tmp2);
36: end loop;
37: if not Is_Equal(lb1.all,min.all)
38: then Swap_Heads(tmp1,mintmp,lb1,min);
39: end if;
40: end;
41: tmp1 := Tail_Of(tmp1);
42: end loop;
43: end Sort;
44:
45: -- CONSTRUCTORS :
46:
47: function Create ( b : Bracket ) return Bracket_Monomial is
48:
49: bm : Bracket_Monomial;
50: lb : Link_to_Bracket := new Bracket'(b);
51:
52: begin
53: Construct(lb,bm);
54: return bm;
55: end Create;
56:
57: procedure Multiply ( bm : in out Bracket_Monomial; b : in Bracket ) is
58: begin
59: if Is_Null(bm)
60: then bm := Create(b);
61: else declare
62: lb : Link_to_Bracket := new Bracket'(b);
63: begin
64: Construct(lb,bm);
65: Sort(bm);
66: end;
67: end if;
68: end Multiply;
69:
70: procedure Copy ( bm1 : in Bracket_Monomial;
71: bm2 : in out Bracket_Monomial ) is
72:
73: tmp : Bracket_Monomial := bm1;
74:
75: begin
76: Clear(bm2);
77: while not Is_Null(tmp) loop
78: declare
79: b : constant Bracket := Head_Of(tmp).all;
80: begin
81: Multiply(bm2,b);
82: end;
83: tmp := Tail_Of(tmp);
84: end loop;
85: end Copy;
86:
87: -- OPERATIONS :
88:
89: function "*" ( b1,b2 : Bracket ) return Bracket_Monomial is
90:
91: bm : Bracket_Monomial := Create(b1);
92:
93: begin
94: Multiply(bm,b2);
95: return bm;
96: end "*";
97:
98: function "*" ( bm : Bracket_Monomial; b : Bracket )
99: return Bracket_Monomial is
100:
101: res : Bracket_Monomial;
102:
103: begin
104: Copy(bm,res);
105: Multiply(res,b);
106: return res;
107: end "*";
108:
109: function "*" ( b : Bracket; bm : Bracket_Monomial )
110: return Bracket_Monomial is
111:
112: res : Bracket_Monomial;
113:
114: begin
115: Copy(bm,res);
116: Multiply(res,b);
117: return res;
118: end "*";
119:
120: function "*" ( bm1,bm2 : Bracket_Monomial ) return Bracket_Monomial is
121:
122: res : Bracket_Monomial;
123:
124: begin
125: Copy(bm1,res);
126: Multiply(res,bm2);
127: return res;
128: end "*";
129:
130: procedure Multiply ( bm1 : in out Bracket_Monomial;
131: bm2 : in Bracket_Monomial ) is
132:
133: tmp : Bracket_Monomial := bm2;
134:
135: begin
136: while not Is_Null(tmp) loop
137: declare
138: b : constant Bracket := Head_Of(tmp).all;
139: begin
140: Multiply(bm1,b);
141: end;
142: tmp := Tail_Of(tmp);
143: end loop;
144: end Multiply;
145:
146: function Is_Equal ( bm1,bm2 : Bracket_Monomial ) return boolean is
147:
148: tmp1 : Bracket_Monomial := bm1;
149: tmp2 : Bracket_Monomial := bm2;
150:
151: begin
152: if Length_Of(tmp1) /= Length_Of(tmp2)
153: then return false;
154: else while not Is_Null(tmp1) loop
155: if not Is_Equal(Head_Of(tmp1).all,Head_Of(tmp2).all)
156: then return false;
157: else tmp1 := Tail_Of(tmp1);
158: tmp2 := Tail_Of(tmp2);
159: end if;
160: end loop;
161: return true;
162: end if;
163: end Is_Equal;
164:
165: function "<" ( bm1,bm2 : Bracket_Monomial ) return boolean is
166:
167: tmp1 : Bracket_Monomial := bm1;
168: tmp2 : Bracket_Monomial := bm2;
169: lb1,lb2 : Link_to_Bracket;
170:
171: begin
172: while not Is_Null(tmp1) and not Is_Null(tmp2) loop
173: lb1 := Head_Of(tmp1); lb2 := Head_Of(tmp2);
174: if lb1.all < lb2.all
175: then return true;
176: elsif lb1.all > lb2.all
177: then return false;
178: else tmp1 := Tail_Of(tmp1); tmp2 := Tail_Of(tmp2);
179: end if;
180: end loop;
181: if Is_Null(tmp1) and not Is_Null(tmp2)
182: then return true;
183: else return false;
184: end if;
185: end "<";
186:
187: function ">" ( bm1,bm2 : Bracket_Monomial ) return boolean is
188:
189: tmp1 : Bracket_Monomial := bm1;
190: tmp2 : Bracket_Monomial := bm2;
191: lb1,lb2 : Link_to_Bracket;
192:
193: begin
194: while not Is_Null(tmp1) and not Is_Null(tmp2) loop
195: lb1 := Head_Of(tmp1); lb2 := Head_Of(tmp2);
196: if lb1.all > lb2.all
197: then return true;
198: elsif lb1.all < lb2.all
199: then return false;
200: else tmp1 := Tail_Of(tmp1); tmp2 := Tail_Of(tmp2);
201: end if;
202: end loop;
203: if Is_Null(tmp2) and not Is_Null(tmp1)
204: then return true;
205: else return false;
206: end if;
207: end ">";
208:
209: function Divisible ( bm : Bracket_Monomial; b : Bracket ) return boolean is
210:
211: tmp : Bracket_Monomial := bm;
212:
213: begin
214: while not Is_Null(tmp) loop
215: if Is_Equal(Head_Of(tmp).all,b)
216: then return true;
217: else tmp := Tail_Of(tmp);
218: end if;
219: end loop;
220: return false;
221: end Divisible;
222:
223: -- ITERATORS OVER THE BRACKETS :
224:
225: function Number_of_Brackets ( bm : Bracket_Monomial ) return natural is
226: begin
227: return Length_Of(bm);
228: end Number_of_Brackets;
229:
230: procedure Enumerate_Brackets ( bm : in Bracket_Monomial ) is
231:
232: tmp : Bracket_Monomial := bm;
233: continue : boolean := true;
234:
235: begin
236: while not Is_Null(tmp) loop
237: Process(Head_Of(tmp).all,continue);
238: exit when not continue;
239: tmp := Tail_Of(tmp);
240: end loop;
241: end Enumerate_Brackets;
242:
243: -- DESTRUCTOR :
244:
245: procedure Clear ( bm : in out Bracket_Monomial ) is
246:
247: tmp : Bracket_Monomial := bm;
248: lb : Link_to_Bracket;
249:
250: begin
251: while not Is_Null(tmp) loop
252: lb := Head_Of(tmp);
253: Clear(lb);
254: tmp := Tail_Of(tmp);
255: end loop;
256: Lists_of_Brackets.Clear(Lists_of_Brackets.List(bm));
257: end Clear;
258:
259: end Bracket_Monomials;