Annotation of OpenXM_contrib/PHC/Ada/Math_Lib/Matrices/ts_fltmat.adb, Revision 1.1.1.1
1.1 maekawa 1: with text_io,integer_io; use text_io,integer_io;
2: with Multprec_Integer_Numbers; use Multprec_Integer_Numbers;
3: with Standard_Natural_Vectors;
4: with Standard_Floating_Numbers; use Standard_Floating_Numbers;
5: with Standard_Floating_Numbers_io; use Standard_Floating_Numbers_io;
6: --with Standard_Random_Numbers; use Standard_Random_Numbers;
7: with Standard_Floating_Vectors;
8: with Standard_Floating_Vectors_io;
9: with Standard_Floating_Matrices;
10: with Standard_Floating_Matrices_io;
11: with Standard_Floating_VecMats;
12: with Standard_Floating_VecMats_io;
13: with Standard_Floating_Linear_Solvers; use Standard_Floating_Linear_Solvers;
14: with Standard_Floating_Norms_Equals; use Standard_Floating_Norms_Equals;
15: with Standard_Random_Vectors; use Standard_Random_Vectors;
16: with Standard_Random_Matrices; use Standard_Random_Matrices;
17: with Multprec_Random_Vectors; use Multprec_Random_Vectors;
18: with Multprec_Random_Matrices; use Multprec_Random_Matrices;
19: with Multprec_Floating_Numbers; use Multprec_Floating_Numbers;
20: with Multprec_Floating_Numbers_io; use Multprec_Floating_Numbers_io;
21: --with Multprec_Random_Numbers; use Multprec_Random_Numbers;
22: with Multprec_Floating_Vectors;
23: with Multprec_Floating_Vectors_io;
24: with Multprec_Floating_Matrices;
25: with Multprec_Floating_Matrices_io;
26: with Multprec_Floating_Linear_Solvers; use Multprec_Floating_Linear_Solvers;
27: with Multprec_Floating_Norms_Equals; use Multprec_Floating_Norms_Equals;
28:
29: procedure ts_fltmat is
30:
31: -- DESCRIPTION :
32: -- Tests the matrix packages of standard and multi-precision floats.
33:
34: function Vdm_Matrix ( v : Multprec_Floating_Vectors.Vector )
35: return Multprec_Floating_Matrices.Matrix is
36:
37: use Multprec_Floating_Matrices;
38:
39: n : constant natural := v'length;
40: res : Matrix(1..n,1..n);
41:
42: begin
43: for i in res'range(1) loop
44: for j in res'range(2) loop
45: res(i,j) := v(i)**(j-1);
46: end loop;
47: end loop;
48: return res;
49: end Vdm_Matrix;
50:
51: function Vdm_Matrix ( v : Standard_Floating_Vectors.Vector )
52: return Standard_Floating_Matrices.Matrix is
53:
54: use Standard_Floating_Matrices;
55:
56: n : constant natural := v'length;
57: res : Matrix(1..n,1..n);
58:
59: begin
60: for i in res'range(1) loop
61: for j in res'range(2) loop
62: res(i,j) := v(i)**(j-1);
63: end loop;
64: end loop;
65: return res;
66: end Vdm_Matrix;
67:
68: procedure Write ( f : in Multprec_Floating_Numbers.Floating_Number ) is
69:
70: frac : Integer_Number := Fraction(f);
71: expo : Integer_Number := Exponent(f);
72:
73: begin
74: put("Fraction :");
75: for i in reverse 0..Size(frac) loop
76: put(Coefficient(frac,i));
77: end loop;
78: new_line;
79: put("Exponent :");
80: for i in reverse 0..Size(expo) loop
81: put(Coefficient(expo,i));
82: end loop;
83: new_line;
84: end Write;
85:
86: procedure Write ( v : in Multprec_Floating_Vectors.Vector ) is
87: begin
88: for i in v'range loop
89: Write(v(i)); new_line;
90: end loop;
91: end Write;
92:
93: procedure Write ( m : in Multprec_Floating_Matrices.Matrix ) is
94: begin
95: for i in m'range(1) loop
96: for j in m'range(2) loop
97: Write(m(i,j)); new_line;
98: end loop;
99: end loop;
100: end Write;
101:
102: procedure Set_Size ( v : in out Multprec_Floating_Vectors.Vector;
103: k : in natural ) is
104:
105: -- DESCRIPTION :
106: -- Sets the size of the elements in v to k.
107:
108: use Multprec_Floating_Numbers,Multprec_Floating_Vectors;
109:
110: begin
111: for i in v'range loop
112: Set_Size(v(i),k);
113: end loop;
114: --Write(v);
115: end Set_Size;
116:
117: procedure Set_Size ( m : in out Multprec_Floating_Matrices.Matrix;
118: k : in natural ) is
119:
120: -- DESCRIPTION :
121: -- Sets the size of the elements in m to k.
122:
123: use Multprec_Floating_Numbers,Multprec_Floating_Matrices;
124:
125: begin
126: for i in m'range(1) loop
127: for j in m'range(2) loop
128: Set_Size(m(i,j),k);
129: end loop;
130: end loop;
131: --Write(m);
132: end Set_Size;
133:
134: procedure Test_Standard_io is
135:
136: use Standard_Floating_Matrices,Standard_Floating_Matrices_io;
137:
138: n,m : natural;
139:
140: begin
141: put("Give the number of rows : "); get(n);
142: put("Give the number of columns : "); get(m);
143: declare
144: mat : Matrix(1..n,1..m);
145: begin
146: put("Give "); put(n,1); put("x"); put(m,1);
147: put_line(" floating matrix : "); get(mat);
148: put_line("Your matrix : "); put(mat); new_line;
149: end;
150: end Test_Standard_io;
151:
152: procedure Test_Standard_VecMat_io is
153:
154: use Standard_Floating_Matrices,Standard_Floating_Matrices_io;
155: use Standard_Floating_VecMats,Standard_Floating_VecMats_io;
156:
157: n,n1,n2 : natural;
158: lv : Link_to_VecMat;
159:
160: begin
161: put("Give the number of matrices : "); get(n);
162: put("Give #rows : "); get(n1);
163: put("Give #columns : "); get(n2);
164: put("Give "); put(n,1); put(" "); put(n1,1); put("-by-"); put(n2,1);
165: put_line(" floating matrices : ");
166: get(n,n1,n2,lv);
167: put_line("The vector of matrices :"); put(lv);
168: end Test_Standard_VecMat_io;
169:
170: procedure lufco_Solve ( n : in natural;
171: mat : in Standard_Floating_Matrices.Matrix;
172: rhs : in Standard_Floating_Vectors.Vector ) is
173:
174: use Standard_Floating_Vectors;
175: use Standard_Floating_Vectors_io;
176: use Standard_Floating_Matrices;
177: use Standard_Floating_Matrices_io;
178:
179: wrk : Matrix(mat'range(1),mat'range(2)) := mat;
180: piv : Standard_Natural_Vectors.Vector(mat'range(2));
181: rcond,nrm : double_float;
182: res,sol : Vector(rhs'range);
183:
184: begin
185: put_line("Solving the linear system with lufco.");
186: lufco(wrk,n,piv,rcond);
187: put("inverse condition : "); put(rcond); new_line;
188: sol := rhs;
189: lusolve(wrk,n,piv,sol);
190: put_line("The solution vector :"); put(sol); new_line;
191: res := rhs - mat*sol;
192: put_line("The residual : "); put(res); new_line;
193: nrm := Max_Norm(res);
194: put("Max norm of residual : "); put(nrm); new_line;
195: nrm := Sum_Norm(res);
196: put("Sum norm of residual : "); put(nrm); new_line;
197: end lufco_Solve;
198:
199: procedure lufac_Solve ( n : in natural;
200: mat : in Standard_Floating_Matrices.Matrix;
201: rhs : in Standard_Floating_Vectors.Vector ) is
202:
203: use Standard_Floating_Vectors;
204: use Standard_Floating_Vectors_io;
205: use Standard_Floating_Matrices;
206: use Standard_Floating_Matrices_io;
207:
208: wrk : Matrix(mat'range(1),mat'range(2)) := mat;
209: piv : Standard_Natural_Vectors.Vector(mat'range(2));
210: info : natural;
211: res,sol : Vector(rhs'range);
212: nrm : double_float;
213:
214: begin
215: put_line("Solving the linear system with lufac.");
216: lufac(wrk,n,piv,info);
217: put("info : "); put(info,1); new_line;
218: sol := rhs;
219: lusolve(wrk,n,piv,sol);
220: put_line("The solution vector :"); put(sol); new_line;
221: res := rhs - mat*sol;
222: put_line("The residual : "); put(res); new_line;
223: nrm := Max_Norm(res);
224: put("Max norm of residual : "); put(nrm); new_line;
225: nrm := Sum_Norm(res);
226: put("Sum norm of residual : "); put(nrm); new_line;
227: end lufac_Solve;
228:
229: procedure Interactive_Test_Standard_Linear_Solvers is
230:
231: use Standard_Floating_Vectors;
232: use Standard_Floating_Vectors_io;
233: use Standard_Floating_Matrices;
234: use Standard_Floating_Matrices_io;
235:
236: n : natural;
237:
238: begin
239: new_line;
240: put_line("Interactive testing of solving standard linear systems.");
241: new_line;
242: put("Give the dimension : "); get(n);
243: declare
244: mat : Matrix(1..n,1..n);
245: rhs : Vector(1..n);
246: begin
247: put("Give "); put(n,1); put("x"); put(n,1);
248: put_line(" floating matrix : "); get(mat);
249: put_line("-> the matrix : "); put(mat);
250: put("Give "); put(n,1); put_line(" floating-numbers : "); get(rhs);
251: put_line("-> right-hand side vector : "); put(rhs); new_line;
252: lufac_Solve(n,mat,rhs);
253: lufco_Solve(n,mat,rhs);
254: end;
255: end Interactive_Test_Standard_Linear_Solvers;
256:
257: procedure Random_Test_Standard_Linear_Solvers is
258:
259: use Standard_Floating_Vectors;
260: use Standard_Floating_Vectors_io;
261: use Standard_Floating_Matrices;
262: use Standard_Floating_Matrices_io;
263:
264: n,nb : natural;
265:
266: begin
267: new_line;
268: put_line("Testing of solving random standard linear systems.");
269: new_line;
270: put("Give the dimension : "); get(n);
271: put("Give the number of tests : "); get(nb);
272: for i in 1..nb loop
273: declare
274: mat : Matrix(1..n,1..n);
275: rhs : Vector(1..n);
276: begin
277: mat := Vdm_Matrix(Random_Vector(1,n));
278: rhs := Random_Vector(1,n);
279: lufac_Solve(n,mat,rhs);
280: lufco_Solve(n,mat,rhs);
281: end;
282: end loop;
283: end Random_Test_Standard_Linear_Solvers;
284:
285: procedure Test_Multprec_io is
286:
287: use Multprec_Floating_Matrices,Multprec_Floating_Matrices_io;
288:
289: n,m : natural;
290:
291: begin
292: put("Give the number of rows : "); get(n);
293: put("Give the number of columns : "); get(m);
294: declare
295: mat : Matrix(1..n,1..m);
296: begin
297: put("Give "); put(n,1); put("x"); put(m,1);
298: put_line(" floating matrix : "); get(mat);
299: put_line("Your matrix : "); put(mat); new_line;
300: end;
301: end Test_Multprec_io;
302:
303: procedure lufco_Solve ( n : in natural;
304: mat : in Multprec_Floating_Matrices.Matrix;
305: rhs : in Multprec_Floating_Vectors.Vector ) is
306:
307: use Multprec_Floating_Vectors;
308: use Multprec_Floating_Vectors_io;
309: use Multprec_Floating_Matrices;
310: use Multprec_Floating_Matrices_io;
311:
312: wrk : Matrix(mat'range(1),mat'range(2));
313: piv : Standard_Natural_Vectors.Vector(mat'range(2));
314: rcond,nrm : Floating_Number;
315: res,sol,acc : Vector(rhs'range);
316:
317: begin
318: put_line("Solving the linear system with lufco.");
319: Copy(mat,wrk);
320: lufco(wrk,n,piv,rcond);
321: put("inverse condition : "); put(rcond); new_line;
322: Copy(rhs,sol);
323: lusolve(wrk,n,piv,sol);
324: put_line("The solution vector :"); put(sol); new_line;
325: acc := mat*sol;
326: res := rhs - acc;
327: put_line("The residual : "); put(res); new_line;
328: nrm := Max_Norm(res);
329: put("Max norm of residual : "); put(nrm); new_line;
330: Clear(nrm);
331: nrm := Sum_Norm(res);
332: put("Sum norm of residual : "); put(nrm); new_line;
333: Clear(nrm); Clear(rcond);
334: Clear(wrk); Clear(acc); Clear(res); Clear(sol);
335: end lufco_Solve;
336:
337: procedure lufac_Solve ( n : in natural;
338: mat : in Multprec_Floating_Matrices.Matrix;
339: rhs : in Multprec_Floating_Vectors.Vector ) is
340:
341: use Multprec_Floating_Vectors;
342: use Multprec_Floating_Vectors_io;
343: use Multprec_Floating_Matrices;
344: use Multprec_Floating_Matrices_io;
345:
346: wrk : Matrix(mat'range(1),mat'range(2));
347: piv : Standard_Natural_Vectors.Vector(mat'range(2));
348: info : natural;
349: res,sol,acc : Vector(rhs'range);
350: nrm : Floating_Number;
351:
352: begin
353: put_line("Solving the linear system with lufac.");
354: Copy(mat,wrk);
355: lufac(wrk,n,piv,info);
356: put("info : "); put(info,1); new_line;
357: Copy(rhs,sol);
358: lusolve(wrk,n,piv,sol);
359: put_line("The solution vector :"); put(sol); new_line;
360: acc := mat*sol;
361: res := rhs - acc;
362: put_line("The residual : "); put(res); new_line;
363: nrm := Max_Norm(res);
364: put("Max norm of residual : "); put(nrm); new_line;
365: Clear(nrm);
366: nrm := Sum_Norm(res);
367: put("Sum norm of residual : "); put(nrm); new_line;
368: Clear(nrm); Clear(wrk); Clear(acc); Clear(res); Clear(sol);
369: end lufac_Solve;
370:
371: procedure Interactive_Test_Multprec_Linear_Solvers is
372:
373: use Multprec_Floating_Vectors;
374: use Multprec_Floating_Vectors_io;
375: use Multprec_Floating_Matrices;
376: use Multprec_Floating_Matrices_io;
377:
378: ans : character;
379: n : natural;
380:
381: begin
382: put("Give the dimension : "); get(n);
383: declare
384: mat : Matrix(1..n,1..n);
385: rhs : Vector(1..n);
386: sz : integer;
387: begin
388: put("Give "); put(n,1); put("x"); put(n,1);
389: put_line(" floating matrix : "); get(mat);
390: put_line("-> the matrix : "); put(mat);
391: put("Give "); put(n,1); put_line(" floating-numbers : "); get(rhs);
392: put_line("-> right-hand side vector : "); put(rhs); new_line;
393: put("Give the size (-1 for default) : "); get(sz);
394: if sz >= 0
395: then Set_Size(mat,sz);
396: Set_Size(rhs,sz);
397: end if;
398: loop
399: lufac_Solve(n,mat,rhs);
400: lufco_Solve(n,mat,rhs);
401: put("Do you want to resolve with other precision ? (y/n) "); get(ans);
402: exit when ans /= 'y';
403: put("Give the size : "); get(sz);
404: Set_Size(mat,sz);
405: Set_Size(rhs,sz);
406: end loop;
407: end;
408: end Interactive_Test_Multprec_Linear_Solvers;
409:
410: procedure Random_Test_Multprec_Linear_Solvers is
411:
412: use Multprec_Floating_Vectors;
413: use Multprec_Floating_Vectors_io;
414: use Multprec_Floating_Matrices;
415: use Multprec_Floating_Matrices_io;
416:
417: n,sz,nb : natural;
418:
419: begin
420: put("Give the dimension : "); get(n);
421: put("Give the size of the numbers : "); get(sz);
422: put("Give the number of tests : "); get(nb);
423: for i in 1..nb loop
424: declare
425: mat : Matrix(1..n,1..n);
426: rhs : Vector(1..n);
427: begin
428: mat := Vdm_Matrix(Random_Vector(1,n,sz)); --Random_Matrix(n,n,sz);
429: rhs := Random_Vector(n,sz);
430: -- lufac_Solve(n,mat,rhs);
431: lufco_Solve(n,mat,rhs);
432: Clear(mat); Clear(rhs);
433: end;
434: end loop;
435: end Random_Test_Multprec_Linear_Solvers;
436:
437: procedure Main is
438:
439: ans : character;
440:
441: begin
442: new_line;
443: put_line("Interactive testing of matrices of floating numbers");
444: loop
445: new_line;
446: put_line("Choose one of the following : ");
447: put_line(" 0. exit this program.");
448: put_line(" 1. io of matrices of standard numbers.");
449: put_line(" 2. io of vectos of matrices of standard numbers.");
450: put_line(" 3. interactive test on solving standard linear systems.");
451: put_line(" 4. test on solving random standard linear systems.");
452: put_line(" 5. io of matrices of multi-precision numbers.");
453: put_line(" 6. interactive test on solving multi-precision systems.");
454: put_line(" 7. test on solving random multi-precision systems.");
455: put("Make your choice (0,1,2,3,4,5,6 or 7) : "); get(ans);
456: exit when ans = '0';
457: case ans is
458: when '1' => Test_Standard_io;
459: when '2' => Test_Standard_VecMat_io;
460: when '3' => Interactive_Test_Standard_Linear_Solvers;
461: when '4' => Random_Test_Standard_Linear_Solvers;
462: when '5' => Test_Multprec_io;
463: when '6' => Interactive_Test_Multprec_Linear_Solvers;
464: when '7' => Random_Test_Multprec_Linear_Solvers;
465: when others => null;
466: end case;
467: end loop;
468: end Main;
469:
470: begin
471: Main;
472: end ts_fltmat;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to ts_fltmat.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 / Matrices