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     ! 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;