home *** CD-ROM | disk | FTP | other *** search
/ CD Shareware Magazine 1996 December / CD_shareware_12-96.iso / DOS / Programa / NUMANA01.ZIP / SRC / TESTS / POLYTEST.MOD < prev    next >
Encoding:
Text File  |  1996-08-16  |  6.5 KB  |  209 lines
  1. MODULE PolyTest;
  2.  
  3.         (********************************************************)
  4.         (*                                                      *)
  5.         (*              Test of Polynomials module              *)
  6.         (*                                                      *)
  7.         (*  Programmer:         P. Moylan                       *)
  8.         (*  Last edited:        31 July 1996                    *)
  9.         (*  Status:             Working                         *)
  10.         (*                                                      *)
  11.         (********************************************************)
  12.  
  13. IMPORT Cx;
  14.  
  15. FROM Poly IMPORT
  16.     (* type *)  Polynomial,
  17.     (* proc *)  Init, Assign, Destroy, Write, Add, Sub, Mul, Div,
  18.                 Degree, Mueller, Newton, FindRoots;
  19.  
  20. FROM MiscM2 IMPORT
  21.     (* type *)  Window,
  22.     (* proc *)  SelectWindow, WriteString, WriteLn, PressAnyKey;
  23.  
  24. (*
  25. FROM Windows IMPORT
  26.     (* type *)  Window, Colour, FrameType, DividerType,
  27.     (* proc *)  OpenWindow, CloseWindow;
  28. *)
  29.  
  30. (************************************************************************)
  31.  
  32. TYPE
  33.     Array3 = ARRAY [0..2] OF LONGREAL;
  34.     Array4 = ARRAY [0..3] OF LONGREAL;
  35.     Array5 = ARRAY [0..4] OF LONGREAL;
  36.     Array6 = ARRAY [0..5] OF LONGREAL;
  37.     Array11 = ARRAY [0..10] OF LONGREAL;
  38.  
  39. (************************************************************************)
  40.  
  41. PROCEDURE BasicTest;
  42.  
  43.     (* Checks some simple polynomial operations. *)
  44.  
  45.     CONST linesize = 78;
  46.  
  47.     VAR P1, P2, P3, P4: Polynomial;
  48.         w1, w2, w3: Window;
  49.  
  50.     BEGIN
  51.         (*
  52.         OpenWindow (w1, yellow, blue, 0, 5, 0, 39, simpleframe, nodivider);
  53.         OpenWindow (w2, yellow, blue, 0, 5, 40, 79, simpleframe, nodivider);
  54.         OpenWindow (w3, yellow, blue, 5, 24, 0, 1+linesize,
  55.                                         simpleframe, nodivider);
  56.         *)
  57.         (* For our present version, Window variables are dummies. *)
  58.         w1 := 1;  w2 := 2;  w3 := 3;
  59.         SelectWindow (w3);
  60.         WriteString ("TEST OF SIMPLE POLYNOMIAL OPERATIONS");
  61.         WriteLn;  WriteLn;
  62.  
  63.         Init(P1);  Init(P2);  Init(P3);  Init(P4);
  64.  
  65.         (* Create polynomials P1 and P2. *)
  66.  
  67.         Assign (P1, Array3{1.0, 2.0, 3.0});
  68.         SelectWindow (w1);
  69.         WriteString ("Polynomial P1 is");  WriteLn;
  70.         Write (P1, 8, linesize);
  71.         Assign (P2, Array6{5.0, -2.0, 0.0, 0.0, -3.0, 1.0});
  72.         SelectWindow (w2);
  73.         WriteString ("Polynomial P2 is");  WriteLn;
  74.         Write (P2, 8, linesize);
  75.  
  76.         (* Do some arithmetic with them. *)
  77.  
  78.         SelectWindow (w3);
  79.         Add (P1, P2, P3);
  80.         WriteString ("P1 + P2 is");  WriteLn;
  81.         Write (P3, 8, linesize);  WriteLn;
  82.         Sub (P1, P2, P3);
  83.         WriteString ("P1 - P2 is");  WriteLn;
  84.         Write (P3, 8, linesize);  WriteLn;
  85.         Mul (P1, P2, P3);
  86.         WriteString ("P1 * P2 is");  WriteLn;
  87.         Write (P3, 8, linesize);  WriteLn;
  88.         PressAnyKey;
  89.         WriteString ("--------------------------");  WriteLn;
  90.  
  91.         (* Division tests. *)
  92.  
  93.         Div (P1, P2, P3, P4);
  94.         WriteString ("P1 / P2: the quotient is  ");  WriteLn;
  95.         Write (P3, 8, linesize);  WriteLn;
  96.         WriteString ("and the remainder is");  WriteLn;
  97.         Write (P4, 8, linesize);  WriteLn;
  98.         WriteString ("Check: quotient*P2 + remainder is ");  WriteLn;
  99.         Mul (P3, P2, P3);  Add (P3, P4, P3);
  100.         Write (P3, 8, linesize);  WriteLn;
  101.         PressAnyKey;
  102.         WriteString ("--------------------------");  WriteLn;
  103.  
  104.         Div (P2, P1, P3, P4);
  105.         WriteString ("P2 / P1: the quotient is  ");  WriteLn;
  106.         Write (P3, 8, linesize);  WriteLn;
  107.         WriteString ("and the remainder is");  WriteLn;
  108.         Write (P4, 8, linesize);  WriteLn;
  109.         WriteString ("Check: quotient*P1 + remainder is ");  WriteLn;
  110.         Mul (P3, P1, P3);  Add (P3, P4, P3);
  111.         Write (P3, 8, linesize);  WriteLn;
  112.  
  113.         PressAnyKey;
  114.         WriteString ("--------------------------");  WriteLn;
  115.         Destroy (P1);  Destroy (P2);  Destroy (P3);  Destroy (P4);
  116.         (*
  117.         CloseWindow (w1);
  118.         CloseWindow (w2);
  119.         CloseWindow (w3);
  120.         *)
  121.  
  122.     END BasicTest;
  123.  
  124. (************************************************************************)
  125.  
  126. PROCEDURE RootTest;
  127.  
  128.     (* Roots of polynomials. *)
  129.  
  130.     CONST linesize = 78;
  131.  
  132.     VAR P: Polynomial;
  133.         w: Window;
  134.  
  135.     PROCEDURE DoRootTest;
  136.  
  137.         VAR allroots: ARRAY [0..20] OF LONGCOMPLEX;
  138.             j: CARDINAL;
  139.  
  140.         BEGIN
  141.             WriteString ("Polynomial P is");  WriteLn;
  142.             Write (P, 8, linesize);
  143.             FindRoots (P, allroots);
  144.             WriteString ("We found the following roots:");
  145.             WriteLn;
  146.             FOR j := 0 TO VAL(CARDINAL,Degree(P))-1 DO
  147.                 Cx.Write (allroots[j], 12);
  148.                 WriteLn;
  149.             END (*FOR*);
  150.         (*
  151.             Mueller (P, root);
  152.             WriteString ("Found the root ");
  153.             Cx.Write (root, 12);
  154.             WriteLn;
  155.             Newton (P, root);
  156.             WriteString ("By Newton's method, improved this to");
  157.             WriteLn;
  158.             Cx.Write (root, 12);
  159.             WriteLn;
  160.         *)
  161.             PressAnyKey;
  162.             WriteString ("--------------------------");  WriteLn;
  163.         END DoRootTest;
  164.  
  165.     BEGIN
  166.         (*
  167.         OpenWindow (w, yellow, blue, 0, 24, 0, 1+linesize,
  168.                                         simpleframe, nodivider);
  169.         *)
  170.         w := 0;
  171.         SelectWindow (w);
  172.         WriteString ("ROOTS OF POLYNOMIALS");
  173.         WriteLn;  WriteLn;
  174.  
  175.         Init(P);
  176.  
  177.         (* Run examples for a few polynomials P. *)
  178.  
  179.         Assign (P, Array3{2.0, -3.0, 1.0});
  180.         DoRootTest;
  181.         Assign (P, Array3{1.0, 2.0, 3.0});
  182.         DoRootTest;
  183.         Assign (P, Array4{6.0, 11.0, 6.0, 1.0});
  184.         DoRootTest;
  185.         Assign (P, Array6{0.0, 4.0, 0.0, 0.0, 0.0, 1.0});
  186.         DoRootTest;
  187.  
  188.         (* This next test still giving wrong answers. *)
  189.  
  190.         Assign (P, Array11{1.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,1.0});
  191.         DoRootTest;
  192.  
  193.         Destroy (P);
  194.         WriteString ("End of tests");
  195.  
  196.         (*CloseWindow (w);*)
  197.  
  198.     END RootTest;
  199.  
  200. (************************************************************************)
  201. (*                              MAIN PROGRAM                            *)
  202. (************************************************************************)
  203.  
  204. BEGIN
  205.     BasicTest;
  206.     RootTest;
  207. END PolyTest.
  208.  
  209.