Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Symmetry/linear_symmetric_reduction.adb, Revision 1.1.1.1
1.1 maekawa 1: with Standard_Integer_Vectors; use Standard_Integer_Vectors;
2: with Standard_Complex_Vectors;
3: with Permutations,Permute_Operations; use Permutations,Permute_Operations;
4: with Random_Product_System;
5:
6: package body Linear_Symmetric_Reduction is
7:
8: -- AUXILIARY DATA STRUCTURE AND OPERATIONS :
9:
10: type Lin_Sys is array(integer range <>)
11: of Standard_Complex_Vectors.Link_to_Vector;
12:
13: -- ELEMENTARY OPERATIONS :
14:
15: function Linear_System ( pos : Vector ) return Lin_Sys is
16:
17: -- DESCRIPTION :
18: -- Creates a linear system, by extracting the vectors that
19: -- correspond to the entries in the given position.
20:
21: res : Lin_Sys(pos'range);
22: use Random_Product_System;
23:
24: begin
25: for k in res'range loop
26: res(k) := Get_Hyperplane(k,pos(k));
27: end loop;
28: return res;
29: end Linear_System;
30:
31: function Permute ( p : Permutation; ls : Lin_Sys ) return Lin_Sys is
32:
33: -- DESCRIPTION :
34: -- Permutes the equations in the linear system.
35:
36: res : Lin_Sys(ls'range);
37: use Standard_Complex_Vectors;
38:
39: begin
40: for i in p'range loop
41: if p(i) >= 0
42: then res(i) := ls(p(i));
43: else res(i) := -ls(-p(i));
44: end if;
45: end loop;
46: return res;
47: end Permute;
48:
49: function Permute ( ls : Lin_Sys; p : Permutation ) return Lin_Sys is
50:
51: -- DESCRIPTION :
52: -- Permutes the unknowns in the linear system.
53:
54: res : Lin_Sys(ls'range);
55:
56: begin
57: for k in res'range loop
58: res(k) := new Standard_Complex_Vectors.Vector'(p*ls(k).all);
59: end loop;
60: return res;
61: end Permute;
62:
63: function Permutable ( ls1,ls2 : Lin_Sys ) return boolean is
64:
65: -- DESCRIPTION :
66: -- Returns true when there exists a permutation that permutes
67: -- the first linear system into the second one.
68:
69: found : boolean := true;
70:
71: begin
72: for i in ls1'range loop
73: for j in ls2'range loop
74: found := Permutable(ls1(i).all,ls2(j).all);
75: exit when found;
76: end loop;
77: exit when not found;
78: end loop;
79: return found;
80: end Permutable;
81:
82: function Sign_Permutable ( ls1,ls2 : Lin_Sys ) return boolean is
83:
84: -- DESCRIPTION :
85: -- Returns true when there exists a permutation that permutes
86: -- the first linear system into the second one, also w.r.t. sign
87: -- permutations.
88:
89: found : boolean := true;
90:
91: begin
92: for i in ls1'range loop
93: for j in ls2'range loop
94: found := Sign_Permutable(ls1(i).all,ls2(j).all);
95: exit when found;
96: end loop;
97: exit when not found;
98: end loop;
99: return found;
100: end Sign_Permutable;
101:
102: procedure Clear ( ls : in out Lin_Sys ) is
103:
104: -- DESCRIPTION :
105: -- Deallocation of the occupied memory space.
106:
107: begin
108: for k in ls'range loop
109: Standard_Complex_Vectors.Clear(ls(k));
110: end loop;
111: end Clear;
112:
113: -- UTILITIES :
114:
115: procedure Search_Permutable
116: ( sub : in Lin_Sys; pos : in Vector;
117: res,res_last : in out List ) is
118:
119: -- DESCRIPTION :
120: -- In the list of positions, already in res, it will be searched
121: -- whether there exists a linear system that is permutable with the
122: -- given linear system.
123:
124: tmp : List := res;
125: found : boolean := false;
126: ls2 : Lin_Sys(sub'range);
127:
128: begin
129: while not Is_Null(tmp) loop
130: ls2 := Linear_System(Head_Of(tmp).all);
131: found := Permutable(sub,ls2);
132: exit when found;
133: tmp := Tail_Of(tmp);
134: end loop;
135: if not found
136: then Append(res,res_last,pos);
137: end if;
138: end Search_Permutable;
139:
140: procedure Search_Sign_Permutable
141: ( sub : in Lin_Sys; pos : in Vector;
142: res,res_last : in out List ) is
143:
144: -- DESCRIPTION :
145: -- In the list of positions, already in res, it will be searched
146: -- whether there exists a linear system that is sign permutable
147: -- with the given linear system.
148:
149: tmp : List := res;
150: found : boolean := false;
151: ls2 : Lin_Sys(sub'range);
152:
153: begin
154: while not Is_Null(tmp) loop
155: ls2 := Linear_System(Head_Of(tmp).all);
156: found := Sign_Permutable(sub,ls2);
157: exit when found;
158: tmp := Tail_Of(tmp);
159: end loop;
160: if not found
161: then Append(res,res_last,pos);
162: end if;
163: end Search_Sign_Permutable;
164:
165: function Search_Position ( sub : Lin_Sys ) return Vector is
166:
167: -- DESCRIPTION :
168: -- Returns the position of the system in the product system.
169:
170: res : Vector(sub'range);
171: lh : Standard_Complex_Vectors.Link_to_Vector;
172:
173: begin
174: for k in 1..Random_Product_System.Dimension loop
175: res(k) := 0;
176: for l in 1..Random_Product_System.Number_of_Hyperplanes(k) loop
177: lh := Random_Product_System.Get_Hyperplane(k,l);
178: if Standard_Complex_Vectors.Equal(sub(k).all,lh.all)
179: then res(k) := l;
180: end if;
181: exit when res(k) /= 0;
182: end loop;
183: end loop;
184: return res;
185: end Search_Position;
186:
187: procedure Permute_and_Search
188: ( v,w : List_of_Permutations; sub : in Lin_Sys;
189: pos : in Vector; res,res_last : in out List ) is
190:
191: -- DESCRIPTION :
192: -- The permutations are applied to the subsystem.
193: -- If none of the positions of the permuted systems already
194: -- belongs to res, then its position pos will be added to res.
195:
196: lv,lw : List_of_Permutations;
197: found : boolean := false;
198:
199: begin
200: lv := v; lw := w;
201: -- put_line("The permuted positions : ");
202: while not Is_Null(lv) loop
203: declare
204: vpersub : Lin_Sys(sub'range)
205: := Permute(sub,Permutation(Head_Of(lv).all));
206: wpersub : Lin_Sys(sub'range)
207: := Permute(Permutation(Head_Of(lw).all),vpersub);
208: perpos : Vector(pos'range) := Search_Position(wpersub);
209: begin
210: if Is_In(res,perpos)
211: then found := true;
212: end if;
213: end;
214: exit when found;
215: lv := Tail_Of(lv);
216: lw := Tail_Of(lw);
217: end loop;
218: if not found
219: then Append(res,res_last,pos);
220: end if;
221: end Permute_and_Search;
222:
223: function Generate_Positions return List is
224:
225: res,res_last : List;
226: n : constant natural := Random_Product_System.Dimension;
227: pos : Vector(1..n) := (1..n => 1);
228:
229: procedure Generate_Positions ( k : natural ) is
230: begin
231: if k > n
232: then Append(res,res_last,pos);
233: else for l in 1..Random_Product_System.Number_of_Hyperplanes(k) loop
234: pos(k) := l;
235: Generate_Positions(k+1);
236: end loop;
237: end if;
238: end Generate_Positions;
239:
240: begin
241: Generate_Positions(1);
242: return res;
243: end Generate_Positions;
244:
245: -- TARGET ROUTINES :
246:
247: function Linear_Symmetric_Reduce ( sign : boolean ) return List is
248:
249: res : List;
250:
251: begin
252: res := Generate_Positions;
253: Linear_Symmetric_Reduce(res,sign);
254: return res;
255: end Linear_Symmetric_Reduce;
256:
257: function Linear_Symmetric_Reduce
258: ( v,w : List_of_Permutations ) return List is
259:
260: res : List;
261:
262: begin
263: res := Generate_Positions;
264: Linear_Symmetric_Reduce(v,w,res);
265: return res;
266: end Linear_Symmetric_Reduce;
267:
268: procedure Linear_Symmetric_Reduce ( lp : in out List; sign : in boolean ) is
269:
270: res,res_last : List;
271: sub : Lin_Sys(1..Random_Product_System.Dimension);
272: pos : Vector(sub'range);
273: tlp : List := lp;
274:
275: begin
276: while not Is_Null(tlp) loop
277: pos := Head_Of(tlp).all;
278: sub := Linear_System(pos);
279: if not sign
280: then Search_Permutable(sub,pos,res,res_last);
281: else Search_Sign_Permutable(sub,pos,res,res_last);
282: end if;
283: tlp := Tail_Of(tlp);
284: end loop;
285: Clear(lp);
286: lp := res;
287: end Linear_Symmetric_Reduce;
288:
289: procedure Linear_Symmetric_Reduce
290: ( v,w : in List_of_Permutations; lp : in out List ) is
291:
292: res,res_last : List;
293: sub : Lin_Sys(1..Random_Product_System.Dimension);
294: pos : Vector(sub'range);
295: tlp : List := lp;
296:
297: begin
298: while not Is_Null(tlp) loop
299: pos := Head_Of(tlp).all;
300: sub := Linear_System(pos);
301: Permute_and_Search(v,w,sub,pos,res,res_last);
302: tlp := Tail_Of(tlp);
303: end loop;
304: Clear(lp);
305: lp := res;
306: end Linear_Symmetric_Reduce;
307:
308: end Linear_Symmetric_Reduction;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to linear_symmetric_reduction.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 / Symmetry