Annotation of OpenXM_contrib/PHC/Ada/Homotopy/homotopy_evaluator_packages.adb, Revision 1.1.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;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to homotopy_evaluator_packages.adb CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / PHC / Ada / Homotopy