Annotation of OpenXM_contrib/PHC/Ada/Schubert/ts_defpos.adb, Revision 1.1.1.1
1.1 maekawa 1: with text_io,integer_io; use text_io,integer_io;
2: with Communications_with_User; use Communications_with_User;
3: with Timing_Package; use Timing_Package;
4: with Standard_Complex_Matrices;
5: with Standard_Complex_Matrices_io; use Standard_Complex_Matrices_io;
6: with Standard_Random_Matrices; use Standard_Random_Matrices;
7: with Standard_Complex_VecMats; use Standard_Complex_VecMats;
8: with Symbol_Table; use Symbol_Table;
9: with Matrix_Indeterminates;
10: with Standard_Complex_Poly_Matrices;
11: with Standard_Complex_Poly_Matrices_io; use Standard_Complex_Poly_Matrices_io;
12: with Drivers_for_Poly_Continuation; use Drivers_for_Poly_Continuation;
13: with Brackets,Brackets_io; use Brackets,Brackets_io;
14: with Symbolic_Minor_Equations; use Symbolic_Minor_Equations;
15: with Pieri_Homotopies; use Pieri_Homotopies;
16: with Localization_Posets; use Localization_Posets;
17: with Localization_Posets_io; use Localization_Posets_io;
18: with Deformation_Posets; use Deformation_Posets;
19:
20: procedure ts_defpos is
21:
22: -- DESCRIPTION :
23: -- Test on the deformation posets.
24:
25: procedure Add_t_Symbol is
26:
27: -- DESCRIPTION :
28: -- Adds the symbol for the continuation parameter t to the symbol table.
29:
30: tsb : Symbol;
31:
32: begin
33: Symbol_Table.Enlarge(1);
34: tsb(1) := 't';
35: for i in 2..tsb'last loop
36: tsb(i) := ' ';
37: end loop;
38: Symbol_Table.Add(tsb);
39: end Add_t_Symbol;
40:
41: procedure Set_Parameters ( file : in file_type; report : out boolean ) is
42:
43: -- DESCRIPTION :
44: -- Interactive determination of the continuation and output parameters.
45:
46: oc : natural;
47:
48: begin
49: new_line;
50: Driver_for_Continuation_Parameters(file);
51: new_line;
52: Driver_for_Process_io(file,oc);
53: report := not (oc = 0);
54: new_line;
55: put_line("No more input expected. See output file for results...");
56: new_line;
57: new_line(file);
58: end Set_Parameters;
59:
60: function Random_Input_Planes ( m,p : natural ) return VecMat is
61:
62: -- DESCRIPTION :
63: -- Returns a vector of m*p random m-planes.
64:
65: res : VecMat(1..m*p);
66: n : constant natural := m+p;
67:
68: begin
69: for i in res'range loop
70: res(i) := new Standard_Complex_Matrices.Matrix'(Random_Matrix(n,m));
71: end loop;
72: return res;
73: end Random_Input_Planes;
74:
75: function Random_Input_Planes ( m,p : natural; k : Bracket ) return VecMat is
76:
77: -- DESCRIPTION :
78: -- Returns a vector of m*p random m-planes.
79:
80: res : VecMat(k'range);
81: n : constant natural := m+p;
82:
83: begin
84: for i in res'range loop
85: res(i)
86: := new Standard_Complex_Matrices.Matrix'(Random_Matrix(n,m+1-k(i)));
87: end loop;
88: return res;
89: end Random_Input_Planes;
90:
91: procedure Solve_Deformation_Poset
92: ( file : in file_type; m,p : in natural;
93: level_poset : in Array_of_Nodes;
94: index_poset : in Array_of_Array_of_Nodes ) is
95:
96: -- DESCRIPTION :
97: -- Creates a deformation poset and applies the Solve operator.
98:
99: deform_poset : Array_of_Array_of_VecMats(index_poset'range)
100: := Create(index_poset);
101: planes : VecMat(1..m*p) := Random_Input_Planes(m,p);
102: report : boolean;
103: timer : Timing_Widget;
104: target_level : natural := m*p;
105: nbp : natural := 0;
106:
107: begin
108: put_line("The size of the deformation poset : ");
109: put_line(file,"The size of the deformation poset : ");
110: put_roco(index_poset);
111: put_roco(file,index_poset);
112: new_line;
113: put("Give target level <= "); put(target_level,1);
114: put(" = root level : "); get(target_level);
115: for i in 1..target_level loop
116: nbp := nbp + Row_Root_Count_Sum(level_poset,i);
117: end loop;
118: put("The number of paths : "); put(nbp,1); new_line;
119: put(file,"The number of paths : "); put(file,nbp,1); new_line(file);
120: Matrix_Indeterminates.Initialize_Symbols(m+p,p);
121: Add_t_Symbol;
122: skip_line;
123: Set_Parameters(file,report);
124: tstart(timer);
125: for i in index_poset(target_level)'range loop
126: declare
127: root : Node := index_poset(target_level)(i).all;
128: begin
129: Solve(file,m+p,deform_poset,root,planes,report);
130: end;
131: end loop;
132: tstop(timer);
133: new_line(file);
134: print_times(file,timer,"Solving along the deformation poset");
135: end Solve_Deformation_Poset;
136:
137: procedure Solve_Deformation_Poset
138: ( file : in file_type; m,p : in natural; k : in Bracket;
139: index_poset : in Array_of_Array_of_Nodes ) is
140:
141: -- DESCRIPTION :
142: -- Applies the solver to general intersection conditions.
143:
144: deform_poset : Array_of_Array_of_VecMats(index_poset'range)
145: := Create(index_poset);
146: planes : VecMat(k'range) := Random_Input_Planes(m,p,k);
147: report : boolean;
148: timer : Timing_Widget;
149: target_level : natural := m*p;
150:
151: begin
152: put_line("The size of the deformation poset : ");
153: put_line(file,"The size of the deformation poset : ");
154: put_roco(index_poset);
155: put_roco(file,index_poset);
156: new_line;
157: put("Give target level <= "); put(target_level,1);
158: put(" = root level : "); get(target_level);
159: Matrix_Indeterminates.Initialize_Symbols(m+p,p);
160: Add_t_Symbol;
161: skip_line;
162: Set_Parameters(file,report);
163: tstart(timer);
164: for i in index_poset(target_level)'range loop
165: declare
166: root : Node := index_poset(target_level)(i).all;
167: begin
168: if ((root.tp = top) or (root.tp = bottom))
169: then --One_Solve(file,m+p,k,deform_poset,root,planes,report);
170: Solve(file,m+p,k,deform_poset,root,planes,report);
171: else Solve(file,m+p,k,deform_poset,root,planes,report);
172: end if;
173: end;
174: end loop;
175: tstop(timer);
176: new_line(file);
177: print_times(file,timer,"Solving along the deformation poset");
178: end Solve_Deformation_Poset;
179:
180: procedure Create_Top_Hypersurface_Poset
181: ( file : in file_type; m,p : in natural ) is
182:
183: -- DESCRIPTION :
184: -- Create the poset by incrementing only top pivots.
185:
186: root : Node(p) := Trivial_Root(m,p);
187: lnkroot : Link_to_Node := new Node'(root);
188: level_poset : Array_of_Nodes(0..m*p);
189: index_poset : Array_of_Array_of_Nodes(0..m*p);
190:
191: begin
192: Top_Create(lnkroot,m+p);
193: put_line("The poset created from the top : ");
194: put_line(file,"The poset created from the top : ");
195: level_poset := Create_Leveled_Poset(lnkroot);
196: Count_Roots(level_poset);
197: index_poset := Create_Indexed_Poset(level_poset);
198: put(index_poset);
199: put(file,index_poset);
200: Solve_Deformation_Poset(file,m,p,level_poset,index_poset);
201: end Create_Top_Hypersurface_Poset;
202:
203: procedure Create_Bottom_Hypersurface_Poset
204: ( file : in file_type; m,p : in natural ) is
205:
206: -- DESCRIPTION :
207: -- Create the poset by decrementing only bottom pivots.
208:
209: root : Node(p) := Trivial_Root(m,p);
210: lnkroot : Link_to_Node := new Node'(root);
211: level_poset : Array_of_Nodes(0..m*p);
212: index_poset : Array_of_Array_of_Nodes(0..m*p);
213:
214: begin
215: Bottom_Create(lnkroot);
216: put_line("The poset created from the bottom : ");
217: put_line(file,"The poset created from the bottom : ");
218: level_poset := Create_Leveled_Poset(lnkroot);
219: Count_Roots(level_poset);
220: index_poset := Create_Indexed_Poset(level_poset);
221: put(index_poset);
222: put(file,index_poset);
223: Solve_Deformation_Poset(file,m,p,level_poset,index_poset);
224: end Create_Bottom_Hypersurface_Poset;
225:
226: procedure Create_Mixed_Hypersurface_Poset
227: ( file : in file_type; m,p : in natural ) is
228:
229: -- DESCRIPTION :
230: -- Create the poset by incrementing top and decrementing bottom pivots.
231:
232: root : Node(p) := Trivial_Root(m,p);
233: lnkroot : Link_to_Node := new Node'(root);
234: level_poset : Array_of_Nodes(0..m*p);
235: index_poset : Array_of_Array_of_Nodes(0..m*p);
236:
237: begin
238: Top_Bottom_Create(lnkroot,m+p);
239: put_line("The poset created in a mixed fashion : ");
240: put_line(file,"The poset created in a mixed fashion : ");
241: level_poset := Create_Leveled_Poset(lnkroot);
242: Count_Roots(level_poset);
243: index_poset := Create_Indexed_Poset(level_poset);
244: put(index_poset);
245: put(file,index_poset);
246: Solve_Deformation_Poset(file,m,p,level_poset,index_poset);
247: end Create_Mixed_Hypersurface_Poset;
248:
249: function Finite ( dim : Bracket; m,p : natural ) return boolean is
250:
251: -- DESCRIPTION :
252: -- Returns true if the codimensions yield a finite number of solutions.
253:
254: sum : natural := 0;
255:
256: begin
257: for i in dim'range loop
258: sum := sum + dim(i);
259: end loop;
260: if sum = m*p
261: then return true;
262: else return false;
263: end if;
264: end Finite;
265:
266: function Read_Codimensions ( m,p : natural ) return Bracket is
267:
268: -- DESCRIPTION :
269: -- Reads the vector of codimensions and checks on finiteness.
270:
271: codim : Bracket(1..m*p);
272: n : natural;
273: poset : Array_of_Nodes(0..m*p);
274:
275: begin
276: loop
277: put("Give number of intersection conditions : "); get(n);
278: put("Give "); put(n,1); put(" codimensions : ");
279: for i in 1..n loop
280: get(codim(i));
281: end loop;
282: for i in 1..n-1 loop
283: put(codim(i),1); put(" + ");
284: end loop;
285: put(codim(n),1);
286: if Finite(codim(1..n),m,p)
287: then put(" = "); put(m*p,1); put_line(" Finite #sols.");
288: exit;
289: else put(" /= "); put(m*p,1);
290: put_line(" Please try again.");
291: end if;
292: end loop;
293: return codim(1..n);
294: end Read_Codimensions;
295:
296: procedure Create_Top_General_Poset
297: ( file : in file_type; m,p : in natural ) is
298:
299: -- DESCRIPTION :
300: -- Creates a poset for counting general subspace intersections,
301: -- by consistently incrementing the top pivots.
302:
303: root : Node(p) := Trivial_Root(m,p);
304: lnkroot : Link_to_Node := new Node'(root);
305: codim : constant Bracket := Read_Codimensions(m,p);
306: level_poset : Array_of_Nodes(0..m*p);
307: index_poset : Array_of_Array_of_Nodes(0..m*p);
308:
309: begin
310: put(file," k = "); put(file,codim); new_line(file);
311: Top_Create(lnkroot,codim,m+p);
312: put_line("The poset created from the top : ");
313: put_line(file,"The poset created from the top : ");
314: level_poset := Create_Leveled_Poset(lnkroot);
315: Count_Roots(level_poset);
316: index_poset := Create_Indexed_Poset(level_poset);
317: put(index_poset);
318: put(file,index_poset);
319: Solve_Deformation_Poset(file,m,p,codim,index_poset);
320: end Create_Top_General_Poset;
321:
322: procedure Create_Bottom_General_Poset
323: ( file : in file_type; m,p : in natural ) is
324:
325: -- DESCRIPTION :
326: -- Creates a poset for counting general subspace intersections,
327: -- by consistently incrementing the top pivots.
328:
329: root : Node(p) := Trivial_Root(m,p);
330: lnkroot : Link_to_Node := new Node'(root);
331: codim : constant Bracket := Read_Codimensions(m,p);
332: level_poset : Array_of_Nodes(0..m*p);
333: index_poset : Array_of_Array_of_Nodes(0..m*p);
334:
335: begin
336: put(file," k = "); put(file,codim); new_line(file);
337: Bottom_Create(lnkroot,codim);
338: put_line("The poset created from the bottom : ");
339: put_line(file,"The poset created from the bottom : ");
340: level_poset := Create_Leveled_Poset(lnkroot);
341: Count_Roots(level_poset);
342: index_poset := Create_Indexed_Poset(level_poset);
343: put(index_poset);
344: put(file,index_poset);
345: Solve_Deformation_Poset(file,m,p,codim,index_poset);
346: end Create_Bottom_General_Poset;
347:
348: procedure Create_Mixed_General_Poset
349: ( file : in file_type; m,p : in natural ) is
350:
351: -- DESCRIPTION :
352: -- Creates a poset for counting general subspace intersections,
353: -- by incrementing the top and decrementing the bottom pivots.
354:
355: root : Node(p) := Trivial_Root(m,p);
356: lnkroot : Link_to_Node := new Node'(root);
357: codim : constant Bracket := Read_Codimensions(m,p);
358: level_poset : Array_of_Nodes(0..m*p);
359: index_poset : Array_of_Array_of_Nodes(0..m*p);
360:
361: begin
362: put(file," k = "); put(file,codim); new_line(file);
363: Top_Bottom_Create(lnkroot,codim,m+p);
364: put_line("The poset created in a mixed fashion : ");
365: put_line(file,"The poset created in a mixed fashion : ");
366: level_poset := Create_Leveled_Poset(lnkroot);
367: Count_Roots(level_poset);
368: index_poset := Create_Indexed_Poset(level_poset);
369: put(index_poset);
370: put(file,index_poset);
371: Solve_Deformation_Poset(file,m,p,codim,index_poset);
372: end Create_Mixed_General_Poset;
373:
374: procedure Main is
375:
376: m,p : natural;
377: ans : character;
378: file : file_type;
379:
380: begin
381: new_line;
382: put_line("MENU for posets for deforming p-planes in (m+p)-space : ");
383: put_line(" 1. k_i = 1 consistently incrementing the top pivots.");
384: put_line(" 2. consistently decrementing the bottom pivots.");
385: put_line(" 3. mixed top-bottom sequence for poset creation.");
386: put_line(" 4. k_i >= 1 consistently incrementing the top pivots.");
387: put_line(" 5. consistently decrementing the bottom pivots.");
388: put_line(" 6. mixed top-bottom sequence for poset creation.");
389: put("Type 1, 2, 3, 4, 5, or 6 to choose : "); get(ans);
390: skip_line; new_line;
391: put_line("Reading the name of the file for the deformations.");
392: Read_Name_and_Create_File(file);
393: new_line;
394: put("Give p, the number of entries in bracket : "); get(p);
395: put("Give m, the complementary dimension : "); get(m);
396: put(file,"p = "); put(file,p,1); put(file," m = "); put(file,m,1);
397: new_line;
398: case ans is
399: when '1' => new_line(file); Create_Top_Hypersurface_Poset(file,m,p);
400: when '2' => new_line(file); Create_Bottom_Hypersurface_Poset(file,m,p);
401: when '3' => new_line(file); Create_Mixed_Hypersurface_Poset(file,m,p);
402: when '4' => Create_Top_General_Poset(file,m,p);
403: when '5' => Create_Bottom_General_Poset(file,m,p);
404: when '6' => Create_Mixed_General_Poset(file,m,p);
405: when others => put_line("Option not recognized. Please try again.");
406: end case;
407: end Main;
408:
409: begin
410: new_line;
411: put_line("Test on deformation posets for linear subspace intersections.");
412: Main;
413: end ts_defpos;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to ts_defpos.adb CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / PHC / Ada / Schubert