home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / TPREAL2.ZIP / TEST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-03-13  |  5.9 KB  |  258 lines
  1. {$N-}   { turn off math-coprocessor }
  2. uses rlib,crt,dos;
  3. type
  4.   command = ( start,stop );
  5. const
  6.   funcname:array [1..9] of string[10] =
  7.   (
  8.    'Savage    ',
  9.    'Multiply  ',
  10.    'Divide    ',
  11.    'Squareroot',
  12.    'Sin       ',
  13.    'Cos       ',
  14.    'Arctan    ',
  15.    'Exp       ',
  16.    'Log       '
  17.   );
  18. var
  19.   time,time1,time2:real;
  20.   funcno,iter,i:word;
  21.   x,y,z:real;
  22.   s:string;
  23.   ch:char;
  24.  
  25. procedure timer(c:command);
  26. var
  27.   hour,min,sec,sec100:word;
  28. begin
  29.   gettime(hour,min,sec,sec100);
  30.   if c = start then time:=0 else time:=-time;
  31.   time:=time+3600*hour+60*min+sec+sec100/100;
  32.   if time < 0 then time:=time+86400;
  33. end;
  34.  
  35. procedure dispfunc;
  36. var
  37.   x,y:word;
  38. begin
  39.   x:=wherex;y:=wherey;
  40.   window(1,1,80,25);
  41.   gotoxy(19,25);
  42.   write(funcname[funcno]);
  43.   window(1,3,80,23);
  44.   gotoxy(x,y);
  45. end;
  46.  
  47. procedure dispiter;
  48. var
  49.   x,y:word;
  50. begin
  51.   x:=wherex;y:=wherey;
  52.   window(1,1,80,25);
  53.   gotoxy(63,25);
  54.   write(iter,'    ');
  55.   window(1,3,80,23);
  56.   gotoxy(x,y);
  57. end;
  58.  
  59.  
  60.  
  61.  
  62. begin
  63.   clrscr;
  64.   writeln(
  65. ' 1.Savage  2.Multiply  3.Divide  4.Sqrt  5.Sin  6.Cos  7.Arctan  8.Exp  9.Log'
  66.     );
  67.   gotoxy(1,25);
  68.   write(
  69.   'Function chosen =                          No of iterations =');
  70.   window(1,3,80,23);
  71.   funcno:=1;iter:=1000;dispfunc;dispiter;
  72.   while true do
  73.   begin write(
  74.   'To change function, enter new function number else press return : ');
  75.   readln(s);
  76.     if s <> '' then val(s,funcno,i);
  77.     dispfunc;
  78.     writeln(
  79. 'To change no of iterations, enter new value ( 0 to 65535 ) else');
  80. write('press return : ');readln(s);
  81.     if s <> '' then val(s,iter,i);
  82.     dispiter;
  83.     if funcno > 1 then
  84.     begin
  85.       write('x = ');readln(x);
  86.     end;
  87.     if (funcno = 2) or (funcno = 3) then
  88.     begin
  89.       write('y = ');readln(y);
  90.     end;
  91.     case funcno of
  92.       1:{ savage }
  93.       begin
  94.         x:=1;
  95.         timer(start);
  96.         for i:=1 to iter do
  97.         begin
  98.           x:=exp(ln(sqrt(x*x)));
  99.           y:=arctan(1+1/x);
  100.           x:=x*sin(y);x:=x/cos(y);
  101.         end;
  102.         timer(stop);
  103.         writeln(
  104.   'Cumulative error in Turbo Pascal''s routine after ',iter,' iterations = '
  105.                );
  106.         writeln(abs(x-iter-1));
  107.       end;
  108.       2:
  109.       begin
  110.         timer(start);
  111.         for i:=1 to iter do z:=x*y;
  112.         timer(stop);
  113.         writeln('x * y = ',z,' ( according to Turbo Pascal )');
  114.       end;
  115.       3:
  116.       begin
  117.         timer(start);
  118.         for i:=1 to iter do z:=x/y;
  119.         timer(stop);
  120.         writeln('x / y = ',z,' ( according to Turbo Pascal )');
  121.       end;
  122.       4:
  123.       begin
  124.         timer(start);
  125.         for i:=1 to iter do z:=sqrt(x);
  126.         timer(stop);
  127.         writeln('Sqrt(x) = ',z,' ( according to Turbo Pascal )');
  128.       end;
  129.       5:
  130.       begin
  131.         timer(start);
  132.         for i:=1 to iter do z:=sin(x);
  133.         timer(stop);
  134.         writeln('Sin(x) = ',z,' ( according to Turbo Pascal )');
  135.       end;
  136.       6:
  137.       begin
  138.         timer(start);
  139.         for i:=1 to iter do z:=cos(x);
  140.         timer(stop);
  141.         writeln('Cos(x) = ',z,' ( according to Turbo Pascal )');
  142.       end;
  143.       7:
  144.       begin
  145.         timer(start);
  146.         for i:=1 to iter do z:=arctan(x);
  147.         timer(stop);
  148.         writeln('Arctan(x) = ',z,' ( according to Turbo Pascal )');
  149.       end;
  150.       8:
  151.       begin
  152.         timer(start);
  153.         for i:=1 to iter do z:=exp(x);
  154.         timer(stop);
  155.         writeln('Exp(x) = ',z,' ( according to Turbo Pascal )');
  156.       end;
  157.       9:
  158.       begin
  159.         timer(start);
  160.         for i:=1 to iter do z:=ln(x);
  161.         timer(stop);
  162.         writeln('Ln(x) = ',z,' ( according to Turbo Pascal )');
  163.       end;
  164.     end;
  165.     writeln('Time taken by Turbo Pascal''s routine = ',time:3:2,' secs.');
  166.     time1:=time;
  167.     case funcno of
  168.       1:{ savage }
  169.       begin
  170.         x:=1;
  171.         timer(start);
  172.         for i:=1 to iter do
  173.         begin
  174.           x:=_exp(_ln(_sqrt(_mul(x,x))));
  175.           y:=_arctan(1+_div(1,x));
  176.           x:=_mul(x,_sin(y));x:=_div(x,_cos(y));
  177.         end;
  178.         timer(stop);
  179.         writeln(
  180.     'Cumulative error in improved routine''s after ',iter,' iterations = '
  181.                );
  182.         writeln(abs(x-iter-1));
  183.       end;
  184.       2:
  185.       begin
  186.         timer(start);
  187.         for i:=1 to iter do z:=_mul(x,y);
  188.         timer(stop);
  189.                 writeln('x * y = ',z,' ( according to improved routine )');
  190.       end;
  191.       3:
  192.       begin
  193.         timer(start);
  194.         for i:=1 to iter do z:=_div(x,y);
  195.         timer(stop);
  196.                 writeln('x / y = ',z,' ( according to improved routine )');
  197.       end;
  198.       4:
  199.       begin
  200.         timer(start);
  201.         for i:=1 to iter do z:=_sqrt(x);
  202.         timer(stop);
  203.                 writeln('Sqrt(x) = ',z,' ( according to improved routine )');
  204.       end;
  205.       5:
  206.       begin
  207.         timer(start);
  208.         for i:=1 to iter do z:=_sin(x);
  209.         timer(stop);
  210.                 writeln('Sin(x) = ',z,' ( according to improved routine )');
  211.       end;
  212.       6:
  213.       begin
  214.         timer(start);
  215.         for i:=1 to iter do z:=_cos(x);
  216.         timer(stop);
  217.                 writeln('Cos(x) = ',z,' ( according to improved routine )');
  218.       end;
  219.       7:
  220.       begin
  221.         timer(start);
  222.         for i:=1 to iter do z:=_arctan(x);
  223.         timer(stop);
  224.                 writeln('Arctan(x) = ',z,' ( according to improved routine )');
  225.       end;
  226.       8:
  227.       begin
  228.         timer(start);
  229.         for i:=1 to iter do z:=_exp(x);
  230.         timer(stop);
  231.                 writeln('Exp(x) = ',z,' ( according to improved routine )');
  232.       end;
  233.       9:
  234.       begin
  235.         timer(start);
  236.         for i:=1 to iter do z:=_ln(x);
  237.         timer(stop);
  238.                 writeln('Ln(x) = ',z,' ( according to improved routine )');
  239.       end;
  240.     end;
  241.         writeln('Time taken by improved routine = ',time:3:2,' secs.');
  242.     time2:=time;
  243.     writeln(
  244.     'Speed improvement in improved routine = ',(100*(time1-time2)/time2):3:0,' %');
  245.   writeln;
  246.   end;
  247. end.
  248.  
  249.  
  250.  
  251.  
  252.  
  253.  
  254.  
  255.  
  256.  
  257.  
  258.