1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:

program BinomAnteil;
{$APPTYPE CONSOLE}
uses
  sysutils;
const
  ANZAHL = 1000;
var
  i,n,k : longint;
  q,p,Faktor,logFaktor,logAnteil,Anteil,SummeAnteile,MittlererWert: double;

  WerteFeld :array[0..ANZAHL-1] of double;


Procedure WerteFeldBelegen;
var
  i: longint;
begin
  For i := 0 to ANZAHL-1 do
    WerteFeld[i] := WerteFeld[i]+i/(ANZAHL-1);
end;

BEGIN
  WerteFeldBelegen;
  writeln(ANZAHL,' Werte von ',WerteFeld[0]:0:0,'..',WerteFeld[Anzahl-1]:0:0,' aufsteigend');
  //n = ANZAHL-1 (0..ANZAHL-1) hat ANZAHL Elemente
  n := ANZAHL-1;
  for k := 1 to 19 do
    begin
    p := k/20;
    q := 1.0-p;
    Faktor := p/q;
    logFaktor := ln(Faktor);
    //Anteil(n,k) = (n ueber k)*p^(n-k)*(1-p)^k
    //=>Anteil(n,k)/Anteil(n,k-1) = (n-k+1)/k*p/q
    //Werte an der Stelle 0 = (n ueber 0)*q^n*p^0=q^n
    logAnteil := n*ln(q);
    Anteil := exp(logAnteil);//=q^N
    SummeAnteile := Anteil;
    MittlererWert := SummeAnteile*WerteFeld[0];
    if Anteil > 0 then
      begin
      for i := 1 to N do
         begin
         Anteil := Anteil/i*(n-i+1)*Faktor;//=(n überk)*p^i*q^(n-i);
         if Anteil = 0 then
            break;
         MittlererWert := MittlererWert+Anteil*WerteFeld[i];
         SummeAnteile := SummeAnteile+Anteil;
         end;
      writeln('Werte fuer ',p:4:3,' ist ',MittlererWert:15:9,'   ',SummeAnteile:15:2);
      end
    else
      begin
      for i := 1 to N do
         begin
         logAnteil := logAnteil-ln(i)+ln(ANZAHL-I)+logFaktor;
         Anteil := exp(logAnteil);
         MittlererWert := MittlererWert+Anteil*WerteFeld[i];
         SummeAnteile := SummeAnteile+Anteil;
         end;
      writeln('Werte fuer ',p:4:3,' ist ',MittlererWert:15:9,'   ',SummeAnteile:15:2,' log');
      end;
end;
end.                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:

function binomial(n, k: Integer): Integer;
var x, y: Integer;
    pas_dreieck: array of array of Integer;
begin
    result:=0;
    if n-k < k then k := n-k;
    if k=0 then result := 1;
    if k=1 then result := n;
    if k>1 then
    begin
        setlength(pas_dreieck,k+1,n+1);
        for y:=0 to n do pas_dreieck[0,y] := 1;
        for y:=1 to n do pas_dreieck[1,y] := y;
        for x:=2 to k do
            for y := x to n do
                pas_dreieck[x,y] := pas_dreieck[x-1,y-1] + pas_dreieck[x,y-1];
        result := pas_dreieck[k,n];
    end;
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:

{$APPTYPE Console}
var
  k,n:integer;


function Binom(n,k:integer): int64;
var
  i : integer;
begin
  {triviales abfangen fehlt}

  //k mit n-k tauschen, falls es sich lohnt
  i := n-k;
  If k>i then
    k := i;


  result := 1;
  For i := 1 to k do
    begin
    result := (n*result) div i;// Ist immer ohne Rest
    dec(n);
    end;
end;

function binomial(n, k: Integer): Int64;
var x, y: Integer;

    pas_dreieck: array of array of Int64;
begin
    result:=0;
    if n-k < k then k := n-k;
    if k=0 then result := 1;
    if k=1 then result := n;
    if k>1 then
    begin
        setlength(pas_dreieck,k+1,n+1);
        for y:=0 to n do pas_dreieck[0,y] := 1;
        for y:=1 to n do pas_dreieck[1,y] := y;
        for x:=2 to k do
            for y := x to n do
                pas_dreieck[x,y] := pas_dreieck[x-1,y-1] + pas_dreieck[x,y-1];
        result := pas_dreieck[k,n];
    end;
end;

function binomPas(n, k: Integer): Int64;
var x, y,idx,g: Integer;
    s: array[0..1]of int64;
    pas_dreieck: array of Int64;
begin
    result:=0;
    if n-k < k then k := n-k;
    if k=0 then
      result := 1;
    if k=1 then
      result := n;
    if k>1 then
      begin
      setlength(pas_dreieck,n);
      for y:=0 to n-1 do
        pas_dreieck[y] := 1;
      for y:= 1 to n-1 do
        begin
        S[0] := 1;//:= pas_dreieck[0];
        idx:=1;
        g := y-1;
        if g>k then
          g:= k;
        for x:= 1 to g do
          begin
          S[idx] := pas_dreieck[x];
          pas_dreieck[x] := S[0]+S[1];
          idx:=1-idx; //FlipFlop 0,1,0,1,0,1,0..
          end;
        end;
       result := pas_dreieck[k]+pas_dreieck[k-1];
    end;
end;

begin
  n := 61;
  For k := 0 to n do
    begin
    writeln(n,'|',k,' = ',binom(n,k));
    writeln(n,'|',k,' = ',binomPas(n,k));
    writeln(n,'|',k,' = ',binomial(n,k));
    end;
  readln;
end.