Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Symmetry/driver_for_symmetric_set_structure.adb, Revision 1.1.1.1
1.1 maekawa 1: with integer_io; use integer_io;
2: with Communications_with_User; use Communications_with_User;
3: with Timing_Package; use Timing_Package;
4: with Standard_Floating_Numbers; use Standard_Floating_Numbers;
5: with Numbers_io; use Numbers_io;
6: with Standard_Natural_Vectors; use Standard_Natural_Vectors;
7: with Standard_Complex_Poly_Systems_io; use Standard_Complex_Poly_Systems_io;
8: with Lists_of_Integer_Vectors_io; use Lists_of_Integer_Vectors_io;
9: with Standard_Complex_Solutions; use Standard_Complex_Solutions;
10: with Standard_Complex_Solutions_io; use Standard_Complex_Solutions_io;
11: with Random_Product_System;
12: with Random_Product_System_io;
13: with Set_Structure,Set_Structure_io; use Set_Structure;
14: with Degree_Sets_Tables; use Degree_Sets_Tables;
15: with Orbits_of_Solutions; use Orbits_of_Solutions;
16: with Permutations,Symmetry_Group; use Permutations,Symmetry_Group;
17: with Symmetry_Group_io; use Symmetry_Group_io;
18: with Symbolic_Symmetry_Group_io; use Symbolic_Symmetry_Group_io;
19: with Drivers_for_Symmetry_Group_io; use Drivers_for_Symmetry_Group_io;
20: with Symmetric_Set_Structure; use Symmetric_Set_Structure;
21: with Equivariant_Polynomial_Systems; use Equivariant_Polynomial_Systems;
22: with Linear_Symmetric_Reduction; use Linear_Symmetric_Reduction;
23:
24: package body Driver_for_Symmetric_Set_Structure is
25:
26: procedure Symmetric_Set_Structure_Info is
27:
28: i : array(1..5) of string(1..65);
29:
30: begin
31: i(1):=" A symmetric generalized Bezout number is based on a symmetric";
32: i(2):="supporting set structure and allows to exploit permutation";
33: i(3):="symmetries in the system. The corresponding linear-product start";
34: i(4):="system has the same symmetric structure, so that in the homotopy,";
35: i(5):="only the generating solution paths need to be traced. ";
36: for k in i'range loop
37: put_line(i(k));
38: end loop;
39: end Symmetric_Set_Structure_Info;
40:
41: procedure Driver_for_Symmetric_Random_Product_Systems
42: ( file : in file_type; p : in Poly_Sys; q : out Poly_Sys;
43: qsols : out Solution_List; bs : in out natural;
44: lpos : in out List ) is
45:
46: tol : constant double_float := 10.0**(-12);
47:
48: procedure Write_Results ( file : in file_type; bb : in natural ) is
49: begin
50: new_line(file);
51: put(file," generalized Bezout number is "); put(file,bb,1);
52: new_line(file);
53: put_line(file," based on the set structure :");
54: Set_Structure_io.put(file);
55: end Write_Results;
56:
57: procedure Save_Results ( qq : in Poly_Sys; qqsols : in Solution_List ) is
58:
59: qqfile : file_type;
60:
61: begin
62: if not Is_Null(qqsols)
63: then new_line;
64: put_line("Reading file name to write start system.");
65: Read_Name_and_Create_File(qqfile);
66: put_line(qqfile,qq);
67: new_line(qqfile);
68: put_line(qqfile,"THE SOLUTIONS : ");
69: new_line(qqfile);
70: put(qqfile,Length_Of(qqsols),Head_Of(qqsols).n,qqsols);
71: Close(qqfile);
72: end if;
73: end Save_Results;
74:
75: procedure Write_Orbits
76: ( file : in file_type; qqsols : in Solution_List ) is
77:
78: orb : constant Permutation := Orbits(qqsols,tol);
79:
80: begin
81: new_line;
82: put("The number of generating solutions : ");
83: put(Length_Of(qqsols),1); new_line;
84: new_line(file);
85: put(file,"The number of generating solutions : ");
86: put(file,Length_Of(qqsols),1); new_line(file);
87: put("The orbits : "); Symmetry_Group_io.put(orb); new_line;
88: put(file,"The orbits : "); Symmetry_Group_io.put(file,orb);
89: new_line(file);
90: end Write_Orbits;
91:
92: procedure Driver_for_Bezout_Number ( file : in file_type ) is
93:
94: timer : timing_widget;
95: ns : Standard_Natural_Vectors.Vector(p'range);
96:
97: begin
98: put_line("Reading the set structure.");
99: for i in ns'range loop
100: put(" Give the number of sets for polynomial ");
101: put(i,1); put(" : ");
102: Read_Natural(ns(i));
103: end loop;
104: Set_Structure.Init(ns);
105: put_line("Give the set structure : ");
106: Set_Structure_io.get;
107: -- Set_Structure.B(bs,lpos);
108: tstart(timer);
109: bs := Permanent(Degree_Sets_Tables.Create);
110: tstop(timer);
111: Write_Results(file,bs);
112: Write_Results(Standard_Output,bs);
113: new_line(file);
114: print_times(file,timer,"computation of generalized permanent");
115: end Driver_for_Bezout_Number;
116:
117: procedure Construct_Start_System
118: ( file : in file_type; n : in natural;
119: allperms : in boolean; v,w : List_of_Permutations;
120: notsymmetric,degenerate : out boolean ) is
121:
122: timer : timing_widget;
123: notequi,notsym,degen : boolean;
124:
125: begin
126: tstart(timer);
127: if allperms
128: then Equivariant_Start_System(n,v,notequi);
129: if notequi
130: then new_line; new_line(file);
131: put_line("The set structure is not equivariant.");
132: put_line(file,"The set structure is not equivariant.");
133: else notsym := false; degen := false;
134: end if;
135: end if;
136: if not allperms or notequi
137: then Symmetric_Start_System(n,bs,lpos,v,w,notsym,degen);
138: new_line; new_line(file);
139: if notsym
140: then
141: put_line("The set structure is not symmetric.");
142: put_line(file,"The set structure is not symmetric.");
143: else
144: if degen
145: then
146: put_line("The set structure is symmetric but degenerate.");
147: put_line(file,
148: "The set structure is symmetric but degenerate.");
149: else
150: put_line("The set structure is symmetric and not degenerate.");
151: put_line(file,
152: "The set structure is symmetric and not degenerate.");
153: end if;
154: end if;
155: end if;
156: notsymmetric := notsym;
157: degenerate := degen;
158: tstop(timer);
159: new_line(file);
160: print_times(file,timer,"construction of symmetric start system");
161: end Construct_Start_System;
162:
163: procedure Solve_Start_System
164: ( file : in file_type;
165: allperms : in boolean; v,w : in List_of_Permutations ) is
166:
167: timer : timing_widget;
168: nl : natural;
169: qq : Poly_Sys(p'range);
170: qqsols : Solution_List;
171:
172: begin
173: -- Random_Product_System_io.put(file,n,2,4,3);
174: qq := Random_Product_System.Polynomial_System;
175: new_line(file);
176: put_line(file,"SYMMETRIC LINEAR-PRODUCT SYSTEM : ");
177: put_line(file,qq);
178: -- put_line(file,"The list of positions : "); put(file,lpos);
179: -- if allperms
180: -- then Linear_Symmetric_Reduce(lpos,false);
181: -- else Linear_Symmetric_Reduce(v,w,lpos);
182: -- end if;
183: tstart(timer);
184: if allperms
185: then lpos := Linear_Symmetric_Reduce(false);
186: else lpos := Linear_Symmetric_Reduce(v,w);
187: end if;
188: -- put_line(file,"The reduced list of positions : "); put(file,lpos);
189: Random_Product_System.Solve(qqsols,nl,lpos);
190: tstop(timer);
191: Random_Product_System.Clear;
192: if allperms
193: then qqsols := Generating(qqsols,false,tol);
194: else Analyze(v,false,tol,qqsols);
195: end if;
196: Save_Results(qq,qqsols);
197: new_line(file);
198: put_line(file,"THE GENERATING SOLUTIONS :");
199: new_line(file);
200: put(file,Length_Of(qqsols),Head_Of(qqsols).n,qqsols);
201: Write_Orbits(file,qqsols);
202: new_line(file);
203: print_times(file,timer,"solving the linear-product system");
204: q := qq; qsols := qqsols;
205: end Solve_Start_System;
206:
207: procedure Driver_for_Start_System
208: ( file : in file_type; n : in natural;
209: allperms : in boolean; v,w : List_of_Permutations ) is
210:
211: ans : character;
212: notsym,degen : boolean;
213:
214: begin
215: new_line;
216: put("Do you want a symmetric linear-product start system ? ");
217: Ask_Yes_or_No(ans);
218: if ans = 'y'
219: then
220: Construct_Start_System(file,n,allperms,v,w,notsym,degen);
221: -- new_line(file); Write_Covering(file); new_line(file);
222: -- new_line(file); Write_Templates(file,n); new_line(file);
223: -- Symmetric_Set_Structure.Clear;
224: Set_Structure.Clear;
225: if not notsym and not degen
226: then Solve_Start_System(file,allperms,v,w);
227: end if;
228: end if;
229: end Driver_for_Start_System;
230:
231: procedure Main_Driver is
232:
233: totaltimer : timing_widget;
234: n : natural := p'length;
235: allperms,notsym,inva,equi : boolean;
236: g,v,w : List_of_Permutations;
237:
238: begin
239: new_line(file);
240: put_line(file,"SYMMETRIC SET STRUCTURE ANALYSIS :");
241: new_line(file);
242: Read_Permutation_Group(n,g,v,allperms);
243: tstart(totaltimer);
244: put_line(file,"THE SYMMETRY GROUP :");
245: new_line(file);
246: put_line(file,"v:"); Symbolic_Symmetry_Group_io.put(file,v);
247: new_line(file);
248: Act(v,p,w,notsym,inva,equi);
249: new_line(file);
250: put_line(file,"w:"); Symmetry_Group_io.put(file,w); new_line(file);
251: if notsym
252: then put_line("The system is not (G,V,W)-symmetric.");
253: put_line(file,"The system is not (G,V,W)-symmetric.");
254: else put_line("The system is (G,V,W)-symmetric.");
255: put_line(file,"The system is (G,V,W)-symmetric.");
256: if Set_Structure.Empty
257: then Driver_for_Bezout_Number(file);
258: end if;
259: if not Set_Structure.Empty
260: then Driver_for_Start_System(file,n,allperms,v,w);
261: end if;
262: end if;
263: tstop(totaltimer);
264: new_line(file);
265: print_times(file,totaltimer,"symmetric set structure analysis");
266: end Main_Driver;
267:
268: begin
269: Main_Driver;
270: end Driver_for_Symmetric_Random_Product_Systems;
271:
272: end Driver_for_Symmetric_Set_Structure;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to driver_for_symmetric_set_structure.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