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