整理我以前的PASCAL源程序-高精度计算(2)计算自然对数底e

来源:互联网 发布:汉字注音软件下载 编辑:程序博客网 时间:2024/06/06 01:22
算自然对数底e,比起算圆周率甚至还要简单。直接利用e的级数算就行。下面的程序算到e的小数点后一万位。

program se;
label ext;
const
     dn=2504;
var
    n,i,ip,k:integer;
    sum,a:array[1..dn] of integer;

procedure testk;
var
   ch:char;
begin
     if k mod 10=0 then write(' ');
     if (k mod 50=0) and (k mod 1000<>0) then
              writeln(':',k:8);
     if k mod 1000<>0 then exit;
     writeln(':',k:8,'  Press Enter..');
     readln;
end;

procedure outp;
var
  i:integer;
begin
   writeln('e=');
   writeln(sum[1],'.');
   k:=0;
   for i:=2 to dn do
      begin
          write(sum[i] div 1000);  k:=k+1; testk;
          write(sum[i] div 100 mod 10); k:=k+1; testk;
          write(sum[i] div 10 mod 10 ); k:=k+1; testk;
          write(sum[i] mod 10);  k:=k+1; testk;
      end;
   writeln;
   writeln('Programmed by j.t.chang');
end;

procedure formats;
var
   c:integer;
begin
     c:=0;
    for i:=dn downto 1 do
      begin
           sum[i]:=sum[i]+c;
           c:=sum[i] div 10000;
           sum[i]:=sum[i] mod 10000;
      end;
end;
procedure m_div;
var
   i:integer;
   r1,c:longint;
begin
   c:=0;
   for i:=ip to dn do
      begin
         r1:=c*10000+a[i];
         a[i]:=r1 div n;
         sum[i]:=sum[i]+a[i];
         c:=r1 mod n;
      end;
end;

begin
    writeln('Please wait...');
    for i:=1 to dn do a[i]:=0;
    a[1]:=1;
    sum:=a;
    n:=1;
    ip:=1;
    repeat
       i:=ip;
       while (a[i]=0) do
         begin
            i:=i+1;
            if i>dn then goto ext;
         end;
        ip:=i;
        m_div;
        n:=n+1;
        formats;
    until false;
ext:
    formats;
    outp;
end.