home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Pascal / MAXONPASCAL3.DMS / in.adf / DEMOS-OS1.3 / berno.p < prev    next >
Encoding:
Text File  |  1994-07-23  |  1.7 KB  |  82 lines
  1. { MaxonPascal3-Anpassung / Test:  Falk Zühlsdorff (PackMAN) 1994 }
  2.  
  3. PROGRAM Bernoulli(input,output);
  4.  
  5. CONST max = 50;
  6.  
  7. TYPE Bruch = Record z,n:integer END;
  8.  
  9. VAR B:Array[0..max] Of Bruch;
  10.     anz,m,i,j,k:integer;
  11.  
  12. FUNCTION Binoko(n,k:integer):integer;
  13.   VAR nf,kf,nkf,i:integer;
  14.   BEGIN
  15.     nf:=1; kf:=1; nkf:=1;
  16.     For i:=1 To n Do
  17.       BEGIN
  18.         nf:=nf*i;
  19.         If i=k   Then  kf:=nf;
  20.         If i=n-k Then nkf:=nf
  21.       END;
  22.     Binoko:=nf Div (kf*nkf)
  23.   END;
  24.  
  25. FUNCTION ggt(a,b:integer):integer;
  26.   BEGIN
  27.     While a<>b Do
  28.       If a>b Then a:=a-b
  29.              Else b:=b-a;
  30.     ggt:=a
  31.   END;
  32.  
  33. PROCEDURE Add(VAR b:Bruch; x,y:integer);
  34.   VAR g:integer;
  35.   BEGIN
  36.     If x<>0 Then
  37.       If b.z=0 Then
  38.         BEGIN b.z:=x; b.n:=y END
  39.       Else
  40.       BEGIN
  41.         g:=ggt(b.n,y);
  42.         b.z:=(y div g)*b.z + (b.n div g)*x;
  43.         b.n:=(b.n div g)*y;
  44.         If b.n<0 Then BEGIN b.z:=-b.z;b.n:=-b.n END;
  45.         If b.z=0 Then b.n:=1
  46.          Else
  47.           BEGIN
  48.             g:=ggt(abs(b.z),b.n);
  49.             b.n := b.n div g;
  50.             b.z := b.z div g
  51.           END
  52.       END
  53.   END;
  54.  
  55. BEGIN
  56.   write('Anzahl:');readln(anz);
  57.   writeln;
  58.   B[0].z:=1;
  59.   B[0].n:=1;
  60.   For m:=1 to anz do
  61.     BEGIN
  62.       B[m].z:=0;
  63.       B[m].n:=1;
  64.       For i:=0 to m-1 Do
  65.         BEGIN
  66.           j:= binoko(m+1,i)*B[i].z;
  67.           If j<>0 Then
  68.             BEGIN
  69.               k:= ggt(abs(j),abs(B[i].n));
  70.               add(b[m], j div k, B[i].n div k)
  71.             END
  72.         END;
  73.       If B[m].z=0 Then k:=m+11 Else k:=ggt(abs(B[m].z), m+1);
  74.       B[m].z := (-B[m].z) Div k;
  75.       B[m].n := B[m].n * ((m+1) Div k);
  76.       write('B(', m:2 , ') = ' , B[m].z:10);
  77.       If B[m].z=0 Then writeln Else writeln('/',B[m].n:1)
  78.     END;
  79.   writeln
  80. END.
  81.  
  82.