Return to mainsmvc.adb CVS log

Up to [local] / OpenXM_contrib / PHC / Ada / Root_Counts / Symmetry

Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Symmetry/mainsmvc.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 Standard_Floating_Numbers;          use Standard_Floating_Numbers;
                      4: with Standard_Complex_Poly_Systems;      use Standard_Complex_Poly_Systems;
                      5: with Standard_Complex_Poly_Systems_io;   use Standard_Complex_Poly_Systems_io;
                      6: with Standard_Complex_Solutions;         use Standard_Complex_Solutions;
                      7: with Standard_Root_Refiners;             use Standard_Root_Refiners;
                      8: with Drivers_for_Implicit_Lifting;       use Drivers_for_Implicit_Lifting;
                      9: with Drivers_for_Static_Lifting;         use Drivers_for_Static_Lifting;
                     10: with Drivers_for_Dynamic_Lifting;        use Drivers_for_Dynamic_Lifting;
                     11: with Drivers_for_Symmetric_Lifting;      use Drivers_for_Symmetric_Lifting;
                     12:
                     13: procedure mainsmvc ( infilename,outfilename : in string ) is
                     14:
                     15:   outft : file_type;
                     16:   lp : Link_to_Poly_Sys;
                     17:   ans : character;
                     18:
                     19:   procedure Read_System ( filename : in string ) is
                     20:
                     21:     file : file_type;
                     22:     n : natural;
                     23:
                     24:   begin
                     25:     if filename /= ""
                     26:      then Open(file,in_file,filename);
                     27:           get(file,n);
                     28:           lp := new Poly_Sys(1..n);
                     29:           get(file,n,lp.all);
                     30:           Close(file);
                     31:     end if;
                     32:   exception
                     33:     when others => put_line("Something is wrong with argument file...");
                     34:                    lp := null; return;
                     35:   end Read_System;
                     36:
                     37:   function Lifting_Strategy return natural is
                     38:
                     39:     choice : string(1..2) := "  ";
                     40:
                     41:   begin
                     42:     loop
                     43:       new_line;
                     44:       put_line("MENU with available Lifting Strategies :");
                     45:       put_line("  1. Implicit lifting  : based on recursive formula.");
                     46:       put_line("  2. Static lifting    : lift points and prune lower hull.");
                     47:       put_line("  3. Dynamic lifting   : incrementally add the points.");
                     48:       put_line
                     49:           ("  4. Symmetric lifting : points in same orbit get same lifting.");
                     50:       put("Type 1, 2, 3, or 4 to select lifting,"
                     51:                 & " eventually preceded by i for info : ");
                     52:       Ask_Alternative(choice,"1234",'i');
                     53:       exit when choice(1) /= 'i';
                     54:       new_line;
                     55:       case choice(2) is
                     56:         when '1' => Implicit_Lifting_Info; new_line;
                     57:                     put("Do you want to apply implicit lifting ? (y/n) ");
                     58:                     Ask_Yes_or_No(ans);
                     59:                     if ans = 'y'
                     60:                      then choice(1) := '1';
                     61:                     end if;
                     62:         when '2' => Static_Lifting_Info; new_line;
                     63:                     put("Do you want to apply static lifting ? (y/n) ");
                     64:                     Ask_Yes_or_No(ans);
                     65:                     if ans = 'y'
                     66:                      then choice(1) := '2';
                     67:                     end if;
                     68:         when '3' => Dynamic_Lifting_Info; new_line;
                     69:                     put("Do you want to apply dynamic lifting ? (y/n) ");
                     70:                     Ask_Yes_or_No(ans);
                     71:                     if ans = 'y'
                     72:                      then choice(1) := '3';
                     73:                     end if;
                     74:         when '4' => Symmetric_Lifting_Info; new_line;
                     75:                     put("Do you want to apply implicit lifting ? (y/n) ");
                     76:                     Ask_Yes_or_No(ans);
                     77:                     if ans = 'y'
                     78:                      then choice(1) := '4';
                     79:                     end if;
                     80:         when others => put_line("No information available.");
                     81:       end case;
                     82:       exit when choice(1) /= 'i';
                     83:     end loop;
                     84:     case choice(1) is
                     85:       when '1'    => return 1;
                     86:       when '2'    => return 2;
                     87:       when '3'    => return 3;
                     88:       when others => return 4;
                     89:     end case;
                     90:   end Lifting_Strategy;
                     91:
                     92: begin
                     93:   Read_System(infilename);
                     94:   if lp = null
                     95:    then new_line; get(lp);
                     96:   end if;
                     97:   declare
                     98:     q : Poly_Sys(lp'range);
                     99:     qsols : Solution_List;
                    100:     mv : natural;
                    101:     strategy : natural;
                    102:   begin
                    103:     Create_Output_File(outft,outfilename);
                    104:     put(outft,lp'last,lp.all);
                    105:     strategy := Lifting_Strategy;
                    106:     new_line(outft);
                    107:     case strategy is
                    108:       when 1 => put_line(outft,"IMPLICIT LIFTING");
                    109:                 Driver_for_Mixture_Bezout_BKK(outft,lp.all,true,q,qsols,mv);
                    110:       when 2 => put_line(outft,"STATIC LIFTING");
                    111:                 Driver_for_Mixed_Volume_Computation
                    112:                                              (outft,lp.all,true,q,qsols,mv);
                    113:       when 3 => put_line(outft,"DYNAMIC LIFTING");
                    114:                 Driver_for_Dynamic_Mixed_Volume_Computation
                    115:                                              (outft,lp.all,true,q,qsols,mv);
                    116:       when others => put_line(outft,"SYMMETRIC LIFTING");
                    117:                 Driver_for_Symmetric_Mixed_Volume_Computation
                    118:                                              (outft,lp.all,true,q,qsols,mv);
                    119:     end case;
                    120:     if Length_Of(qsols) > 0
                    121:      then declare
                    122:             epsxa,epsfa : constant double_float := 10.0**(-8);
                    123:             tolsing : constant double_float := 10.0**(-8);
                    124:             nb : natural := 0;
                    125:           begin
                    126:             new_line(outft);
                    127:             Reporting_Root_Refiner
                    128:               (outft,q,qsols,epsxa,epsfa,tolsing,nb,5,false);
                    129:           end;
                    130:     end if;
                    131:     Close(outft);
                    132:   end;
                    133: end mainsmvc;