home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Pascal / Libraries / Hi-Performance Trigs 1.0 / Tables⁄Demos / CalcErr.p next >
Encoding:
Text File  |  1992-12-06  |  4.8 KB  |  229 lines  |  [TEXT/PJMM]
  1. program CalcErr;
  2.  
  3. {}
  4. {}
  5. { This program tests the mean accuracy of the sine, cosine and tangens tables. Use the Run... }
  6. { Menu to select the correct table. This program calculates the mean error mentioned in the  }
  7. { Appendix B of the Fast Performance Trigs documentation                                                    }
  8. {}
  9. { © 1992 by Christian Franz }
  10. {}
  11. {}
  12. { To generate only summary output, set the visual compiler directive to FALSE }
  13.  
  14.  
  15.     uses
  16.         FastPerfTrigs;
  17.  
  18.     var
  19.         i: integer;
  20.         x, y: integer;
  21.         a: real;
  22.         TheErr: OSErr;
  23.         count: Integer;
  24.         Delta: real;
  25.         maxdelta: real;
  26.         Sumdelta: real;
  27.         deltapos: real;
  28.         t1, t2: real;
  29.         Trect: Rect;
  30.  
  31.     const
  32.         Tries = 20;
  33.         treshold = 2;
  34.  
  35.     function S (r: real; accuracy: integer): Str255;
  36.  
  37.         var
  38.             theString: Str255;
  39.             Digit: Str255;
  40.             n: integer;
  41.  
  42.     begin
  43.         n := TRUNC(r);
  44.         NumToString(n, theString);
  45.         if (r < 0) and (n = 0) then
  46.             theString := concat('-', theString);
  47.         if r > 0 then
  48.             theString := Concat(' ', theString);
  49.         theString := Concat(theString, '.');
  50.         r := r - n;
  51.         r := abs(r); (* kill sign *)
  52.         while Length(theString) < accuracy do
  53.             begin
  54.                 r := r * 10;
  55.                 n := TRUNC(r);
  56.                 NumToString(n, Digit);
  57.                 theString := Concat(theString, Digit);
  58.                 r := r - n;
  59.             end;
  60.         S := theString;
  61.     end;
  62.  
  63. begin
  64.     SetRect(Trect, 0, 20, 520, 380);
  65.     SetTextRect(Trect);
  66.     ShowText;
  67.     TheErr := InitTrigs;
  68.     if theErr <> noErr then
  69.         Writeln('ResErr...');
  70.     count := 0;
  71.     maxdelta := -1;
  72.     sumdelta := 0;
  73.  
  74.     writeln('Beginning Sine-Test');
  75.     for i := 1 to Tries do
  76.         begin
  77. {$IFC Visual <> TRUE }
  78.             if i mod 50 = 0 then
  79.                 write('.');
  80. {$ENDC}
  81.  
  82.             count := count + 1;
  83.             x := Random;
  84.             y := Random;
  85.             a := x / y;
  86.  
  87. {$IFC Visual = TRUE }
  88.             write('x : ', S(a, 8));
  89.             write('   sin(x) : ', S(sin(a), 8));
  90.             write('   FSin(x) : ', S(FSin(a), 8));
  91. {$ENDC }
  92.  
  93.             Delta := abs(sin(a) - FSin(a));
  94.             if Delta > maxDelta then
  95.                 begin
  96.                     maxDelta := Delta;
  97.                     deltapos := a;
  98.                 end;
  99.  
  100.  
  101.             sumdelta := sumdelta + delta;
  102. {$IFC Visual = TRUE }
  103.             write(' || Δ = ', S(delta, 8));
  104.             writeln;
  105. {$ENDC}
  106.         end;
  107.     writeln;
  108.     writeln('Results of Sine test:');
  109.     writeln('Maximum Δ at ', S(deltapos, 8), ' with ', S(maxdelta, 8));
  110.     writeln;
  111.     writeln('Mean Δ at ', count : 8, ' tries : ', S(sumdelta / count, 8));
  112.  
  113.     writeln;
  114.     writeln;
  115.     writeln;
  116.  
  117.     count := 0;
  118.     maxdelta := -1;
  119.     sumdelta := 0;
  120.  
  121.     writeln('Beginning Cosine-Test');
  122.     for i := 1 to Tries do
  123.         begin
  124. {$IFC Visual <> TRUE }
  125.             if i mod 50 = 0 then
  126.                 write('.');
  127. {$ENDC}
  128.  
  129.             count := count + 1;
  130.             x := Random;
  131.             y := Random;
  132.             a := x / y;
  133. {$IFC Visual = TRUE }
  134.             write('x : ', S(a, 8));
  135.             write('   cos(x) : ', S(cos(a), 8));
  136.             write('   FCos(x) : ', S(FCos(a), 8));
  137. {$ENDC }
  138.             t1 := cos(a);
  139.             t2 := FCos(a);
  140.             Delta := abs(cos(a) - FCos(a));
  141.             if Delta > maxDelta then
  142.                 begin
  143.                     maxDelta := Delta;
  144.                     deltapos := a;
  145.                 end;
  146.  
  147.             sumdelta := sumdelta + delta;
  148. {$IFC Visual = TRUE }
  149.             write(' || Δ = ', S(delta, 8));
  150.             if Delta > 1 then
  151.                 begin
  152.                     write(' -> Delta > 1! ');
  153.                 end;
  154.             writeln;
  155. {$ENDC}
  156.         end;
  157.     writeln;
  158.     writeln('Results of Cosine test:');
  159.     writeln('Maximum Δ at ', S(deltapos, 8), ' with ', S(maxdelta, 8));
  160.     writeln;
  161.     writeln('Mean Δ at ', count : 8, ' tries : ', S(sumdelta / count, 8));
  162.  
  163.  
  164.     writeln;
  165.     writeln;
  166.     writeln;
  167.  
  168.     count := 0;
  169.     maxdelta := -1;
  170.     sumdelta := 0;
  171.  
  172.     writeln('Beginning Tangens-Test');
  173.     for i := 1 to Tries do
  174.         begin
  175. {$IFC Visual <> TRUE }
  176.             if i mod 50 = 0 then
  177.                 write('.');
  178. {$ENDC}
  179.             count := count + 1;
  180.             x := Random;
  181.             y := Random;
  182.             a := x / y;
  183. {$IFC Visual = TRUE }
  184.             write('x : ', S(a, 8));
  185.             write('   tan(x) : ', S(tan(a), 8));
  186.             write('   FTan(x) : ', S(FTan(a), 8));
  187.             write(' [', S(FSin(a) / FCos(a), 8), ']');
  188. {$ENDC}
  189.             t1 := tan(a);
  190.             t2 := FTan(a);
  191.             Delta := abs(tan(a) - FTan(a));
  192.             if (Delta > maxDelta) and (t1 < treshold) then
  193.                 begin
  194.                     maxDelta := Delta;
  195.                     deltapos := a;
  196.                 end;
  197.  
  198.             if abs(t1) < treshold then
  199.                 sumdelta := sumdelta + delta
  200.             else
  201.                 count := count - 1;
  202. {$IFC Visual = TRUE }
  203.             write(' || Δ = ', S(delta, 8));
  204.             if abs(t1) > treshold then
  205.                 write('*');
  206.  
  207.             if Delta > 1 then
  208.                 write('+');
  209.  
  210.             writeln;
  211. {$ENDC}
  212.         end;
  213.     writeln;
  214. {$IFC Visual = TRUE }
  215.     writeln('  * Means : Function value was greater than filter treshold. It will not be used ');
  216.     writeln('            for accuracy evaluation');
  217.     writeln('  + Means : Difference between FPU and lookuptable was greater than 1.');
  218. {$ENDC}
  219.     writeln;
  220.     writeln('Results of Tangens test:');
  221.     writeln('Maximum Δ at ', S(deltapos, 8), ' with ', S(maxdelta, 8));
  222.     writeln;
  223.     writeln('Mean Δ at ', count : 8, ' tries : ', S(sumdelta / count, 8));
  224.     writeln('  (Treshold at ', S(treshold, 8), ')');
  225.  
  226.     writeln('TableResulution (Sine   ) was at ', GetSinResolution, ' Values for 2π.');
  227.     writeln('TableResulution (Cosine ) was at ', GetCosResolution, ' Values for 2π.');
  228.     writeln('TableResulution (Tangent) was at ', GetTanResolution, ' Values for 2π.');
  229. end.