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

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;