Return to phcpack.adb CVS log

Up to [local] / OpenXM_contrib / PHC / Ada / Main

Annotation of OpenXM_contrib/PHC/Ada/Main/phcpack.adb, Revision 1.1

1.1     ! maekawa     1: with Standard_Floating_Numbers;          use Standard_Floating_Numbers;
        !             2: with Standard_Complex_Vectors;           use Standard_Complex_Vectors;
        !             3: with Standard_Complex_Norms_Equals;      use Standard_Complex_Norms_Equals;
        !             4: with Standard_Complex_Matrices;          use Standard_Complex_Matrices;
        !             5: with Standard_Complex_Poly_Systems_io;   use Standard_Complex_Poly_Systems_io;
        !             6: with Standard_Complex_Poly_Randomizers;  use Standard_Complex_Poly_Randomizers;
        !             7: with Scaling;                            use Scaling;
        !             8: with Reduction_of_Polynomial_Systems;    use Reduction_of_Polynomial_Systems;
        !             9: with Homotopy;
        !            10: with Total_Degree_Start_Systems;         use Total_Degree_Start_Systems;
        !            11: with BKK_Bound_Computations;             use BKK_Bound_Computations;
        !            12: with Continuation_Parameters;
        !            13: with Increment_and_Fix_Continuation;     use Increment_and_Fix_Continuation;
        !            14: with Standard_Root_Refiners;             use Standard_Root_Refiners;
        !            15:
        !            16: package body PHCPACK is
        !            17:
        !            18: -- 1. PRE-PROCESSING : SCALING AND REDUCTION
        !            19:
        !            20:   procedure Equation_Scaling
        !            21:                 ( file : in file_type; p : in Poly_Sys; s : out Poly_Sys ) is
        !            22:
        !            23:     res : Poly_Sys(p'range);
        !            24:
        !            25:   begin
        !            26:     Copy(p,res);
        !            27:     Scale(res);
        !            28:     put(file,res);
        !            29:     s := res;
        !            30:   end Equation_Scaling;
        !            31:
        !            32:   procedure Linear_Reduction
        !            33:                 ( file : in file_type; p : in Poly_Sys; r : out Poly_Sys ) is
        !            34:
        !            35:     res : Poly_Sys(p'range);
        !            36:     success,inconsistent,infinite : boolean := false;
        !            37:
        !            38:   begin
        !            39:     Copy(p,res);
        !            40:     reduce(res,success,inconsistent,infinite);
        !            41:     if success
        !            42:      then if inconsistent
        !            43:            then put_line(file,"system is inconsistent");
        !            44:           end if;
        !            45:           if infinite
        !            46:            then put_line(file,"system has infinite number of solutions");
        !            47:           end if;
        !            48:     end if;
        !            49:     put(file,res);
        !            50:     r := res;
        !            51:   end Linear_Reduction;
        !            52:
        !            53: -- 2. ROOT COUNTING AND CONSTRUCTION OF START SYSTEM
        !            54:
        !            55:   procedure Total_Degree
        !            56:                 ( file : in file_type; p : in Poly_Sys; d : out natural ) is
        !            57:   begin
        !            58:     d := Total_Degree(p);
        !            59:   end Total_Degree;
        !            60:
        !            61:   procedure Total_Degree
        !            62:                 ( file : in file_type; p : in Poly_Sys; d : out natural;
        !            63:                   q : out Poly_Sys; qsols : out Solution_List ) is
        !            64:
        !            65:     qq : Poly_Sys(p'range);
        !            66:     qqsols : Solution_List;
        !            67:
        !            68:   begin
        !            69:     d := Total_Degree(p);
        !            70:     Start_System(p,qq,qqsols);
        !            71:     q := qq; qsols := qqsols;
        !            72:   end Total_Degree;
        !            73:
        !            74:   procedure Implicit_Lifting
        !            75:                  ( file : in file_type; p : in Poly_Sys; mv : out natural ) is
        !            76:   begin
        !            77:     mv := BKK_by_Implicit_Lifting(p);
        !            78:   end Implicit_Lifting;
        !            79:
        !            80:   procedure Implicit_Lifting
        !            81:                  ( file : in file_type; p : in Poly_Sys; mv : out natural;
        !            82:                    q : out Poly_Sys; qsols : out Solution_List ) is
        !            83:
        !            84:     qq : Poly_Sys(p'range) := Complex_Randomize1(p);
        !            85:     qqsols : Solution_List := Solve_by_Implicit_Lifting(file,qq);
        !            86:
        !            87:   begin
        !            88:     mv := Length_Of(qqsols);
        !            89:     Set_Continuation_Parameter(qqsols,Create(0.0));
        !            90:     q := qq; qsols := qqsols;
        !            91:   end Implicit_Lifting;
        !            92:
        !            93:   procedure Static_Lifting
        !            94:                  ( file : in file_type; p : in Poly_Sys; mv : out natural ) is
        !            95:   begin
        !            96:     mv := BKK_by_Static_Lifting(file,p);
        !            97:   end Static_Lifting;
        !            98:
        !            99:   procedure Static_Lifting
        !           100:                  ( file : in file_type; p : in Poly_Sys; mv : out natural;
        !           101:                    q : out Poly_Sys; qsols : out Solution_List ) is
        !           102:
        !           103:     qq : Poly_Sys(p'range) := Complex_Randomize1(p);
        !           104:     qqsols : Solution_List := Solve_by_Static_Lifting(file,qq);
        !           105:
        !           106:   begin
        !           107:     mv := Length_Of(qqsols);
        !           108:     Set_Continuation_Parameter(qqsols,Create(0.0));
        !           109:     q := qq; qsols := qqsols;
        !           110:   end Static_Lifting;
        !           111:
        !           112: -- 3. POLYNOMIAL CONTINUATION
        !           113:
        !           114:   procedure Artificial_Parameter_Continuation
        !           115:                  ( file : in file_type; p,q : in Poly_Sys;
        !           116:                    sols : in out Solution_List;
        !           117:                    k : in natural := 2;
        !           118:                    a : in Complex_Number := Create(1.0);
        !           119:                    target : in Complex_Number := Create(1.0) ) is
        !           120:
        !           121:     procedure Cont is
        !           122:       new Reporting_Continue(Max_Norm,
        !           123:                              Homotopy.Eval,Homotopy.Eval,Homotopy.Diff);
        !           124:
        !           125:   begin
        !           126:     Homotopy.Create(p,q,k,a);
        !           127:     Continuation_Parameters.Tune(0);
        !           128:     Cont(file,sols,false,target);
        !           129:     Homotopy.Clear;
        !           130:   end Artificial_Parameter_Continuation;
        !           131:
        !           132:   procedure Natural_Parameter_Continuation
        !           133:                  ( file : in file_type; h : in Poly_Sys; k : in natural;
        !           134:                    t0,t1 : in Complex_Number; sols : in out Solution_List ) is
        !           135:   begin
        !           136:     null;
        !           137:   end Natural_Parameter_Continuation;
        !           138:
        !           139: -- 4. POST-PROCESSING : VALIDATION
        !           140:
        !           141:   procedure Refine_Roots
        !           142:                  ( file : in file_type; p : in Poly_Sys;
        !           143:                    sols : in out Solution_List ) is
        !           144:
        !           145:     epsxa,epsfa : constant double_float := 10.0**(-8);   -- defaults
        !           146:     tolsing : constant double_float := 10.0**(-8);
        !           147:     maxit : constant natural := 3;
        !           148:     numit : natural := 0;
        !           149:
        !           150:   begin
        !           151:     Reporting_Root_Refiner(file,p,sols,epsxa,epsfa,tolsing,numit,maxit,false);
        !           152:   end Refine_Roots;
        !           153:
        !           154: end PHCPACK;