Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Symmetry/symmetric_polyhedral_continuation.adb, Revision 1.1.1.1
1.1 maekawa 1: with integer_io; use integer_io;
2: with Standard_Floating_Numbers; use Standard_Floating_Numbers;
3: with Standard_Complex_Numbers; use Standard_Complex_Numbers;
4: with Standard_Integer_Vectors_io; use Standard_Integer_Vectors_io;
5: with Standard_Complex_Polynomials; use Standard_Complex_Polynomials;
6: with Standard_Complex_Laur_Polys; use Standard_Complex_Laur_Polys;
7: with Standard_Complex_Poly_Systems; use Standard_Complex_Poly_Systems;
8: with Standard_Laur_Poly_Convertors; use Standard_Laur_Poly_Convertors;
9: with Standard_Complex_Laur_Randomizers; use Standard_Complex_Laur_Randomizers;
10: with Lists_of_Integer_Vectors; use Lists_of_Integer_Vectors;
11: with Transforming_Integer_Vector_Lists; use Transforming_Integer_Vector_Lists;
12: with Arrays_of_Integer_Vector_Lists; use Arrays_of_Integer_Vector_Lists;
13: with Power_Lists; use Power_Lists;
14: with Integer_Lifting_Utilities; use Integer_Lifting_Utilities;
15: with Transforming_Laurent_Systems; use Transforming_Laurent_Systems;
16: with Fewnomial_System_Solvers; use Fewnomial_System_Solvers;
17: with Integer_Polyhedral_Continuation; use Integer_Polyhedral_Continuation;
18: with Symmetric_BKK_Bound_Solvers; use Symmetric_BKK_Bound_Solvers;
19: with Orbits_of_Solutions; use Orbits_of_Solutions;
20:
21: package body Symmetric_Polyhedral_Continuation is
22:
23: function Select_Subsystem ( p : Laur_Sys; mix : Vector; mic : Mixed_Cell )
24: return Laur_Sys is
25:
26: res : Laur_Sys(p'range);
27: cnt : natural := 0;
28:
29: begin
30: for k in mix'range loop
31: for l in 1..mix(k) loop
32: cnt := cnt + 1;
33: res(cnt) := Select_Terms(p(cnt),mic.pts(k));
34: end loop;
35: end loop;
36: return res;
37: end Select_Subsystem;
38:
39: function Symmetric_Mixed_Solve
40: ( file : file_type; grp : List_of_Permutations; sign : boolean;
41: p : Laur_Sys; mixsub : Mixed_Subdivision;
42: n : natural; mix : Vector ) return Solution_List is
43:
44: sols,sols_last : Solution_List;
45: cnt : natural := 0;
46: tmp : Mixed_Subdivision := mixsub;
47:
48: procedure Solve_Subsystem ( mic : in Mixed_Cell ) is
49:
50: q : Laur_Sys(p'range) := Select_Subsystem(p,mix,mic);
51: sq : Laur_Sys(q'range);
52: qsols : Solution_List;
53: fail : boolean;
54: eps : constant double_float := 10.0**(-10);
55:
56: begin
57: new_line(file);
58: put(file,"*** CONSIDERING SUBSYSTEM "); put(file,cnt,1);
59: put_line(file," ***");
60: new_line(file);
61: Reduce(n+1,q); sq := Shift(q);
62: declare
63: pq : Poly_Sys(q'range) := Laurent_to_Polynomial_System(sq);
64: begin
65: Solve(sq,qsols,fail);
66: if not fail
67: then put_line(file,"It is a fewnomial system.");
68: else put_line(file,"No fewnomial system.");
69: if mic.sub = null
70: then put_line(file,"Calling the black box solver.");
71: qsols := Symmetric_BKK_Solve(file,pq,grp,sign);
72: else put_line(file,"Using the refinement of the cell.");
73: declare
74: sup : Array_of_Lists(q'range);
75: cnt : natural := sup'first;
76: lif : Array_of_Lists(mix'range);
77: lifq : Laur_Sys(q'range);
78: begin
79: for i in mic.pts'range loop
80: sup(cnt) := Reduce(mic.pts(i),q'last+1);
81: for j in 1..(mix(i)-1) loop
82: Copy(sup(cnt),sup(cnt+j));
83: end loop;
84: cnt := cnt + mix(i);
85: end loop;
86: lif := Induced_Lifting(n,mix,sup,mic.sub.all);
87: lifq := Perform_Lifting(n,mix,lif,q);
88: qsols := Symmetric_Mixed_Solve
89: (file,grp,sign,lifq,mic.sub.all,n,mix);
90: Deep_Clear(sup); Deep_Clear(lif); Clear(lifq);
91: end;
92: end if;
93: Set_Continuation_Parameter(qsols,Create(0.0));
94: end if;
95: put(file,Length_Of(qsols),1);
96: put_line(file," solutions found.");
97: if not Is_Null(qsols)
98: then Analyze(grp,sign,eps,qsols);
99: put(file,Length_Of(qsols),1);
100: put_line(file," generating solutions found.");
101: Mixed_Continuation(file,p,mic.nor.all,qsols);
102: Concat(sols,sols_last,qsols);
103: end if;
104: Clear(pq); Clear(sq);
105: end;
106: Clear(q); -- Shallow_Clear(qsols);
107: end Solve_Subsystem;
108:
109: begin
110: while not Is_Null(tmp) loop
111: cnt := cnt + 1;
112: Solve_Subsystem(Head_Of(tmp));
113: tmp := Tail_Of(tmp);
114: end loop;
115: return sols;
116: end Symmetric_Mixed_Solve;
117:
118: function Symmetric_Mixed_Solve
119: ( file : file_type; sign : boolean; p : Laur_Sys;
120: mixsub : Mixed_Subdivision; n : natural;
121: mix : Vector ) return Solution_List is
122:
123: sols,sols_last : Solution_List;
124: cnt : natural;
125: tmp : Mixed_Subdivision := mixsub;
126:
127: procedure Solve_Subsystem ( mic : in Mixed_Cell ) is
128:
129: q : Laur_Sys(p'range) := Select_Subsystem(p,mix,mic);
130: sq : Laur_Sys(q'range);
131: qsols,genqsols : Solution_List;
132: fail : boolean;
133: eps : constant double_float := 10.0**(-10);
134:
135: begin
136: new_line(file);
137: put(file,"*** CONSIDERING SUBSYSTEM "); put(file,cnt,1);
138: put_line(file," ***");
139: new_line(file);
140: Reduce(n+1,q); sq := Shift(q);
141: declare
142: pq : Poly_Sys(q'range) := Laurent_to_Polynomial_System(sq);
143: begin
144: Solve(sq,qsols,fail);
145: if not fail
146: then put_line(file,"It is a fewnomial system.");
147: else put_line(file,"No fewnomial system.");
148: if mic.sub = null
149: then put_line(file,"Calling the black box solver.");
150: qsols := Symmetric_BKK_Solve(file,pq,sign);
151: else put_line(file,"Using the refinement of the cell.");
152: declare
153: sup : Array_of_Lists(q'range);
154: cnt : natural := sup'first;
155: lif : Array_of_Lists(mix'range);
156: lifq : Laur_Sys(q'range);
157: begin
158: for i in mic.pts'range loop
159: sup(cnt) := Reduce(mic.pts(i),q'last+1);
160: for j in 1..(mix(i)-1) loop
161: Copy(sup(cnt),sup(cnt+j));
162: end loop;
163: cnt := cnt + mix(i);
164: end loop;
165: lif := Induced_Lifting(n,mix,sup,mic.sub.all);
166: lifq := Perform_Lifting(n,mix,lif,q);
167: qsols := Symmetric_Mixed_Solve(file,sign,lifq,
168: mic.sub.all,n,mix);
169: Deep_Clear(sup); Deep_Clear(lif); Clear(lifq);
170: end;
171: end if;
172: Set_Continuation_Parameter(qsols,Create(0.0));
173: end if;
174: put(file,Length_Of(qsols),1);
175: put_line(file," solutions found.");
176: if not Is_Null(qsols)
177: then genqsols := Generating(qsols,sign,eps);
178: put(file,Length_Of(genqsols),1);
179: put_line(file," generating solutions found.");
180: Mixed_Continuation(file,p,mic.nor.all,genqsols);
181: Concat(sols,sols_last,genqsols);
182: end if;
183: Clear(pq); Clear(sq);
184: end;
185: Clear(q); -- Shallow_Clear(genqsols);
186: end Solve_Subsystem;
187:
188: begin
189: while not Is_Null(tmp) loop
190: cnt := cnt + 1;
191: Solve_Subsystem(Head_Of(tmp));
192: tmp := Tail_Of(tmp);
193: end loop;
194: return sols;
195: end Symmetric_Mixed_Solve;
196:
197: end Symmetric_Polyhedral_Continuation;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to symmetric_polyhedral_continuation.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