home *** CD-ROM | disk | FTP | other *** search
/ CD Shareware Magazine 1996 December / CD_shareware_12-96.iso / DOS / Programa / NUMANA01.ZIP / SRC / TESTS / MATTEST.MOD < prev    next >
Encoding:
Text File  |  1996-08-15  |  7.3 KB  |  264 lines
  1. MODULE MatTest;
  2.  
  3.         (********************************************************)
  4.         (*                                                      *)
  5.         (*              Test of Matrices module                 *)
  6.         (*                                                      *)
  7.         (*  Programmer:         P. Moylan                       *)
  8.         (*  Last edited:        15 August 1996                  *)
  9.         (*  Status:             Working                         *)
  10.         (*                                                      *)
  11.         (********************************************************)
  12.  
  13. IMPORT Cx;
  14.  
  15. FROM Mat IMPORT
  16.     (* proc *)  Zero, Write, Add, Sub, Mul,
  17.                 Random, Solve, GaussJ, Invert, Eigenvalues;
  18.  
  19. (*
  20. FROM Windows IMPORT
  21.     (* type *)  Window, Colour, FrameType, DividerType,
  22.     (* proc *)  OpenWindow, CloseWindow;
  23. *)
  24.  
  25. FROM MiscM2 IMPORT
  26.     (* proc *)  SelectWindow, WriteString, WriteLn, PressAnyKey;
  27.  
  28. (************************************************************************)
  29.  
  30. PROCEDURE BasicTest;
  31.  
  32.     (* Checks some simple matrix operations. *)
  33.  
  34.     CONST Arows = 2;  Acols = 3;
  35.           Brows = 3;  Bcols = 2;
  36.  
  37.     VAR A, D, E: ARRAY [1..Arows],[1..Acols] OF LONGREAL;
  38.         B, C: ARRAY [1..Brows],[1..Bcols] OF LONGREAL;
  39.         (*w: Window;*)
  40.  
  41.     BEGIN
  42.         (*
  43.         OpenWindow (w, yellow, blue, 1, 23, 10, 69, simpleframe, nodivider);
  44.         SelectWindow (w);
  45.         *)
  46.         WriteString ("TEST OF SIMPLE MATRIX OPERATIONS");
  47.         WriteLn;  WriteLn;
  48.  
  49.         (* Give a value to the A matrix. *)
  50.  
  51.         Random (A, Arows, Acols);
  52.         WriteString ("Matrix A is");  WriteLn;
  53.         Write (A, Arows, Acols, 10);
  54.  
  55.         (* Give a value to the B matrix. *)
  56.  
  57.         Random (B, Brows, Bcols);
  58.         WriteString ("Matrix B is");  WriteLn;
  59.         Write (B, Brows, Bcols, 10);
  60.  
  61.         (* Try an addition (it will fail). *)
  62.  
  63.         WriteString ("We can't compute A+B");  WriteLn;
  64.  
  65.         (* Try a multiplication (it should work). *)
  66.  
  67.         Mul (A, B, Arows, Acols, Bcols, C);
  68.         WriteString ("C = A*B is");  WriteLn;
  69.         Write (C, Arows, Bcols, 10);
  70.  
  71.         (* Give a value to the D matrix. *)
  72.  
  73.         Random (D, Arows, Acols);
  74.         WriteString ("Matrix D is");  WriteLn;
  75.         Write (D, Arows, Acols, 10);
  76.  
  77.         (* Try another addition (this one should work). *)
  78.  
  79.         Add (A, D, Arows, Acols, E);
  80.         WriteString ("E = A+D is");  WriteLn;
  81.         Write (E, Arows, Acols, 10);
  82.  
  83.         PressAnyKey;
  84.         (*CloseWindow (w);*)
  85.  
  86.     END BasicTest;
  87.  
  88. (************************************************************************)
  89.  
  90. PROCEDURE SolveTest;
  91.  
  92.     (* Solution of a linear equation. *)
  93.  
  94.     CONST Arows = 4;  Acols = 4;
  95.           Brows = 4;  Bcols = 2;
  96.  
  97.     VAR A: ARRAY [1..Arows],[1..Acols] OF LONGREAL;
  98.         B, C, D, X: ARRAY [1..Brows],[1..Bcols] OF LONGREAL;
  99.         (*w: Window;*)
  100.  
  101.     BEGIN
  102.         (*
  103.         OpenWindow (w, black, brown, 0, 24, 0, 79, simpleframe, nodivider);
  104.         SelectWindow (w);
  105.         *)
  106.         WriteString ("SOLVING LINEAR ALGEBRAIC EQUATIONS");
  107.         WriteLn;
  108.  
  109.         (* Give a value to the A matrix. *)
  110.  
  111.         Random (A, Arows, Acols);
  112.         WriteString ("Matrix A is");  WriteLn;
  113.         Write (A, Arows, Acols, 10);
  114.  
  115.         (* Give a value to the B matrix. *)
  116.  
  117.         Random (B, Brows, Bcols);
  118.         WriteString ("Matrix B is");  WriteLn;
  119.         Write (B, Brows, Bcols, 10);
  120.  
  121.         (* Solve the equation AX = B. *)
  122.  
  123.         Solve (A, B, X, Arows, Bcols);
  124.         (*GaussJ (A, B, X, Arows, Bcols);*)
  125.  
  126.         (* Write the solution. *)
  127.  
  128.         WriteString ("The solution X to AX = B is");  WriteLn;
  129.         Write (X, Brows, Bcols, 10);
  130.  
  131.         (* Check that the solution looks right. *)
  132.  
  133.         Mul (A, X, Arows, Acols, Bcols, C);
  134.         Sub (B, C, Brows, Bcols, D);
  135.         WriteString ("As a check, AX-B evaluates to");  WriteLn;
  136.         Write (D, Brows, Bcols, 10);
  137.  
  138.         PressAnyKey;
  139.         (*CloseWindow (w);*)
  140.  
  141.     END SolveTest;
  142.  
  143. (************************************************************************)
  144.  
  145. PROCEDURE SingularTest;
  146.  
  147.     (* Linear equation with singular coefficient matrix. *)
  148.  
  149.     CONST Arows = 2;  Acols = 2;
  150.           Brows = 2;  Bcols = 1;
  151.  
  152.     VAR A: ARRAY [1..Arows],[1..Acols] OF LONGREAL;
  153.         B, X: ARRAY [1..Brows],[1..Bcols] OF LONGREAL;
  154.         (*w: Window;*)
  155.  
  156.     BEGIN
  157.         (*
  158.         OpenWindow (w, black, brown, 0, 24, 0, 79, simpleframe, nodivider);
  159.         SelectWindow (w);
  160.         *)
  161.         WriteString ("A SINGULAR PROBLEM");
  162.         WriteLn;
  163.  
  164.         (* Give a value to the A matrix. *)
  165.  
  166.         A[1,1] := 1.0;
  167.         A[1,2] := 2.0;
  168.         A[2,1] := 2.0;
  169.         A[2,2] := 4.0;
  170.         WriteString ("Matrix A is");  WriteLn;
  171.         Write (A, Arows, Acols, 10);
  172.  
  173.         (* Give a value to the B matrix. *)
  174.  
  175.         Random (B, Brows, Bcols);
  176.         WriteString ("Matrix B is");  WriteLn;
  177.         Write (B, Brows, Bcols, 10);
  178.  
  179.         (* Try to solve the equation AX = B. *)
  180.  
  181.         Solve (A, B, X, Arows, Bcols);
  182.  
  183.         WriteString ("The equation AX = B could not be solved");  WriteLn;
  184.  
  185.         PressAnyKey;
  186.         (*CloseWindow (w);*)
  187.  
  188.     END SingularTest;
  189.  
  190. (************************************************************************)
  191.  
  192. PROCEDURE InversionTest;
  193.  
  194.     (* Inverting a matrix, also an eigenvalue calculation. *)
  195.  
  196.     CONST N = 5;
  197.  
  198.     VAR A, B, X: ARRAY [1..N],[1..N] OF LONGREAL;
  199.         W: ARRAY [1..N] OF LONGCOMPLEX;
  200.         (*w: Window;*)  j: CARDINAL;
  201.  
  202.     BEGIN
  203.         (*
  204.         OpenWindow (w, yellow, brown, 0, 24, 0, 79, simpleframe, nodivider);
  205.         SelectWindow (w);
  206.         *)
  207.         WriteString ("INVERTING A SQUARE MATRIX");
  208.         WriteLn;
  209.  
  210.         (* Give a value to the A matrix. *)
  211.  
  212.         Random (A, N, N);
  213.         WriteString ("Matrix A is");  WriteLn;
  214.         Write (A, N, N, 10);
  215.  
  216.         (* Invert it. *)
  217.  
  218.         Invert (A, X, N);
  219.  
  220.         (* Write the solution. *)
  221.  
  222.         WriteLn;
  223.         WriteString ("The inverse of A is");  WriteLn;
  224.         Write (X, N, N, 10);
  225.  
  226.         (* Check that the solution looks right. *)
  227.  
  228.         Mul (A, X, N, N, N, B);
  229.         WriteLn;
  230.         WriteString ("As a check, the product evaluates to");  WriteLn;
  231.         Write (B, N, N, 10);
  232.  
  233.         PressAnyKey;
  234.         WriteLn;  WriteString ("EIGENVALUES");  WriteLn;
  235.         WriteString ("The eigenvalues of A are");  WriteLn;
  236.         Eigenvalues (A, W, N);
  237.         FOR j := 1 TO N DO
  238.             WriteString ("    ");  Cx.Write (W[j], 10);  WriteLn;
  239.         END (*FOR*);
  240.  
  241.         PressAnyKey;
  242.         WriteString ("The eigenvalues of its inverse are");  WriteLn;
  243.         Eigenvalues (X, W, N);
  244.         FOR j := 1 TO N DO
  245.             WriteString ("    ");  Cx.Write (W[j], 10);  WriteLn;
  246.         END (*FOR*);
  247.  
  248.         PressAnyKey;
  249.         (*CloseWindow (w);*)
  250.  
  251.     END InversionTest;
  252.  
  253. (************************************************************************)
  254. (*                              MAIN PROGRAM                            *)
  255. (************************************************************************)
  256.  
  257. BEGIN
  258.     BasicTest;
  259.     SolveTest;
  260.     SingularTest;
  261.     InversionTest;
  262. END MatTest.
  263.  
  264.