Annotation of OpenXM_contrib/PHC/Ada/Math_Lib/Polynomials/standard_evaluator_packages.adb, Revision 1.1.1.1
1.1 maekawa 1: with integer_io; use integer_io;
2: with Communications_with_User; use Communications_with_User;
3: with Characters_and_Numbers; use Characters_and_Numbers;
4: with Standard_Floating_Numbers; use Standard_Floating_Numbers;
5: with Standard_Floating_Numbers_io; use Standard_Floating_Numbers_io;
6: with Standard_Complex_Numbers; use Standard_Complex_Numbers;
7: with Symbol_Table; use Symbol_Table;
8: with Standard_Complex_Polynomials; use Standard_Complex_Polynomials;
9: with Standard_Complex_Polynomials_io; use Standard_Complex_Polynomials_io;
10: with Standard_Complex_Jaco_Matrices; use Standard_Complex_Jaco_Matrices;
11:
12: package body Standard_Evaluator_Packages is
13:
14: function Vector_Symbol ( i : natural ) return Symbol is
15:
16: res : Symbol;
17: s : constant String := "x(" & Convert(i) & ")";
18: cnt : natural := res'first;
19:
20: begin
21: for i in s'range loop
22: res(cnt) := s(i);
23: cnt := cnt+1;
24: exit when cnt > res'last;
25: end loop;
26: for i in cnt..res'last loop
27: res(i) := ' ';
28: end loop;
29: return res;
30: end Vector_Symbol;
31:
32: procedure Replace_Symbols is
33:
34: -- DESCRIPTION :
35: -- Replaces all symbols in the symbol table with vector entries:
36: -- x(1), x(2), up to x(n).
37:
38: n : constant natural := Symbol_Table.Number;
39:
40: begin
41: Symbol_Table.Clear;
42: Symbol_Table.Init(n);
43: for i in 1..n loop
44: Symbol_Table.Add(Vector_Symbol(i));
45: end loop;
46: end Replace_Symbols;
47:
48: procedure Create_Inline_Term_Evaluator
49: ( file : in file_type; t : in Term ) is
50:
51: -- DESCRIPTION :
52: -- Writes the code to evaluate one term on file.
53:
54: cff : boolean := false;
55:
56: begin
57: new_line(file);
58: if t.cf = Create(1.0)
59: then if Sum(t.dg) = 0
60: then put(file," + Create(1.0)");
61: else put(file," + ");
62: end if;
63: elsif t.cf = Create(-1.0)
64: then if Sum(t.dg) = 0
65: then put(file," - Create(1.0)");
66: else put(file," - ");
67: end if;
68: else put(file," + Create(");
69: put(file,REAL_PART(t.cf));
70: put(file,",");
71: put(file,IMAG_PART(t.cf));
72: put(file,")");
73: cff := true;
74: end if;
75: for i in t.dg'range loop
76: if t.dg(i) /= 0
77: then if cff
78: then put(file,"*");
79: else cff := true;
80: end if;
81: put(file,"x(" & Convert(i) & ")");
82: if t.dg(i) > 1
83: then put(file,"**");
84: put(file,t.dg(i),1);
85: end if;
86: end if;
87: end loop;
88: end Create_Inline_Term_Evaluator;
89:
90: procedure Create_Inline_Polynomial_Evaluator
91: ( file : in file_type; p : in Poly ) is
92:
93: procedure Visit_Term ( t : in Term; continue : out boolean ) is
94: begin
95: Create_Inline_Term_Evaluator(file,t);
96: continue := true;
97: end Visit_Term;
98: procedure Visit_Terms is new Visiting_Iterator(Visit_Term);
99:
100: begin
101: Visit_Terms(p);
102: put_line(file,";");
103: end Create_Inline_Polynomial_Evaluator;
104:
105: procedure Create_Inline_System_Evaluator
106: ( file : in file_type; funname : in String; p : in Poly_Sys ) is
107:
108: -- DESCRIPTION :
109: -- Writes the body of a function for an evaluator for p on file.
110:
111: begin
112: put_line(file," function " & funname
113: & " ( x : Vector ) return Vector is");
114: new_line(file);
115: put_line(file," y : Vector(x'range);");
116: new_line(file);
117: put_line(file," begin");
118: for i in p'range loop
119: put(file," y(" & Convert(i) & ") := ");
120: Create_Inline_Polynomial_Evaluator(file,p(i));
121: end loop;
122: put_line(file," return y;");
123: put_line(file," end " & funname & ";");
124: end Create_Inline_System_Evaluator;
125:
126: procedure Create_Inline_Jacobian_Evaluator
127: ( file : in file_type; funname : in String; p : in Poly_Sys ) is
128:
129: -- DESCRIPTION :
130: -- Writes the body of a function to evaluate the Jacobian matrix of
131: -- p on file.
132:
133: jm : Jaco_Mat(p'range,p'range) := Create(p);
134:
135: begin
136: put_line(file," function " & funname
137: & " ( x : Vector ) return Matrix is");
138: new_line(file);
139: put_line(file," y : Matrix(x'range,x'range);");
140: new_line(file);
141: put_line(file," begin");
142: for i in p'range loop
143: for j in p'range loop
144: put(file," y(" & Convert(i) & "," & Convert(j) & ") := ");
145: Create_Inline_Polynomial_Evaluator(file,jm(i,j));
146: end loop;
147: end loop;
148: put_line(file," return y;");
149: put_line(file," end " & funname & ";");
150: Clear(jm);
151: end Create_Inline_Jacobian_Evaluator;
152:
153: function Read_Package_Name return String is
154:
155: -- DESCRIPTION :
156: -- Reads the package name from standard input and returns the string.
157:
158: begin
159: put_line("Reading the name of the package.");
160: declare
161: s : String := Read_String;
162: begin
163: return s;
164: end;
165: end Read_Package_Name;
166:
167: procedure Create ( packname : in String; p : in Poly_Sys ) is
168:
169: -- DESCRIPTION :
170: -- Creates a package that allows to evaluate the polynomial system p.
171:
172: specfile,bodyfile : file_type;
173:
174: begin
175: Replace_Symbols;
176: Create(specfile,out_file,packname & ".ads");
177: put_line(specfile,"with Standard_Complex_Vectors; "
178: & "use Standard_Complex_Vectors;");
179: put_line(specfile,"with Standard_Complex_Matrices; "
180: & "use Standard_Complex_Matrices;");
181: new_line(specfile);
182: put_line(specfile,"package " & packname & " is");
183: new_line(specfile);
184: put_line(specfile," function Eval_Sys ( x : Vector ) return Vector;");
185: put_line(specfile," function Eval_Jaco ( x : Vector ) return Matrix;");
186: new_line(specfile);
187: put_line(specfile,"end " & packname & ";");
188: Close(specfile);
189: Create(bodyfile,out_file,packname & ".adb");
190: put_line(bodyfile,"with Standard_Floating_Numbers; "
191: & "use Standard_Floating_Numbers;");
192: put_line(bodyfile,"with Standard_Complex_Numbers; "
193: & "use Standard_Complex_Numbers;");
194: new_line(bodyfile);
195: put_line(bodyfile,"package body " & packname & " is");
196: new_line(bodyfile);
197: Create_Inline_System_Evaluator(bodyfile,"Eval_Sys",p);
198: new_line(bodyfile);
199: Create_Inline_Jacobian_Evaluator(bodyfile,"Eval_Jaco",p);
200: new_line(bodyfile);
201: put_line(bodyfile,"end " & packname & ";");
202: Close(bodyfile);
203: end Create;
204:
205: procedure Create ( p : in Poly_Sys ) is
206:
207: -- DESCRIPTION :
208: -- Creates a package that allows to evaluate the polynomial system p.
209:
210: packname : String := Read_Package_Name;
211:
212: begin
213: Create(packname,p);
214: end Create;
215:
216: end Standard_Evaluator_Packages;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to standard_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 / Math_Lib / Polynomials