mathpaqs_20230121.0.0_773568e5/lin_alg/test_qr.adb

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
with Ada.Text_IO;                       use Ada.Text_IO;

with Ada.Numerics.Generic_Real_Arrays;
with Generic_Real_Linear_Equations;

procedure Test_QR is

  subtype Real is Long_Float;
  type Integer_Vector is array (Integer range <>) of Integer;

  package RIO is new Float_IO(Real);

  package GRA is new Ada.Numerics.Generic_Real_Arrays(Real);
  package GRLE is new Generic_Real_Linear_Equations(Real, GRA, Integer_Vector);

  use GRA, GRLE, RIO;

  procedure Put(A: Real_Matrix) is
  begin
    for i in A'Range(1) loop
      for j in A'Range(2) loop
        Put(A(i,j), 4,2,0);
      end loop;
      New_Line;
    end loop;
  end Put;

  procedure Put(x: Real_Vector) is
  begin
    for i in x'Range loop
      Put(x(i), 4,2,0);
    end loop;
    New_Line;
  end Put;

  procedure Test(A: Real_Matrix; x, y: Real_Vector) is
    Q: Real_Matrix(A'Range(1), A'Range(1));
    R: Real_Matrix(A'Range(2), A'Range(2));
    Z: Real_Matrix:= A;
    res: Real:= 0.0;
    x_solved: Real_Vector(x'Range);
  begin
    QR_Decomposition ( A , Q , R ) ;
    Put_Line("**** QR test A -> QR. A is:");
    Put(A);
    Put_Line("Q is:");
    Put(Q);
    Put_Line("R is:");
    Put(R);
    Put_Line("Check Q orthogonal: QtQ should be close to unit matrix");
    Put(Transpose(Q) * Q);
    Put_Line("Check QR - A, should be close to 0 matrix");
    Z:= Q*R-A;
    Put(Z);
    for i in Z'Range(1) loop
      for j in Z'Range(2) loop
        res:= res + abs Z(i,j);
      end loop;
    end loop;
    Put("This sum should be close to 0 :");
    Put(res);
    New_Line;
    Put_Line("**** QR solver");
    x_solved:= QR_Solve(Q,R,y);
    Put_Line("  solution x  :");
    Put(x_solved);
    Put_Line("  x should be :");
    Put(x);
    Put("  Ax=");
    Put(A*x_solved);
    Put("   y=");
    Put(y);
    New_Line;
    New_Line;
  end Test;

  A33: constant Real_Matrix(1..3, 1..3):=
        (( 12.0 , -51.0,   4.0),
         (  6.0 , 167.0, -68.0),
         ( -4.0,   24.0, -41.0));

  x_a: constant Real_Vector:= (1.0, 2.0, 3.0);
  y_a: constant Real_Vector:= A33 * x_a;

  --  A32: constant Real_Matrix(1..3, 1..2):=
  --        ((  2.0, 1.0),
  --         (  4.0, 5.0),
  --         (  3.0, 7.0));

  --  x_b: constant Real_Vector:= (123.0, 456.0);
  --  y_b: constant Real_Vector:= A32 * x_b;

begin
  Test( A33, x_a, y_a );
  -- Test( A32, x_b, y_b ); -- !! QR not yet set for non-square matrices
  Put("Finished - press return");
  Skip_Line;
end Test_QR;