Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Product/drivers_for_set_structures.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 Numbers_io; use Numbers_io;
5: with Standard_Natural_Vectors;
6: with Standard_Complex_Poly_Systems_io; use Standard_Complex_Poly_Systems_io;
7: with Standard_Complex_Solutions_io; use Standard_Complex_Solutions_io;
8: with Set_Structure,Set_Structure_io;
9: with Degree_Sets_Tables; use Degree_Sets_Tables;
10: with Random_Product_System;
11: with Random_Product_Start_Systems; use Random_Product_Start_Systems;
12:
13: package body Drivers_for_Set_Structures is
14:
15: procedure Set_Structure_Info is
16:
17: i : array(1..18) of string(1..65);
18:
19: begin
20: i( 1):=" A generalized Bezout number is based on a supporting set";
21: i( 2):="structure. A set structure is a tuple of arrays of subsets of";
22: i( 3):="unknowns. ";
23: i( 4):=" The corresponding start system is a linear-product system: the";
24: i( 5):="i-th equation is the product of linear equations with random";
25: i( 6):="coefficient in the unknowns of the set of the i-th array. The";
26: i( 7):="number of factors in the product for the i-th equation of the";
27: i( 8):="start system equals the number of subsets in the i-th array of";
28: i( 9):="the set structure. ";
29: i(10):=" A set structure is supporting for a polynomial system if every";
30: i(11):="monomial in the system also occurs in the corresponding linear-";
31: i(12):="product start system. ";
32: i(13):=" Given a supporting set structure, the generalized Bezout number";
33: i(14):="equals the number of solutions of the corresponding linear-";
34: i(15):="product start system. Before the construction of the start";
35: i(16):="system, a generalized Bezout number is first computed in a formal";
36: i(17):="way as a generalized permanent of a degree matrix. A heuristic";
37: i(18):="procedure is available for generating a supporting set structure.";
38: for k in i'range loop
39: put_line(i(k));
40: end loop;
41: end Set_Structure_Info;
42:
43: procedure Driver_for_Set_Structure
44: ( file : in file_type; p : in Poly_Sys;
45: b : in out natural; lpos : in out List;
46: q : out Poly_Sys; qsols : out Solution_List ) is
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 Display_Menu ( choice : out character; bb : in natural ) is
76:
77: ans : character;
78:
79: begin
80: new_line;
81: put_line("MENU for generalized Bezout Numbers based on Set Structures :");
82: put (" 0. exit - current Bezout number is "); put(bb,1); new_line;
83: put_line(" 1. Apply heuristic constructor for set structure");
84: put_line(" 2. Evaluate your own set structure");
85: put("Type 0, 1, or 2 to make your choice : ");
86: Ask_Alternative(ans,"012"); choice := ans;
87: end Display_Menu;
88:
89: procedure Dispatch_Menu ( file : in file_type;
90: choice : in character; bb : in out natural ) is
91: begin
92: case choice is
93: when '1' =>
94: Random_Product_Start_Systems.Build_Set_Structure(p);
95: bb := Permanent(Degree_Sets_Tables.Create);
96: when '2' =>
97: declare
98: ns : Standard_Natural_Vectors.Vector(p'range);
99: begin
100: for i in ns'range loop
101: put(" Give the number of sets for polynomial ");
102: put(i,1); put(" : "); 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: end;
108: bb := Permanent(Degree_Sets_Tables.Create);
109: when others => null;
110: end case;
111: Write_Results(Standard_Output,bb); Write_Results(file,bb);
112: end Dispatch_Menu;
113:
114: procedure Driver_for_Bezout_Number
115: ( file : in file_type; bb : in out natural ) is
116:
117: method : character;
118: timer : timing_widget;
119:
120: begin
121: new_line(file);
122: put_line(file,"SET STRUCTURE ANALYSIS :");
123: tstart(timer);
124: loop
125: Display_Menu(method,bb);
126: exit when method = '0';
127: Dispatch_Menu(file,method,bb);
128: end loop;
129: tstop(timer);
130: new_line(file);
131: print_times(file,timer,"set structure analysis");
132: end Driver_for_Bezout_Number;
133:
134: procedure Driver_for_Start_System
135: ( file : in file_type; bb : in natural ) is
136:
137: ans : character;
138: timer : timing_widget;
139: qq : Poly_Sys(p'range);
140: qqsols : Solution_List;
141:
142: begin
143: new_line;
144: put("Do you want a start system based on the set structure ? (y/n) ");
145: Ask_Yes_or_No(ans);
146: if ans = 'y'
147: then
148: declare
149: nl : natural;
150: n : natural := p'length;
151: begin
152: -- new_line;
153: -- put("Solving "); put(bb,1); put(" linear systems...");
154: tstart(timer);
155: Random_Product_System.Init(n);
156: Build_Random_Product_System(n);
157: Set_Structure.Clear;
158: qq := Random_Product_System.Polynomial_System;
159: -- Random_Product_System.Solve(qqsols,nl,lpos);
160: Random_Product_System.Solve(qqsols,nl);
161: Random_Product_System.Clear;
162: tstop(timer);
163: Save_Results(qq,qqsols);
164: q := qq; qsols := qqsols;
165: new_line(file);
166: put_line(file,"RANDOM LINEAR-PRODUCT START SYSTEM : ");
167: put_line(file,qq);
168: new_line(file);
169: put_line(file,"THE SOLUTIONS :");
170: new_line(file);
171: put(file,Length_Of(qqsols),Head_Of(qqsols).n,qqsols);
172: new_line(file);
173: print_times(file,timer,"constructing and solving the start system");
174: end;
175: else
176: Set_Structure.Clear;
177: -- Clear(lpos);
178: end if;
179: end Driver_for_Start_System;
180:
181: procedure Main_Driver is
182:
183: bb : natural := b;
184:
185: begin
186: Driver_for_Bezout_Number(file,bb);
187: if not Set_Structure.Empty
188: then b := bb;
189: Driver_for_Start_System(file,bb);
190: end if;
191: end Main_Driver;
192:
193: begin
194: Main_Driver;
195: end Driver_for_Set_Structure;
196:
197: end Drivers_for_Set_Structures;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to drivers_for_set_structures.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 / Product