Return to homotopy_evaluator_packages.adb CVS log

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

Annotation of OpenXM_contrib/PHC/Ada/Homotopy/homotopy_evaluator_packages.adb, Revision 1.1

1.1     ! maekawa     1: with text_io;                            use text_io;
        !             2: with Standard_Evaluator_Packages;        use Standard_Evaluator_Packages;
        !             3:
        !             4: package body Homotopy_Evaluator_Packages is
        !             5:
        !             6:   procedure Create_Homotopy_Constants ( file : in file_type ) is
        !             7:
        !             8:   -- DESCRIPTION :
        !             9:   --   Writes the code to initialize the homotopy constants.
        !            10:
        !            11:   begin
        !            12:     put_line(file,
        !            13:       "  procedure Homotopy_Constants ( a : in Complex_Number; "
        !            14:                                      & "k : in positive ) is");
        !            15:     put_line(file,"  begin");
        !            16:     put_line(file,"    aa := a;");
        !            17:     put_line(file,"    kk := k;");
        !            18:     put_line(file,"  end Homotopy_Constants;");
        !            19:   end Create_Homotopy_Constants;
        !            20:
        !            21:   procedure Create_Inline_Homotopy_Evaluator ( file : in file_type ) is
        !            22:
        !            23:   -- DESCRIPTION :
        !            24:   --   Writes the code to evaluate the homotopy.
        !            25:
        !            26:   begin
        !            27:     put_line(file,
        !            28:       "  function Eval_Homotopy ( x : Vector; t : Complex_Number ) "
        !            29:            & "return Vector is");
        !            30:     new_line(file);
        !            31:     put_line(file,"    y : Vector(x'range);                                  ");
        !            32:     put_line(file,"    eval_target : Vector(x'range) := Eval_Target_Sys(x);  ");
        !            33:     put_line(file,"    eval_astart : Vector(x'range) := aa*Eval_Start_Sys(x);");
        !            34:     put_line(file,"    tpk : constant Complex_Number := t**kk;               ");
        !            35:     put_line(file,"    mtk : constant Complex_Number := (Create(1.0)-t)**kk; ");
        !            36:     new_line(file);
        !            37:     put_line(file,"  begin");
        !            38:     put_line(file,"    for i in y'range loop");
        !            39:     put_line(file,"      y(i) := mtk*eval_astart(i) + tpk*eval_target(i);");
        !            40:     put_line(file,"    end loop;");
        !            41:     put_line(file,"    return y;");
        !            42:     put_line(file,"  end Eval_Homotopy;");
        !            43:   end Create_Inline_Homotopy_Evaluator;
        !            44:
        !            45:   procedure Create_Inline_Homotopy_Differentiator1 ( file : in file_type ) is
        !            46:
        !            47:   -- DESCRIPTION :
        !            48:   --   Writes the code to differentiate the homotopy w.r.t. the variables.
        !            49:
        !            50:   begin
        !            51:     put_line(file,
        !            52:       "  function Diff_Homotopy ( x : Vector; t : Complex_Number ) "
        !            53:            & "return Matrix is");
        !            54:     new_line(file);
        !            55:     put_line(file,"    y : Matrix(x'range,x'range);                          ");
        !            56:     put_line(file,"    eval_target : Matrix(x'range,x'range)"
        !            57:                                & " := Eval_Target_Jaco(x);  ");
        !            58:     put_line(file,"    eval_astart : Matrix(x'range,x'range)"
        !            59:                                & " := Eval_Start_Jaco(x);");
        !            60:     put_line(file,"    tpk : constant Complex_Number := t**kk;               ");
        !            61:     put_line(file,"    mtk : constant Complex_Number"
        !            62:                        & " := aa*(Create(1.0)-t)**kk; ");
        !            63:     new_line(file);
        !            64:     put_line(file,"  begin");
        !            65:     put_line(file,"    for i in y'range(1) loop");
        !            66:     put_line(file,"      for j in y'range(2) loop");
        !            67:     put_line(file,"        y(i,j) := mtk*eval_astart(i,j) "
        !            68:                                 & "+ tpk*eval_target(i,j);");
        !            69:     put_line(file,"      end loop;");
        !            70:     put_line(file,"    end loop;");
        !            71:     put_line(file,"    return y;");
        !            72:     put_line(file,"  end Diff_Homotopy;");
        !            73:   end Create_Inline_Homotopy_Differentiator1;
        !            74:
        !            75:   procedure Create_Inline_Homotopy_Differentiator2 ( file : in file_type ) is
        !            76:
        !            77:   -- DESCRIPTION :
        !            78:   --   Writes the code to differentiate the homotopy w.r.t. t.
        !            79:
        !            80:   begin
        !            81:     put_line(file,
        !            82:       "  function Diff_Homotopy ( x : Vector; t : Complex_Number ) "
        !            83:            & "return Vector is");
        !            84:     new_line(file);
        !            85:     put_line(file,"    y : Vector(x'range);");
        !            86:     new_line(file);
        !            87:     put_line(file,"  begin");
        !            88:     put_line(file,"    return y;");
        !            89:     put_line(file,"  end Diff_Homotopy;");
        !            90:   end Create_Inline_Homotopy_Differentiator2;
        !            91:
        !            92:   procedure Create_Package_Specification
        !            93:                 ( file : in file_type; packname : in String ) is
        !            94:
        !            95:   -- DESCRIPTION :
        !            96:   --   Writes the specification of the homotopy evaluator package.
        !            97:
        !            98:   begin
        !            99:     put_line(file,"with Standard_Complex_Numbers;           "
        !           100:                  & "use Standard_Complex_Numbers;");
        !           101:     put_line(file,"with Standard_Complex_Vectors;           "
        !           102:                  & "use Standard_Complex_Vectors;");
        !           103:     put_line(file,"with Standard_Complex_Matrices;          "
        !           104:                  & "use Standard_Complex_Matrices;");
        !           105:     new_line(file);
        !           106:     put_line(file,"package " & packname & " is");
        !           107:     new_line(file);
        !           108:     put_line(file,
        !           109:       "  procedure Homotopy_Constants ( a : in Complex_Number; "
        !           110:                                      & "k : in positive );");
        !           111:     new_line(file);
        !           112:     put_line(file,
        !           113:       "  function Eval_Homotopy ( x : Vector; t : Complex_Number ) "
        !           114:            & "return Vector;");
        !           115:     put_line(file,
        !           116:       "  function Diff_Homotopy ( x : Vector; t : Complex_Number ) "
        !           117:            & "return Matrix;");
        !           118:     put_line(file,
        !           119:       "  function Diff_Homotopy ( x : Vector; t : Complex_Number ) "
        !           120:            & "return Vector;");
        !           121:     new_line(file);
        !           122:     put_line(file,"end " & packname & ";");
        !           123:   end Create_Package_Specification;
        !           124:
        !           125:   procedure Create_Package_Implementation
        !           126:                  ( file : in file_type; packname : in String;
        !           127:                    p,q : in Poly_Sys ) is
        !           128:
        !           129:   -- DESCRIPTION :
        !           130:   --   Writes the implementation of the homotopy evaluator package.
        !           131:
        !           132:   begin
        !           133:     put_line(file,"with Standard_Floating_Numbers;          "
        !           134:                  & "use Standard_Floating_Numbers;");
        !           135:     new_line(file);
        !           136:     put_line(file,"package body " & packname & " is");
        !           137:     new_line(file);
        !           138:     put_line(file,"  aa : Complex_Number;");
        !           139:     put_line(file,"  kk : positive;");
        !           140:     new_line(file);
        !           141:     Create_Inline_System_Evaluator(file,"Eval_Target_Sys",p);
        !           142:     new_line(file);
        !           143:     Create_Inline_System_Evaluator(file,"Eval_Start_Sys",q);
        !           144:     new_line(file);
        !           145:     Create_Inline_Jacobian_Evaluator(file,"Eval_Target_Jaco",p);
        !           146:     new_line(file);
        !           147:     Create_Inline_Jacobian_Evaluator(file,"Eval_Start_Jaco",q);
        !           148:     new_line(file);
        !           149:     Create_Homotopy_Constants(file);
        !           150:     new_line(file);
        !           151:     Create_Inline_Homotopy_Evaluator(file);
        !           152:     new_line(file);
        !           153:     Create_Inline_Homotopy_Differentiator1(file);
        !           154:     new_line(file);
        !           155:     Create_Inline_Homotopy_Differentiator2(file);
        !           156:     new_line(file);
        !           157:     put_line(file,"end " & packname & ";");
        !           158:   end Create_Package_Implementation;
        !           159:
        !           160:   procedure Create ( packname : in String; p,q : in Poly_Sys ) is
        !           161:
        !           162:     specfile,bodyfile : file_type;
        !           163:
        !           164:   begin
        !           165:     Replace_Symbols;
        !           166:     Create(specfile,out_file,packname & ".ads");
        !           167:     Create_Package_Specification(specfile,packname);
        !           168:     Close(specfile);
        !           169:     Create(bodyfile,out_file,packname & ".adb");
        !           170:     Create_Package_Implementation(bodyfile,packname,p,q);
        !           171:     Close(bodyfile);
        !           172:   end Create;
        !           173:
        !           174:   procedure Create ( p,q : in Poly_Sys ) is
        !           175:
        !           176:     packname : String := Read_Package_Name;
        !           177:
        !           178:   begin
        !           179:     Create(packname,p,q);
        !           180:   end Create;
        !           181:
        !           182: end Homotopy_Evaluator_Packages;