Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Symmetry/symmetric_lifting_functions.adb, Revision 1.1.1.1
1.1 maekawa 1: with Standard_Random_Numbers; use Standard_Random_Numbers;
2: with Lists_of_Integer_Vectors;
3: with Lists_of_Floating_Vectors;
4: with Mixed_Volume_Computation; use Mixed_Volume_Computation;
5: with Permutations,Permute_Operations; use Permutations,Permute_Operations;
6:
7: package body Symmetric_Lifting_Functions is
8:
9: procedure Classify_Orbits
10: ( supports : in Arrays_of_Integer_Vector_Lists.Array_of_Lists;
11: mix : in Standard_Integer_Vectors.Vector;
12: v,w : in List_of_Permutations; norb : out natural;
13: orbits : out Arrays_of_Integer_Vector_Lists.Array_of_Lists ) is
14:
15: use Standard_Integer_Vectors;
16: use Lists_of_Integer_Vectors;
17: use Arrays_of_Integer_Vector_Lists;
18:
19: res,done,res_last,done_last : Array_of_Lists(mix'range);
20: cnt,k,orbit,inmixk : natural;
21: n : constant natural := supports'last - supports'first + 1;
22: tmp : List;
23: lv : Link_to_Vector;
24:
25: function Lift ( lv : Link_to_Vector ) return Link_to_Vector is
26:
27: res : Link_to_Vector;
28:
29: begin
30: res := new Vector(lv'first..lv'last+1);
31: res(lv'range) := lv.all;
32: res(res'last) := orbit;
33: return res;
34: end Lift;
35:
36: function Search_and_Lift ( lv : Link_to_Vector; l : List )
37: return Link_to_Vector is
38: begin
39: if Is_In(l,lv)
40: then return Lift(lv);
41: else return lv;
42: end if;
43: end Search_and_Lift;
44:
45: procedure Update ( k : in natural; lv,liftlv : in Link_to_Vector ) is
46: begin
47: if not Is_In(done(k),lv)
48: then Append(done(k),done_last(k),lv.all);
49: Append(res(k),res_last(k),liftlv.all);
50: end if;
51: end Update;
52:
53: begin
54: orbit := 0;
55: k := supports'first;
56: for i in mix'range loop
57: tmp := supports(k);
58: inmixk := Compute_Index(k,mix);
59: while not Is_Null(tmp) loop
60: lv := Head_Of(tmp);
61: if not Is_In(done(inmixk),lv)
62: then orbit := orbit + 1; -- new orbit
63: declare
64: tmpv,tmpw : List_of_Permutations;
65: liftlv : Link_to_Vector := Lift(lv);
66: begin
67: Update(inmixk,lv,liftlv); Clear(liftlv);
68: tmpv := v; tmpw := w;
69: while not Is_Null(tmpv) loop -- construct the orbit
70: declare
71: plv : Link_to_Vector := new Vector(lv'range);
72: index : natural := Head_Of(tmpw)(k);
73: inmix : natural := Compute_Index(index,mix);
74: begin
75: plv.all := Permutation(Head_Of(tmpv).all)*lv.all;
76: liftlv := Search_and_Lift(plv,supports(index));
77: if liftlv'last = n+1
78: then inmix := Compute_Index(index,mix);
79: Update(inmix,plv,liftlv); Clear(liftlv);
80: end if;
81: Clear(plv);
82: end;
83: tmpv := Tail_Of(tmpv);
84: tmpw := Tail_Of(tmpw);
85: end loop;
86: end;
87: end if;
88: tmp := Tail_Of(tmp);
89: end loop;
90: k := k + mix(i);
91: end loop;
92: Deep_Clear(done);
93: cnt := 1;
94: for i in res'range loop
95: for j in 1..mix(i) loop
96: orbits(cnt) := res(i);
97: cnt := cnt + 1;
98: end loop;
99: end loop;
100: norb := orbit;
101: end Classify_Orbits;
102:
103: procedure Float_Lift_Orbits
104: ( orbits : in out Arrays_of_Floating_Vector_Lists.Array_of_Lists;
105: lifting : in Standard_Floating_Vectors.Vector ) is
106:
107: use Standard_Floating_Vectors;
108: use Lists_of_Floating_Vectors;
109: tmp : List;
110:
111: begin
112: for k in orbits'range loop
113: tmp := orbits(k);
114: while not Is_Null(tmp) loop
115: declare
116: lv : Link_to_Vector := Head_Of(tmp);
117: begin
118: lv(lv'last) := lifting(integer(lv(lv'last)));
119: Set_Head(tmp,lv);
120: end;
121: tmp := Tail_Of(tmp);
122: end loop;
123: end loop;
124: end Float_Lift_Orbits;
125:
126: procedure Integer_Lift_Orbits
127: ( orbits : in out Arrays_of_Integer_Vector_Lists.Array_of_Lists;
128: lifting : in Standard_Integer_Vectors.Vector ) is
129:
130: use Standard_Integer_Vectors;
131: use Lists_of_Integer_Vectors;
132: tmp : List;
133:
134: begin
135: for k in orbits'range loop
136: tmp := orbits(k);
137: while not Is_Null(tmp) loop
138: declare
139: lv : Link_to_Vector := Head_Of(tmp);
140: begin
141: lv(lv'last) := lifting(lv(lv'last));
142: Set_Head(tmp,lv);
143: end;
144: tmp := Tail_Of(tmp);
145: end loop;
146: end loop;
147: end Integer_Lift_Orbits;
148:
149: procedure Float_Random_Lift_Orbits
150: ( orbits : in out Arrays_of_Floating_Vector_Lists.Array_of_Lists;
151: norb : in natural; lower,upper : in double_float ) is
152:
153: use Standard_Floating_Vectors;
154: rv : Vector(1..norb);
155:
156: begin
157: for k in rv'range loop
158: rv(k) := (Random + 1.0)*(upper - lower)/2.0;
159: end loop;
160: Float_Lift_Orbits(orbits,rv);
161: end Float_Random_Lift_Orbits;
162:
163: procedure Integer_Random_Lift_Orbits
164: ( orbits : in out Arrays_of_Integer_Vector_Lists.Array_of_Lists;
165: norb : in natural; lower,upper : in integer ) is
166:
167: use Standard_Integer_Vectors;
168: rv : Vector(1..norb);
169:
170: begin
171: for k in rv'range loop
172: rv(k) := Random(lower,upper);
173: end loop;
174: Integer_Lift_Orbits(orbits,rv);
175: end Integer_Random_Lift_Orbits;
176:
177: end Symmetric_Lifting_Functions;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to symmetric_lifting_functions.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