File: [local] / OpenXM_contrib / PHC / Ada / Math_Lib / Matrices / ts_fltmat.adb (download)
Revision 1.1.1.1 (vendor branch), Sun Oct 29 17:45:24 2000 UTC (23 years, 9 months ago) by maekawa
Branch: PHC, MAIN
CVS Tags: v2, maekawa-ipv6, RELEASE_1_2_3, RELEASE_1_2_2_KNOPPIX_b, RELEASE_1_2_2_KNOPPIX, RELEASE_1_2_2, RELEASE_1_2_1, HEAD Changes since 1.1: +0 -0
lines
Import the second public release of PHCpack.
OKed by Jan Verschelde.
|
with text_io,integer_io; use text_io,integer_io;
with Multprec_Integer_Numbers; use Multprec_Integer_Numbers;
with Standard_Natural_Vectors;
with Standard_Floating_Numbers; use Standard_Floating_Numbers;
with Standard_Floating_Numbers_io; use Standard_Floating_Numbers_io;
--with Standard_Random_Numbers; use Standard_Random_Numbers;
with Standard_Floating_Vectors;
with Standard_Floating_Vectors_io;
with Standard_Floating_Matrices;
with Standard_Floating_Matrices_io;
with Standard_Floating_VecMats;
with Standard_Floating_VecMats_io;
with Standard_Floating_Linear_Solvers; use Standard_Floating_Linear_Solvers;
with Standard_Floating_Norms_Equals; use Standard_Floating_Norms_Equals;
with Standard_Random_Vectors; use Standard_Random_Vectors;
with Standard_Random_Matrices; use Standard_Random_Matrices;
with Multprec_Random_Vectors; use Multprec_Random_Vectors;
with Multprec_Random_Matrices; use Multprec_Random_Matrices;
with Multprec_Floating_Numbers; use Multprec_Floating_Numbers;
with Multprec_Floating_Numbers_io; use Multprec_Floating_Numbers_io;
--with Multprec_Random_Numbers; use Multprec_Random_Numbers;
with Multprec_Floating_Vectors;
with Multprec_Floating_Vectors_io;
with Multprec_Floating_Matrices;
with Multprec_Floating_Matrices_io;
with Multprec_Floating_Linear_Solvers; use Multprec_Floating_Linear_Solvers;
with Multprec_Floating_Norms_Equals; use Multprec_Floating_Norms_Equals;
procedure ts_fltmat is
-- DESCRIPTION :
-- Tests the matrix packages of standard and multi-precision floats.
function Vdm_Matrix ( v : Multprec_Floating_Vectors.Vector )
return Multprec_Floating_Matrices.Matrix is
use Multprec_Floating_Matrices;
n : constant natural := v'length;
res : Matrix(1..n,1..n);
begin
for i in res'range(1) loop
for j in res'range(2) loop
res(i,j) := v(i)**(j-1);
end loop;
end loop;
return res;
end Vdm_Matrix;
function Vdm_Matrix ( v : Standard_Floating_Vectors.Vector )
return Standard_Floating_Matrices.Matrix is
use Standard_Floating_Matrices;
n : constant natural := v'length;
res : Matrix(1..n,1..n);
begin
for i in res'range(1) loop
for j in res'range(2) loop
res(i,j) := v(i)**(j-1);
end loop;
end loop;
return res;
end Vdm_Matrix;
procedure Write ( f : in Multprec_Floating_Numbers.Floating_Number ) is
frac : Integer_Number := Fraction(f);
expo : Integer_Number := Exponent(f);
begin
put("Fraction :");
for i in reverse 0..Size(frac) loop
put(Coefficient(frac,i));
end loop;
new_line;
put("Exponent :");
for i in reverse 0..Size(expo) loop
put(Coefficient(expo,i));
end loop;
new_line;
end Write;
procedure Write ( v : in Multprec_Floating_Vectors.Vector ) is
begin
for i in v'range loop
Write(v(i)); new_line;
end loop;
end Write;
procedure Write ( m : in Multprec_Floating_Matrices.Matrix ) is
begin
for i in m'range(1) loop
for j in m'range(2) loop
Write(m(i,j)); new_line;
end loop;
end loop;
end Write;
procedure Set_Size ( v : in out Multprec_Floating_Vectors.Vector;
k : in natural ) is
-- DESCRIPTION :
-- Sets the size of the elements in v to k.
use Multprec_Floating_Numbers,Multprec_Floating_Vectors;
begin
for i in v'range loop
Set_Size(v(i),k);
end loop;
--Write(v);
end Set_Size;
procedure Set_Size ( m : in out Multprec_Floating_Matrices.Matrix;
k : in natural ) is
-- DESCRIPTION :
-- Sets the size of the elements in m to k.
use Multprec_Floating_Numbers,Multprec_Floating_Matrices;
begin
for i in m'range(1) loop
for j in m'range(2) loop
Set_Size(m(i,j),k);
end loop;
end loop;
--Write(m);
end Set_Size;
procedure Test_Standard_io is
use Standard_Floating_Matrices,Standard_Floating_Matrices_io;
n,m : natural;
begin
put("Give the number of rows : "); get(n);
put("Give the number of columns : "); get(m);
declare
mat : Matrix(1..n,1..m);
begin
put("Give "); put(n,1); put("x"); put(m,1);
put_line(" floating matrix : "); get(mat);
put_line("Your matrix : "); put(mat); new_line;
end;
end Test_Standard_io;
procedure Test_Standard_VecMat_io is
use Standard_Floating_Matrices,Standard_Floating_Matrices_io;
use Standard_Floating_VecMats,Standard_Floating_VecMats_io;
n,n1,n2 : natural;
lv : Link_to_VecMat;
begin
put("Give the number of matrices : "); get(n);
put("Give #rows : "); get(n1);
put("Give #columns : "); get(n2);
put("Give "); put(n,1); put(" "); put(n1,1); put("-by-"); put(n2,1);
put_line(" floating matrices : ");
get(n,n1,n2,lv);
put_line("The vector of matrices :"); put(lv);
end Test_Standard_VecMat_io;
procedure lufco_Solve ( n : in natural;
mat : in Standard_Floating_Matrices.Matrix;
rhs : in Standard_Floating_Vectors.Vector ) is
use Standard_Floating_Vectors;
use Standard_Floating_Vectors_io;
use Standard_Floating_Matrices;
use Standard_Floating_Matrices_io;
wrk : Matrix(mat'range(1),mat'range(2)) := mat;
piv : Standard_Natural_Vectors.Vector(mat'range(2));
rcond,nrm : double_float;
res,sol : Vector(rhs'range);
begin
put_line("Solving the linear system with lufco.");
lufco(wrk,n,piv,rcond);
put("inverse condition : "); put(rcond); new_line;
sol := rhs;
lusolve(wrk,n,piv,sol);
put_line("The solution vector :"); put(sol); new_line;
res := rhs - mat*sol;
put_line("The residual : "); put(res); new_line;
nrm := Max_Norm(res);
put("Max norm of residual : "); put(nrm); new_line;
nrm := Sum_Norm(res);
put("Sum norm of residual : "); put(nrm); new_line;
end lufco_Solve;
procedure lufac_Solve ( n : in natural;
mat : in Standard_Floating_Matrices.Matrix;
rhs : in Standard_Floating_Vectors.Vector ) is
use Standard_Floating_Vectors;
use Standard_Floating_Vectors_io;
use Standard_Floating_Matrices;
use Standard_Floating_Matrices_io;
wrk : Matrix(mat'range(1),mat'range(2)) := mat;
piv : Standard_Natural_Vectors.Vector(mat'range(2));
info : natural;
res,sol : Vector(rhs'range);
nrm : double_float;
begin
put_line("Solving the linear system with lufac.");
lufac(wrk,n,piv,info);
put("info : "); put(info,1); new_line;
sol := rhs;
lusolve(wrk,n,piv,sol);
put_line("The solution vector :"); put(sol); new_line;
res := rhs - mat*sol;
put_line("The residual : "); put(res); new_line;
nrm := Max_Norm(res);
put("Max norm of residual : "); put(nrm); new_line;
nrm := Sum_Norm(res);
put("Sum norm of residual : "); put(nrm); new_line;
end lufac_Solve;
procedure Interactive_Test_Standard_Linear_Solvers is
use Standard_Floating_Vectors;
use Standard_Floating_Vectors_io;
use Standard_Floating_Matrices;
use Standard_Floating_Matrices_io;
n : natural;
begin
new_line;
put_line("Interactive testing of solving standard linear systems.");
new_line;
put("Give the dimension : "); get(n);
declare
mat : Matrix(1..n,1..n);
rhs : Vector(1..n);
begin
put("Give "); put(n,1); put("x"); put(n,1);
put_line(" floating matrix : "); get(mat);
put_line("-> the matrix : "); put(mat);
put("Give "); put(n,1); put_line(" floating-numbers : "); get(rhs);
put_line("-> right-hand side vector : "); put(rhs); new_line;
lufac_Solve(n,mat,rhs);
lufco_Solve(n,mat,rhs);
end;
end Interactive_Test_Standard_Linear_Solvers;
procedure Random_Test_Standard_Linear_Solvers is
use Standard_Floating_Vectors;
use Standard_Floating_Vectors_io;
use Standard_Floating_Matrices;
use Standard_Floating_Matrices_io;
n,nb : natural;
begin
new_line;
put_line("Testing of solving random standard linear systems.");
new_line;
put("Give the dimension : "); get(n);
put("Give the number of tests : "); get(nb);
for i in 1..nb loop
declare
mat : Matrix(1..n,1..n);
rhs : Vector(1..n);
begin
mat := Vdm_Matrix(Random_Vector(1,n));
rhs := Random_Vector(1,n);
lufac_Solve(n,mat,rhs);
lufco_Solve(n,mat,rhs);
end;
end loop;
end Random_Test_Standard_Linear_Solvers;
procedure Test_Multprec_io is
use Multprec_Floating_Matrices,Multprec_Floating_Matrices_io;
n,m : natural;
begin
put("Give the number of rows : "); get(n);
put("Give the number of columns : "); get(m);
declare
mat : Matrix(1..n,1..m);
begin
put("Give "); put(n,1); put("x"); put(m,1);
put_line(" floating matrix : "); get(mat);
put_line("Your matrix : "); put(mat); new_line;
end;
end Test_Multprec_io;
procedure lufco_Solve ( n : in natural;
mat : in Multprec_Floating_Matrices.Matrix;
rhs : in Multprec_Floating_Vectors.Vector ) is
use Multprec_Floating_Vectors;
use Multprec_Floating_Vectors_io;
use Multprec_Floating_Matrices;
use Multprec_Floating_Matrices_io;
wrk : Matrix(mat'range(1),mat'range(2));
piv : Standard_Natural_Vectors.Vector(mat'range(2));
rcond,nrm : Floating_Number;
res,sol,acc : Vector(rhs'range);
begin
put_line("Solving the linear system with lufco.");
Copy(mat,wrk);
lufco(wrk,n,piv,rcond);
put("inverse condition : "); put(rcond); new_line;
Copy(rhs,sol);
lusolve(wrk,n,piv,sol);
put_line("The solution vector :"); put(sol); new_line;
acc := mat*sol;
res := rhs - acc;
put_line("The residual : "); put(res); new_line;
nrm := Max_Norm(res);
put("Max norm of residual : "); put(nrm); new_line;
Clear(nrm);
nrm := Sum_Norm(res);
put("Sum norm of residual : "); put(nrm); new_line;
Clear(nrm); Clear(rcond);
Clear(wrk); Clear(acc); Clear(res); Clear(sol);
end lufco_Solve;
procedure lufac_Solve ( n : in natural;
mat : in Multprec_Floating_Matrices.Matrix;
rhs : in Multprec_Floating_Vectors.Vector ) is
use Multprec_Floating_Vectors;
use Multprec_Floating_Vectors_io;
use Multprec_Floating_Matrices;
use Multprec_Floating_Matrices_io;
wrk : Matrix(mat'range(1),mat'range(2));
piv : Standard_Natural_Vectors.Vector(mat'range(2));
info : natural;
res,sol,acc : Vector(rhs'range);
nrm : Floating_Number;
begin
put_line("Solving the linear system with lufac.");
Copy(mat,wrk);
lufac(wrk,n,piv,info);
put("info : "); put(info,1); new_line;
Copy(rhs,sol);
lusolve(wrk,n,piv,sol);
put_line("The solution vector :"); put(sol); new_line;
acc := mat*sol;
res := rhs - acc;
put_line("The residual : "); put(res); new_line;
nrm := Max_Norm(res);
put("Max norm of residual : "); put(nrm); new_line;
Clear(nrm);
nrm := Sum_Norm(res);
put("Sum norm of residual : "); put(nrm); new_line;
Clear(nrm); Clear(wrk); Clear(acc); Clear(res); Clear(sol);
end lufac_Solve;
procedure Interactive_Test_Multprec_Linear_Solvers is
use Multprec_Floating_Vectors;
use Multprec_Floating_Vectors_io;
use Multprec_Floating_Matrices;
use Multprec_Floating_Matrices_io;
ans : character;
n : natural;
begin
put("Give the dimension : "); get(n);
declare
mat : Matrix(1..n,1..n);
rhs : Vector(1..n);
sz : integer;
begin
put("Give "); put(n,1); put("x"); put(n,1);
put_line(" floating matrix : "); get(mat);
put_line("-> the matrix : "); put(mat);
put("Give "); put(n,1); put_line(" floating-numbers : "); get(rhs);
put_line("-> right-hand side vector : "); put(rhs); new_line;
put("Give the size (-1 for default) : "); get(sz);
if sz >= 0
then Set_Size(mat,sz);
Set_Size(rhs,sz);
end if;
loop
lufac_Solve(n,mat,rhs);
lufco_Solve(n,mat,rhs);
put("Do you want to resolve with other precision ? (y/n) "); get(ans);
exit when ans /= 'y';
put("Give the size : "); get(sz);
Set_Size(mat,sz);
Set_Size(rhs,sz);
end loop;
end;
end Interactive_Test_Multprec_Linear_Solvers;
procedure Random_Test_Multprec_Linear_Solvers is
use Multprec_Floating_Vectors;
use Multprec_Floating_Vectors_io;
use Multprec_Floating_Matrices;
use Multprec_Floating_Matrices_io;
n,sz,nb : natural;
begin
put("Give the dimension : "); get(n);
put("Give the size of the numbers : "); get(sz);
put("Give the number of tests : "); get(nb);
for i in 1..nb loop
declare
mat : Matrix(1..n,1..n);
rhs : Vector(1..n);
begin
mat := Vdm_Matrix(Random_Vector(1,n,sz)); --Random_Matrix(n,n,sz);
rhs := Random_Vector(n,sz);
-- lufac_Solve(n,mat,rhs);
lufco_Solve(n,mat,rhs);
Clear(mat); Clear(rhs);
end;
end loop;
end Random_Test_Multprec_Linear_Solvers;
procedure Main is
ans : character;
begin
new_line;
put_line("Interactive testing of matrices of floating numbers");
loop
new_line;
put_line("Choose one of the following : ");
put_line(" 0. exit this program.");
put_line(" 1. io of matrices of standard numbers.");
put_line(" 2. io of vectos of matrices of standard numbers.");
put_line(" 3. interactive test on solving standard linear systems.");
put_line(" 4. test on solving random standard linear systems.");
put_line(" 5. io of matrices of multi-precision numbers.");
put_line(" 6. interactive test on solving multi-precision systems.");
put_line(" 7. test on solving random multi-precision systems.");
put("Make your choice (0,1,2,3,4,5,6 or 7) : "); get(ans);
exit when ans = '0';
case ans is
when '1' => Test_Standard_io;
when '2' => Test_Standard_VecMat_io;
when '3' => Interactive_Test_Standard_Linear_Solvers;
when '4' => Random_Test_Standard_Linear_Solvers;
when '5' => Test_Multprec_io;
when '6' => Interactive_Test_Multprec_Linear_Solvers;
when '7' => Random_Test_Multprec_Linear_Solvers;
when others => null;
end case;
end loop;
end Main;
begin
Main;
end ts_fltmat;