Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Symmetry/drivers_for_symmetric_lifting.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 Standard_Floating_Numbers_io; use Standard_Floating_Numbers_io;
6: with Numbers_io; use Numbers_io;
7: with Standard_Integer_Vectors;
8: with Standard_Integer_Vectors_io; use Standard_Integer_Vectors_io;
9: with Standard_Floating_Vectors;
10: with Standard_Floating_Vectors_io; use Standard_Floating_Vectors_io;
11: with Standard_Complex_Poly_Systems_io; use Standard_Complex_Poly_Systems_io;
12: with Standard_Complex_Laur_Systems; use Standard_Complex_Laur_Systems;
13: with Standard_Poly_Laur_Convertors; use Standard_Poly_Laur_Convertors;
14: with Standard_Laur_Poly_Convertors; use Standard_Laur_Poly_Convertors;
15: with Lists_of_Integer_Vectors; use Lists_of_Integer_Vectors;
16: with Lists_of_Integer_Vectors_io; use Lists_of_Integer_Vectors_io;
17: with Arrays_of_Integer_Vector_Lists;
18: with Arrays_of_Integer_Vector_Lists_io; use Arrays_of_Integer_Vector_Lists_io;
19: with Arrays_of_Floating_Vector_Lists;
20: with Standard_Complex_Solutions_io; use Standard_Complex_Solutions_io;
21: with Drivers_for_Poly_Continuation; use Drivers_for_Poly_Continuation;
22: with Power_Lists; use Power_Lists;
23: with Integer_Faces_of_Polytope;
24: with Integer_Mixed_Subdivisions;
25: with Integer_Mixed_Subdivisions_io; use Integer_Mixed_Subdivisions_io;
26: with Integer_Lifting_Functions; use Integer_Lifting_Functions;
27: with Integer_Lifting_Utilities; use Integer_Lifting_Utilities;
28: with Floating_Lifting_Utilities; use Floating_Lifting_Utilities;
29: with Drivers_for_Lifting_Functions; use Drivers_for_Lifting_Functions;
30: with Pruning_Statistics;
31: with Integer_Pruning_Methods; use Integer_Pruning_Methods;
32: with Mixed_Volume_Computation; use Mixed_Volume_Computation;
33: with Floating_Integer_Convertors; use Floating_Integer_Convertors;
34: with Floating_Faces_of_Polytope;
35: with Floating_Mixed_Subdivisions;
36: with Floating_Mixed_Subdivisions_io; use Floating_Mixed_Subdivisions_io;
37: with Floating_Pruning_Methods; use Floating_Pruning_Methods;
38: with Mixed_Volume_Computation; use Mixed_Volume_Computation;
39: with Permutations; use Permutations;
40: with Symmetry_Group; use Symmetry_Group;
41: with Symmetry_Group_io; use Symmetry_Group_io;
42: with Symbol_Table,Symbol_Table_io; use Symbol_Table;
43: with Symbolic_Symmetry_Group_io; use Symbolic_Symmetry_Group_io;
44: with Drivers_for_Symmetry_Group_io; use Drivers_for_Symmetry_Group_io;
45: with Equivariant_Polynomial_Systems; use Equivariant_Polynomial_Systems;
46: with Faces_of_Symmetric_Polytopes; use Faces_of_Symmetric_Polytopes;
47: with Symmetric_Lifting_Functions; use Symmetric_Lifting_Functions;
48: with Generating_Mixed_Cells; use Generating_Mixed_Cells;
49: with Symmetric_Randomize;
50: with Symmetric_Polyhedral_Continuation; use Symmetric_Polyhedral_Continuation;
51:
52: package body Drivers_for_Symmetric_Lifting is
53:
54: procedure Symmetric_Lifting_Info is
55:
56: i : array(1..6) of string(1..65);
57:
58: begin
59: i(1):=" Symmetric lifting allows to exploit permutation symmetries in";
60: i(2):="the tuple of Newton polytopes. A symmetric subdivision is";
61: i(3):="induced by lifting the points in the same orbit up to the same";
62: i(4):="height. The corresponding random coefficient start system has";
63: i(5):="the same symmetric structure, so that in the homotopy, only the";
64: i(6):="generating solution paths need to be traced. ";
65: for k in i'range loop
66: put_line(i(k));
67: end loop;
68: end Symmetric_Lifting_Info;
69:
70: procedure Driver_for_Symmetric_Mixed_Volume_Computation
71: ( file : in file_type; p : in Poly_Sys; byebye : in boolean;
72: q : out Poly_Sys; qsols : out Solution_List;
73: mv : out natural ) is
74:
75: welcome : constant string
76: := "Mixed-Volume Computation by Symmetric Lifting";
77:
78: solsft,gft,outsubft : file_type;
79:
80: -- SWITCHES :
81:
82: invariant : boolean; -- true if the polynomials are invariant
83: equivaria : boolean; -- true if the system is equivariant
84: compmisu : boolean; -- if a mixed subdivision has to be computed
85: misufile : boolean; -- when the mixed subdivision has to be put on file
86: signsym : boolean; -- there is sign symmetry
87: allperms : boolean; -- equi-invariant w.r.t. all permutations
88: allsigns : boolean; -- equi-invariant w.r.t. all sign permutations
89: tosolve : boolean; -- on when the system has to be solved
90: torandq : boolean; -- on when random symmetric start system is solved
91:
92: procedure Read_Symmetry
93: ( n : in natural; pv,pw,fv,fw : in out List_of_Permutations;
94: fail : out boolean ) is
95:
96: -- DESCRIPTON :
97: -- Reads and builds representations of the symmetry groups.
98:
99: -- ON ENTRY :
100: -- n dimension;
101:
102: -- ON RETURN :
103: -- pv permutation symmetry on the unknowns;
104: -- pw effect of the group actions in pv on the equations;
105: -- fv contains pv, plus eventually sign symmetry;
106: -- fw effect of the group actions in fv on the equations;
107: -- fail when the polynomial system is not symmetric.
108:
109: ans : character;
110: nb : natural;
111: pg,fg : List_of_Permutations;
112:
113: begin
114: Read_Permutation_Group(n,pg,pv,allperms);
115: put("Is there a sign symmetry to take into account ? (y/n) ");
116: Ask_Yes_or_No(ans);
117: signsym := (ans = 'y');
118: if signsym
119: then
120: put("Is the system invariant under all changes of signs ? (y/n) ");
121: Ask_Yes_or_No(ans);
122: if ans = 'y'
123: then
124: allsigns := true;
125: fv := pv;
126: else
127: allsigns := false;
128: signsym := false; -- fv will contain these permutations
129: allperms := false; -- fv will be used for the generating solutions
130: put("The sign inversion of all elements is represented as ");
131: for i in 1..n loop
132: put('-');
133: declare
134: sb : Symbol;
135: begin
136: sb := (sb'range => ' ');
137: sb := Symbol_Table.get(i);
138: Symbol_Table_io.put(sb); put(" ");
139: end;
140: end loop;
141: new_line;
142: put("Give the number of generating elements in the group : ");
143: Read_Natural(nb);
144: put("Give "); put(nb,1);
145: put_line(" vector representations of the generating elements :");
146: Symbolic_Symmetry_Group_io.get(fg,n,nb);
147: put("Do you want the generation of the group ? (y/n) ");
148: Ask_Yes_or_No(ans);
149: if ans = 'y'
150: then fv := Generate(Union(fg,pv));
151: else fv := Union(fg,pv);
152: end if;
153: end if;
154: else
155: allsigns := false;
156: fv := pv;
157: end if;
158: new_line(file);
159: put_line(file,"THE SYMMETRY GROUP :");
160: new_line(file);
161: put_line(file,"v:"); Symbolic_Symmetry_Group_io.put(file,fv);
162: new_line(file);
163: Act(pv,p,pw,fail,invariant,equivaria);
164: if not Is_Null(fg)
165: then Act(fv,p,fw,fail,invariant,equivaria);
166: else fw := pw;
167: end if;
168: new_line(file);
169: put_line(file,"w:"); Symmetry_Group_io.put(file,fw); new_line(file);
170: if allsigns
171: then put_line(file,
172: "The system is invariant under all changes of signs.");
173: end if;
174: end Read_Symmetry;
175:
176: procedure Data_Management
177: ( n : in natural;
178: points : in out Arrays_of_Integer_Vector_Lists.
179: Array_of_Lists;
180: pv,pw,fv,fw : in List_of_Permutations; fltlif : out boolean;
181: mix : out Standard_Integer_Vectors.Link_to_Vector;
182: imixsub : out Integer_Mixed_Subdivisions.Mixed_Subdivision;
183: permp : out Poly_Sys ) is
184:
185: -- DESCRIPTION :
186: -- Allows to read in a mixed subdivision, determines type of mixture.
187:
188: -- ON ENTRY :
189: -- n dimension;
190: -- points supports;
191: -- pv permutation symmetry on the unknowns;
192: -- pw effect of the group actions in pv on the equations.
193: -- fv contains pv, eventually with sign symmetry;
194: -- fw effect of the group actions in fv on the equations.
195:
196: -- ON RETURN :
197: -- fltlif true when floating-point lifting is used, false otherwise;
198: -- mix type of mixture;
199: -- points ordered according to mix;
200: -- imixsub integer mixed subdivision;
201: -- permp system ordered according to mix.
202:
203: use Standard_Integer_Vectors;
204: use Arrays_of_Integer_Vector_Lists;
205: use Integer_Mixed_Subdivisions;
206:
207: tmpmix,perm : Link_to_Vector;
208: lifted_points : Array_of_Lists(p'range);
209: m : natural;
210: mixsub : Mixed_Subdivision;
211: ans : character;
212:
213: procedure Read_Subdivision is
214:
215: insubft : file_type;
216: nn,bkk : natural;
217:
218: begin
219: put_line("Reading the name of the input file.");
220: Read_Name_and_Open_File(insubft);
221: get(insubft,nn,m,tmpmix,mixsub);
222: Close(insubft);
223: new_line(file);
224: put_line(file,"MIXED SUBDIVISION :");
225: new_line(file);
226: put(file,nn,tmpmix.all,mixsub,bkk);
227: new_line(file);
228: compmisu := false;
229: fltlif := false;
230: imixsub := mixsub;
231: permp := p;
232: exception
233: when DATA_ERROR
234: => put_line("Data not in correct format. Will ignore it...");
235: Close(insubft);
236: end Read_Subdivision;
237:
238: begin
239: new_line;
240: put("Do you have already a mixed subdivision ? (y/n) ");
241: Ask_Yes_or_No(ans);
242: if ans = 'y'
243: then Read_Subdivision;
244: else compmisu := true;
245: end if;
246: if compmisu
247: then
248: put("Do you want to enforce the type of mixture ? (y/n) ");
249: Ask_Yes_or_No(ans);
250: if ans = 'y'
251: then put("Give the number of different supports : ");
252: Read_Natural(m);
253: put("Give the vector with occurencies : "); get(m,tmpmix);
254: permp := p;
255: else Compute_Mixture(points,tmpmix,perm);
256: permp := Permute(p,perm); Clear(perm);
257: end if;
258: put("Do you want to have the subdivision on separate file ? (y/n) ");
259: Ask_Yes_or_No(ans);
260: misufile := (ans = 'y');
261: if misufile
262: then put_line("Reading the name of the output file.");
263: Read_Name_and_Create_File(outsubft);
264: end if;
265: new_line(file);
266: put_line(file,"THE TYPE OF MIXTURE :");
267: new_line(file);
268: put(file,"The number of different supports : ");
269: put(file,tmpmix'last,1);
270: new_line(file);
271: put(file,"Vector indicating the occurrences : "); put(file,tmpmix);
272: new_line(file);
273: else
274: misufile := false;
275: end if;
276: mix := tmpmix;
277: end Data_Management;
278:
279: procedure Write_Generating_Cells
280: ( subfile : in file_type; n : in natural;
281: mix : in Standard_Integer_Vectors.Vector;
282: lifted : in Arrays_of_Integer_Vector_Lists.Array_of_Lists;
283: mixsub : in Integer_Mixed_Subdivisions.Mixed_Subdivision ) is
284:
285: -- DESCRIPTION :
286: -- Writes the list of generating cells on file, as the subdivision
287: -- of the cell that contains all lifted points.
288: -- By doing so, we will have no troubles recovering the lifting.
289:
290: use Arrays_of_Integer_Vector_Lists;
291: use Integer_Mixed_Subdivisions;
292:
293: genmic : Mixed_Cell;
294: genmixsub : Mixed_Subdivision;
295:
296: begin
297: genmic.nor := new Standard_Integer_Vectors.Vector'(1..n+1 => 0);
298: genmic.pts := new Array_of_Lists'(lifted);
299: genmic.sub := new Mixed_Subdivision'(mixsub);
300: Construct(genmic,genmixsub);
301: put(subfile,n,mix,genmixsub);
302: end Write_Generating_Cells;
303:
304: procedure Write_Generating_Cells
305: ( subfile : in file_type; n : in natural;
306: mix : in Standard_Integer_Vectors.Vector;
307: lifted : in Arrays_of_Floating_Vector_Lists.Array_of_Lists;
308: mixsub : in Floating_Mixed_Subdivisions.Mixed_Subdivision ) is
309:
310: -- DESCRIPTION :
311: -- Writes the list of generating cells on file, as the subdivision
312: -- of the cell that contains all lifted points.
313: -- By doing so, we will have no troubles recovering the lifting.
314:
315: use Arrays_of_Floating_Vector_Lists;
316: use Floating_Mixed_Subdivisions;
317:
318: genmic : Mixed_Cell;
319: genmixsub : Mixed_Subdivision;
320:
321: begin
322: genmic.nor := new Standard_Floating_Vectors.Vector'(1..n+1 => 0.0);
323: genmic.pts := new Array_of_Lists'(lifted);
324: genmic.sub := new Mixed_Subdivision'(mixsub);
325: Construct(genmic,genmixsub);
326: put(subfile,n,mix,genmixsub);
327: end Write_Generating_Cells;
328:
329: procedure Integer_Automatic_Lift_Orbits
330: ( file : in file_type; norb : in natural;
331: orbits : in out Arrays_of_Integer_Vector_Lists.
332: Array_of_Lists ) is
333:
334: -- DESCRIPTION :
335: -- Random integer numbers are generated and given to each orbit.
336:
337: lower,upper : integer;
338:
339: begin
340: new_line(file);
341: put_line(file,"AUTOMATIC RANDOM INTEGER LIFTING :");
342: new_line(file);
343: put("Give lower bound for random lifting : "); Read_Integer(lower);
344: put("Give upper bound for random lifting : "); Read_Integer(upper);
345: put(file," Lower bound for random lifting : ");
346: put(file,lower,1); new_line(file);
347: put(file," Upper bound for random lifting : ");
348: put(file,upper,1); new_line(file);
349: Integer_Random_Lift_Orbits(orbits,norb,lower,upper);
350: end Integer_Automatic_Lift_Orbits;
351:
352: procedure Float_Automatic_Lift_Orbits
353: ( file : in file_type; norb : in natural;
354: orbits : in out Arrays_of_Floating_Vector_Lists.
355: Array_of_Lists ) is
356:
357: -- DESCRIPTION :
358: -- Random floating-point numbers are generated and given to each orbit.
359:
360: lower,upper : double_float;
361:
362: begin
363: new_line(file);
364: put_line(file,"AUTOMATIC RANDOM FLOATING-POINT LIFTING :");
365: new_line(file);
366: put("Give lower bound for random lifting : "); Read_Double_Float(lower);
367: put("Give upper bound for random lifting : "); Read_Double_Float(upper);
368: put(file," Lower bound for random lifting : ");
369: put(file,lower,2,3,3); new_line(file);
370: put(file," Upper bound for random lifting : ");
371: put(file,upper,2,3,3); new_line(file);
372: Float_Random_Lift_Orbits(orbits,norb,lower,upper);
373: end Float_Automatic_Lift_Orbits;
374:
375: procedure Integer_Manual_Lift_Orbits
376: ( file : in file_type; norb : in natural;
377: orbits : in out Arrays_of_Integer_Vector_Lists.
378: Array_of_Lists ) is
379:
380: -- DESCRIPTION :
381: -- The user can give integer lifting values for every orbit.
382:
383: rv : Standard_Integer_Vectors.Vector(1..norb) := (1..norb => 0);
384:
385: begin
386: new_line(file);
387: put_line(file,"MANUAL INTEGER LIFTING :");
388: new_line(file);
389: put("Reading "); put(norb,1);
390: put_line(" integer numbers to lift orbits");
391: for i in rv'range loop
392: put(" give lifting for orbit "); put(i,1); put(" : ");
393: Read_Integer(rv(i));
394: end loop;
395: put_line(file," Lifting vector supplied by user :");
396: put(file,rv); new_line(file);
397: Integer_Lift_Orbits(orbits,rv);
398: end Integer_Manual_Lift_Orbits;
399:
400: procedure Float_Manual_Lift_Orbits
401: ( file : in file_type; norb : in natural;
402: orbits : in out Arrays_of_Floating_Vector_Lists.
403: Array_of_Lists ) is
404:
405: -- DESCRIPTION :
406: -- The user can give integer lifting values for every orbit.
407:
408: use Standard_Floating_Vectors;
409: rv : Standard_Floating_Vectors.Vector(1..norb) := (1..norb => 0.0);
410:
411: begin
412: new_line(file);
413: put_line(file,"MANUAL FLOATING-POINT LIFTING :");
414: new_line(file);
415: put("Reading "); put(norb,1);
416: put_line(" floating-point numbers to lift orbits");
417: for i in rv'range loop
418: put(" give lifting for orbit "); put(i,1); put(" : ");
419: Read_Double_Float(rv(i));
420: end loop;
421: put_line(file," Lifting vector supplied by user :");
422: Standard_Floating_Vectors_io.put(file,rv); new_line(file);
423: Float_Lift_Orbits(orbits,rv);
424: end Float_Manual_Lift_Orbits;
425:
426: procedure Classify_and_Lift_Orbits
427: ( file : in file_type;
428: mix : in Standard_Integer_Vectors.Vector;
429: points : in Arrays_of_Integer_Vector_Lists.Array_of_Lists;
430: pv,pw : in List_of_Permutations; fltlif : out boolean;
431: ilft : out Arrays_of_Integer_Vector_Lists.Array_of_Lists;
432: flft : out Arrays_of_Floating_Vector_Lists.Array_of_Lists ) is
433:
434: -- DESCRIPTION :
435: -- Classifies the points into orbits and lifts orbits.
436:
437: -- ON ENTRY :
438: -- file output file;
439: -- mix type of mixture;
440: -- points support sets;
441: -- pv representation of permutation symmetry;
442: -- pw effect of group actions on the system.
443:
444: -- ON RETURN :
445: -- fltlif true when floating-point lifting, false otherwise;
446: -- ilft integer-valued lifted supports;
447: -- flft floating-point lifted supports;
448:
449: ans : character;
450: cnt,norb : natural;
451: orbits : Arrays_of_Integer_Vector_Lists.Array_of_Lists(points'range);
452: fltorb : Arrays_of_Floating_Vector_Lists.Array_of_Lists(points'range);
453:
454: begin
455: new_line(file);
456: put_line(file,"CLASSIFICATION OF POINTS INTO ORBITS :");
457: new_line(file);
458: Classify_Orbits(points,mix,pv,pw,norb,orbits);
459: cnt := orbits'first;
460: new_line; put("Classified orbits,");
461: put_line(" last coordinate of vector is orbit number : ");
462: for k in mix'range loop
463: put("support no. "); put(cnt,1); put_line(" :"); put(orbits(cnt));
464: put(file,"support no. "); put(file,cnt,1);
465: put_line(file," :"); put(file,orbits(cnt));
466: cnt := cnt + mix(k);
467: end loop;
468: new_line;
469: put_line("MENU for Lifting of Orbits");
470: put(" 1. Integer Automatic : ");
471: put(norb,1); put_line(" random integer numbers as lifting.");
472: put(" 2. Manual : ");
473: put("you can give "); put(norb,1); put_line(" integer lifting values.");
474: put(" 3. Float Automatic : ");
475: put(norb,1); put_line(" random floating-point numbers as lifting.");
476: put(" 4. Manual : ");
477: put("you can give "); put(norb,1);
478: put_line(" floating-point lifting values.");
479: put("Type 1, 2, 3, or 4 to select lifting : ");
480: Ask_Alternative(ans,"1234");
481: case ans is
482: when '1' => Integer_Automatic_Lift_Orbits(file,norb,orbits);
483: ilft := orbits; fltlif := false;
484: when '2' => Integer_Manual_Lift_Orbits(file,norb,orbits);
485: ilft := orbits; fltlif := false;
486: when '3' => fltorb := Convert(orbits);
487: Float_Automatic_Lift_Orbits(file,norb,fltorb);
488: flft := fltorb; fltlif := true;
489: when '4' => fltorb := Convert(orbits);
490: Float_Manual_Lift_Orbits(file,norb,fltorb);
491: flft := fltorb; fltlif := true;
492: when others => null;
493: end case;
494: end Classify_and_Lift_Orbits;
495:
496: procedure Integer_Prune_for_Mixed_Cells
497: ( file : in file_type; n : in natural;
498: mix : in Standard_Integer_Vectors.Vector;
499: lifpts : in Arrays_of_Integer_Vector_Lists.Array_of_Lists;
500: pv : in List_of_Permutations;
501: mixsub : in out Integer_Mixed_Subdivisions.
502: Mixed_Subdivision ) is
503:
504: -- DESCRIPTION :
505: -- Given the lifted supports, the mixed cells will be computed.
506:
507: -- ON ENTRY :
508: -- file output file;
509: -- n dimension;
510: -- mix type of mixture;
511: -- lifpts lifted supports;
512: -- pv representation of permutation group.
513:
514: -- ON RETURN :
515: -- mixsub mixed cells;
516:
517: use Integer_Faces_of_Polytope;
518: use Integer_Mixed_Subdivisions;
519:
520: fa : Array_of_Faces(mix'range);
521: nbsucc,nbfail : Standard_Floating_Vectors.Vector(mix'range)
522: := (mix'range => 0.0);
523: timer : Timing_Widget;
524:
525: begin
526: tstart(timer);
527: for k in fa'range loop
528: fa(k) := Create_Lower(mix(k),n+1,lifpts(k));
529: end loop;
530: if invariant
531: then if allperms
532: then fa(fa'first) := Generating_Lifted_Faces(fa(fa'first));
533: else fa(fa'first) := Generating_Lifted_faces(pv,fa(fa'first));
534: end if;
535: end if;
536: tstop(timer);
537: new_line(file);
538: put_line(file,"CARDINALITIES OF THE LIFTED FACES :");
539: new_line(file);
540: for i in fa'range loop
541: put(file," # lifted "); put(file,mix(i),1);
542: put(file,"-faces of polytope "); put(file,i,1);
543: put(file," : "); put(file,Length_Of(fa(i)),1); new_line(file);
544: end loop;
545: new_line(file);
546: print_times(file,timer,"Creation of the Lower Faces");
547: new_line(file);
548: tstart(timer);
549: Create_CS(n,mix,fa,lifpts,nbsucc,nbfail,mixsub);
550: tstop(timer);
551: Pruning_Statistics(file,nbsucc,nbfail);
552: new_line(file);
553: print_times(file,timer,"Pruning for Mixed Cells");
554: end Integer_Prune_for_Mixed_Cells;
555:
556: procedure Float_Prune_for_Mixed_Cells
557: ( file : in file_type; n : in natural;
558: mix : in Standard_Integer_Vectors.Vector;
559: lifpts : in Arrays_of_Floating_Vector_Lists.Array_of_Lists;
560: pv : in List_of_Permutations;
561: mixsub : in out Floating_Mixed_Subdivisions.
562: Mixed_Subdivision ) is
563:
564: -- DESCRIPTION :
565: -- Given the lifted supports, the mixed cells will be computed.
566:
567: -- ON ENTRY :
568: -- file output file;
569: -- n dimension;
570: -- mix type of mixture;
571: -- lifpts lifted supports;
572: -- pv representation of permutation group.
573:
574: -- ON RETURN :
575: -- mixsub mixed cells;
576:
577: use Floating_Faces_of_Polytope;
578: use Floating_Mixed_Subdivisions;
579:
580: tol : constant double_float := 10.0**(-10);
581: fa : Array_of_Faces(mix'range);
582: nbsucc,nbfail : Standard_Floating_Vectors.Vector(mix'range)
583: := (mix'range => 0.0);
584: timer : Timing_Widget;
585:
586: begin
587: tstart(timer);
588: for k in fa'range loop
589: fa(k) := Create_Lower(mix(k),n+1,lifpts(k),tol);
590: end loop;
591: -- if invariant
592: -- then if allperms
593: -- then fa(fa'first) := Generating_Lifted_Faces(fa(fa'first));
594: -- else fa(fa'first) := Generating_Lifted_faces(pv,fa(fa'first));
595: -- end if;
596: -- end if;
597: tstop(timer);
598: new_line(file);
599: put_line(file,"CARDINALITIES OF THE LIFTED FACES :");
600: new_line(file);
601: for i in fa'range loop
602: put(file," # lifted "); put(file,mix(i),1);
603: put(file,"-faces of polytope "); put(file,i,1);
604: put(file," : "); put(file,Length_Of(fa(i)),1); new_line(file);
605: end loop;
606: new_line(file);
607: print_times(file,timer,"Creation of the Lower Faces");
608: new_line(file);
609: tstart(timer);
610: Create(n,mix,fa,lifpts,tol,nbsucc,nbfail,mixsub);
611: tstop(timer);
612: Pruning_Statistics(file,nbsucc,nbfail);
613: new_line(file);
614: print_times(file,timer,"Pruning for Mixed Cells");
615: end Float_Prune_for_Mixed_Cells;
616:
617: procedure Compute_Mixed_Volume
618: ( file : in file_type; n : in natural;
619: mix : in Standard_Integer_Vectors.Vector;
620: lifpts : in Arrays_of_Integer_Vector_Lists.Array_of_Lists;
621: mixsub : in out Integer_Mixed_Subdivisions.Mixed_Subdivision;
622: mv : out natural ) is
623:
624: -- DESCRIPTION :
625: -- Computes the mixed volume of the supports in lifpts and checks
626: -- on the mixed cells in the subdivision.
627: -- Results are written on the output file.
628:
629: -- ON ENTRY :
630: -- file output file;
631: -- n dimension;
632: -- mix type of mixture;
633: -- lifpts lifted supports;
634: -- mixsub list of mixed cells.
635:
636: -- ON RETURN :
637: -- mixsub can contain refinements of cells;
638: -- mv mixed volume.
639:
640: use Integer_Mixed_Subdivisions;
641:
642: timer : timing_widget;
643: bkk : natural;
644:
645: begin
646: new_line(file);
647: put_line(file,"THE LIFTED SUPPORTS :");
648: new_line(file);
649: put(file,lifpts);
650: new_line(file);
651: put_line(file,"VOLUME OF MIXED CELLS :");
652: new_line(file);
653: tstart(timer);
654: put(file,n,mix,mixsub,bkk);
655: mv := bkk;
656: tstop(timer);
657: new_line(file);
658: put(file,"The mixed volume : "); put(file,bkk,1); new_line(file);
659: new_line(file);
660: print_times(file,timer,"Volume computation of mixed cells");
661: new_line(file);
662: mixsub := Create(lifpts,mixsub);
663: new_line(file);
664: put_line(file,"COMPUTING AGAIN AFTER CHECKING :");
665: new_line(file);
666: tstart(timer);
667: put(file,n,mix,mixsub,bkk);
668: tstop(timer);
669: mv := bkk;
670: put(file,"The mixed volume : "); put(file,bkk,1); new_line(file);
671: new_line(file);
672: print_times(file,timer,"Checking the Mixed Volume Computation");
673: end Compute_Mixed_Volume;
674:
675: procedure Compute_Mixed_Volume
676: ( file : in file_type; n : in natural;
677: mix : in Standard_Integer_Vectors.Vector;
678: lifpts : in Arrays_of_Floating_Vector_Lists.Array_of_Lists;
679: mixsub : in out Floating_Mixed_Subdivisions.Mixed_Subdivision;
680: mv : out natural ) is
681:
682: -- DESCRIPTION :
683: -- Computes the mixed volume of the supports in lifpts.
684: -- Results are written on the output file.
685:
686: -- ON ENTRY :
687: -- file output file;
688: -- n dimension;
689: -- mix type of mixture;
690: -- lifpts lifted supports;
691: -- mixsub list of mixed cells.
692:
693: -- ON RETURN :
694: -- mixsub can contain refinements of cells;
695: -- mv mixed volume.
696:
697: timer : timing_widget;
698: bkk : natural;
699:
700: begin
701: new_line(file);
702: put_line(file,"THE LIFTED SUPPORTS :");
703: new_line(file);
704: put(file,lifpts);
705: new_line(file);
706: put_line(file,"VOLUME OF MIXED CELLS :");
707: new_line(file);
708: tstart(timer);
709: put(file,n,mix,mixsub,bkk);
710: mv := bkk;
711: tstop(timer);
712: new_line(file);
713: put(file,"The mixed volume : "); put(file,bkk,1); new_line(file);
714: new_line(file);
715: print_times(file,timer,"Volume computation of mixed cells");
716: end Compute_Mixed_Volume;
717:
718: procedure Generating_Mixed_Cells
719: ( file : in file_type; n : in natural;
720: points : in Arrays_of_Integer_Vector_Lists.Array_of_Lists;
721: pv,pw : in List_of_Permutations;
722: mix : in Standard_Integer_Vectors.Vector;
723: lorb : in Arrays_of_Integer_Vector_Lists.Array_of_Lists;
724: lifted : out Arrays_of_Integer_Vector_Lists.
725: Link_to_Array_of_Lists;
726: gensub : in out Integer_Mixed_Subdivisions.
727: Mixed_Subdivision ) is
728:
729: -- DESCRIPTION :
730: -- Computes a list of generating mixed cells.
731:
732: -- ON ENTRY :
733: -- file output file;
734: -- n dimension;
735: -- points support sets;
736: -- pv representation of permutation symmetry;
737: -- pw effect of group actions in pv on the system;
738: -- mix type of mixture;
739: -- lorb classified and lifted supports.
740:
741: -- ON RETURN :
742: -- lifted lifted points;
743: -- gensub generating cells.
744:
745: use Arrays_of_Integer_Vector_Lists;
746: use Integer_Mixed_Subdivisions;
747:
748: lifpts : Array_of_Lists(mix'range);
749: mixsub,genmixsub : Mixed_Subdivision;
750: index,bkk : natural;
751: timer : timing_widget;
752:
753: begin
754: if compmisu
755: then index := lorb'first;
756: for k in lifpts'range loop
757: lifpts(k) := lorb(index);
758: index := index + mix(k);
759: end loop;
760: Integer_Prune_for_Mixed_Cells(file,n,mix,lifpts,pv,mixsub);
761: Compute_Mixed_Volume(file,n,mix,lifpts,mixsub,mv);
762: tstart(timer);
763: if allperms
764: then genmixsub := Generating_Cells(mixsub);
765: else genmixsub := Generating_Cells(pv,pw,mix,mixsub);
766: end if;
767: new_line(file);
768: put_line(file,"THE GENERATING CELLS :");
769: new_line(file);
770: put(file,n,mix,genmixsub,bkk);
771: tstop(timer);
772: if misufile
773: then Write_Generating_Cells(outsubft,n,mix,lifpts,genmixsub);
774: end if;
775: new_line(file);
776: put(file,"Number of generating solutions : "); put(file,bkk,1);
777: new_line(file); new_line(file);
778: print_times(file,timer,"Computing generating cells");
779: gensub := genmixsub;
780: else lifpts := Induced_Lifting(n,mix,points,gensub);
781: new_line(file);
782: put_line(file,"THE LIFTED SUPPORTS :");
783: new_line(file);
784: put(file,lifpts);
785: new_line(file);
786: end if;
787: lifted := new Array_of_Lists'(lifpts);
788: end Generating_Mixed_Cells;
789:
790: procedure Generating_Mixed_Cells
791: ( file : in file_type; n : in natural;
792: points : in Arrays_of_Integer_Vector_Lists.Array_of_Lists;
793: pv,pw : in List_of_Permutations;
794: mix : in Standard_Integer_Vectors.Vector;
795: lorb : in Arrays_of_Floating_Vector_Lists.Array_of_Lists;
796: lifted : out Arrays_of_Floating_Vector_Lists.
797: Link_to_Array_of_Lists;
798: gensub : out Floating_Mixed_Subdivisions.
799: Mixed_Subdivision ) is
800:
801: -- DESCRIPTION :
802: -- Computes a list of generating mixed cells.
803:
804: -- ON ENTRY :
805: -- file output file;
806: -- n dimension;
807: -- points support sets;
808: -- pv representation of permutation symmetry;
809: -- pw effect of group actions in pv on the system;
810: -- mix type of mixture;
811: -- lorb classified and lifted supports.
812:
813: use Arrays_of_Floating_Vector_Lists;
814: use Floating_Mixed_Subdivisions;
815:
816: fpoints,lifpts : Array_of_Lists(mix'range);
817: mixsub,genmixsub : Mixed_Subdivision;
818: index,bkk : natural;
819: timer : timing_widget;
820:
821: begin
822: if compmisu
823: then index := lorb'first;
824: for k in lifpts'range loop
825: lifpts(k) := lorb(index);
826: index := index + mix(k);
827: end loop;
828: Float_Prune_for_Mixed_Cells(file,n,mix,lifpts,pv,mixsub);
829: Compute_Mixed_Volume(file,n,mix,lifpts,mixsub,mv);
830: else fpoints := Convert(points);
831: lifpts := Induced_Lifting(n,mix,fpoints,mixsub);
832: new_line(file);
833: put_line(file,"THE LIFTED SUPPORTS : ");
834: new_line(file);
835: put(file,lifpts);
836: new_line(file);
837: end if;
838: tstart(timer);
839: if allperms
840: then genmixsub := Generating_Cells(mixsub);
841: else genmixsub := Generating_Cells(pv,pw,mix,mixsub);
842: end if;
843: new_line(file);
844: put_line(file,"THE GENERATING CELLS :");
845: new_line(file);
846: put(file,n,mix,genmixsub,bkk);
847: tstop(timer);
848: if misufile
849: then Write_Generating_Cells(outsubft,n,mix,lifpts,genmixsub);
850: end if;
851: new_line(file);
852: put(file,"Number of generating solutions : "); put(file,bkk,1);
853: new_line(file); new_line(file);
854: print_times(file,timer,"Computing generating cells");
855: lifted := new Array_of_Lists'(lifpts);
856: gensub := genmixsub;
857: end Generating_Mixed_Cells;
858:
859: procedure Settings_for_Polyhedral_Continuation is
860:
861: -- DESCRIPTION :
862: -- Displays the menu and allows the user to set the parameters.
863:
864: ans : character;
865: oc : natural;
866:
867: begin
868: new_line;
869: put_line("MENU for Symmetric Polyhedral Continuation : ");
870: put_line(" 0. No polyhedral continuation, leave the menu.");
871: put_line(" 1. Solve given system by polyhedral continuation.");
872: put_line(" 2. Create and solve random coefficient system.");
873: put("Type 0,1, or 2 to choose : "); Ask_Alternative(ans,"012");
874: tosolve := not (ans = '0');
875: torandq := (ans = '2');
876: if tosolve
877: then if torandq
878: then
879: put_line("Reading a name of a file to write start system on.");
880: Read_Name_and_Create_File(gft);
881: else
882: new_line;
883: put_line
884: ("Reading a name of a file to write start solutions on.");
885: Read_Name_and_Create_File(solsft);
886: end if;
887: new_line;
888: Driver_for_Continuation_Parameters(file);
889: new_line;
890: Driver_for_Process_io(file,oc);
891: end if;
892: if byebye
893: then new_line;
894: put_line("No more input expected. See output file for results.");
895: new_line;
896: else new_line;
897: put_line("Starting the Computations ...");
898: new_line;
899: end if;
900: end Settings_for_Polyhedral_Continuation;
901:
902: procedure Symmetric_Polyhedral_Continuation
903: ( file : in file_type;
904: pp : in Poly_Sys; fv,fw : List_of_Permutations;
905: n : in natural; mix : in Standard_Integer_Vectors.Vector;
906: lifpts : in Arrays_of_Integer_Vector_Lists.Array_of_Lists;
907: gensub : in Integer_Mixed_Subdivisions.
908: Mixed_Subdivision ) is
909:
910: -- DESCRIPTION :
911: -- Constructs and solves a symmetric random-coefficient start system.
912:
913: -- ON ENTRY :
914: -- file output file;
915: -- pp polynomial system, ordered according to mixture;
916: -- fv representation of symmetry group;
917: -- fw effect on group actions on system;
918: -- n dimension;
919: -- mix type of mixture;
920: -- lifpts lifted points;
921: -- gensub generating mixed cells.
922:
923: use Arrays_of_Integer_Vector_Lists;
924: use Integer_Mixed_Subdivisions;
925:
926: lq,lifted_lq : Laur_Sys(p'range);
927: lp : Laur_Sys(p'range);
928: qq : Poly_Sys(p'range);
929: qqsols : Solution_List;
930: timer : timing_widget;
931:
932: begin
933: new_line(file);
934: put_line(file,"COMPUTING THE GENERATING SOLUTIONS :");
935: new_line(file);
936: tstart(timer);
937: lp := Polynomial_to_Laurent_System(pp);
938: if torandq
939: then lq := Symmetric_Randomize(lp,fv,fw);
940: qq := Laurent_to_Polynomial_System(lq); q := qq;
941: put(gft,qq);
942: else lq := lp; q := p;
943: end if;
944: lifted_lq := Perform_Lifting(n,mix,lifpts,lq);
945: if allperms
946: then qqsols := Symmetric_Mixed_Solve
947: (file,signsym,lifted_lq,gensub,n,mix);
948: else qqsols := Symmetric_Mixed_Solve
949: (file,fv,signsym,lifted_lq,gensub,n,mix);
950: end if;
951: tstop(timer);
952: new_line(file);
953: put(file,qqsols);
954: if torandq
955: then new_line(gft);
956: put_line(gft,"THE GENERATING SOLUTIONS :"); new_line(gft);
957: put(gft,Length_Of(qqsols),n,qqsols);
958: Close(gft);
959: else put(solsft,Length_Of(qqsols),n,qqsols);
960: Close(solsft);
961: end if;
962: new_line(file);
963: print_times(file,timer,"Symmetric polyhedral continuation");
964: qsols := qqsols;
965: end Symmetric_Polyhedral_Continuation;
966:
967: procedure Main_Driver is
968:
969: n : constant natural := p'length;
970: timer : timing_widget;
971: notsym : boolean;
972: pv,pw,fv,fw : List_of_Permutations;
973: igencells : Integer_Mixed_Subdivisions.Mixed_Subdivision;
974: fgencells : Floating_Mixed_Subdivisions.Mixed_Subdivision;
975: mix : Standard_Integer_Vectors.Link_to_Vector;
976: permp : Poly_Sys(p'range);
977: points,iliforb : Arrays_of_Integer_Vector_Lists.Array_of_Lists(p'range);
978: fliforb : Arrays_of_Floating_Vector_Lists.Array_of_Lists(p'range);
979: fltlif : boolean;
980: ilifpts : Arrays_of_Integer_Vector_Lists.Link_to_Array_of_Lists;
981: flifpts : Arrays_of_Floating_Vector_Lists.Link_to_Array_of_Lists;
982:
983: begin
984: new_line; put_line(welcome);
985: tstart(timer);
986: Read_Symmetry(n,pv,pw,fv,fw,notsym);
987: if notsym
988: then put_line("The given system is not symmetric !");
989: put_line(file,"The given system is not symmetric !");
990: else points := Create(p);
991: Data_Management(n,points,pv,pw,fv,fw,fltlif,mix,igencells,permp);
992: if compmisu
993: then Classify_and_Lift_Orbits
994: (file,mix.all,points,pv,pw,fltlif,iliforb,fliforb);
995: end if;
996: Settings_for_Polyhedral_Continuation;
997: tstart(timer);
998: if fltlif
999: then
1000: Generating_Mixed_Cells
1001: (file,n,points,pv,pw,mix.all,fliforb,flifpts,fgencells);
1002: else
1003: Generating_Mixed_Cells
1004: (file,n,points,pv,pw,mix.all,iliforb,ilifpts,igencells);
1005: if tosolve
1006: then Symmetric_Polyhedral_Continuation
1007: (file,permp,fv,fw,n,mix.all,ilifpts.all,igencells);
1008: end if;
1009: end if;
1010: end if;
1011: tstop(timer);
1012: new_line(file);
1013: print_times(file,timer,"All Computations");
1014: end Main_Driver;
1015:
1016: begin
1017: Main_Driver;
1018: end Driver_for_Symmetric_Mixed_Volume_Computation;
1019:
1020: end Drivers_for_Symmetric_Lifting;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to drivers_for_symmetric_lifting.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