program Statistics;
//loc's = 360
// ...we discuss the 4 types of statistics:
{1. Permutation = n!
2. Permutation(Variation without repeating) = nPr = n!/(n-k)!
3. Combination (binominal coefficient)= nCr = nPr / k!
4. Variation(repeating) = n^k
where,
         n,k are non negative integers and k<=n.
         k is the size of each permutation.
         n is the size of the set from which elements are permuted.
         ! is the factorial operator.
  
1 Anordnungen (Permutationen)
2 Auswhlen mit Beachtung der Reihenfolge (Variationen)
    * 2.1 Variation ohne Zurcklegen
    * 4.1 Variation mit Zurcklegen
3 Auswhlen ohne Beachtung der Reihenfolge (Kombinationen)

{1. ex. 4*4 sudoku line = 567  (or runners in) 
2. ex. 21345 (11000)  = 12,20 (two first runners with 5 or 2 books from 5)
3. ex. 10100 = 10 (or lotto 6 aus 46)
4. ex. lock (zahlenschloss) = 10000}      


const 
  DIM = 660;
  PI2 = 6.28318530717958647692528676655901;
  E = 2.718281828459;
  BODY = 23;
  EMOTION = 28;
  SPIRIT = 33;
 
type TBIOVector = array[0..DIM] of TPoint; 
     Tperm = array[1..4] of byte;
     Tperm2 = array[1..5] of byte;
     TCube = array[1..6] of byte;


var
  cFrm: TForm;
  ageindays: integer;
  bodyPts, emoPts, spiritPts: TBIOVector;
  

procedure CalculateGraph(var bPts, ePts, sPts: TBIOVector);
var
  dayinterval, radian: Double;
  periodrange: integer;
  xRgePixs, yRgePixs, origx, origy, i: Integer;
begin
  { We calculate the biosinus curve in the interval -2Pi..+2Pi}
  xRgePixs:= (cFrm.Width - 2); { pixels in Pi }
  yRgePixs:= (cFrm.Height - 2) div 6; { pixels amplitude}
  origx:= cFrm.Width div 2 ;
  origy:= cFrm.Height div 2;
  periodrange:= 33;
  ageInDays:= 18263; //or input box  this is 20.6.2009
  dayInterval:= 0.1;
  radian:= ageInDays - periodRange;
  for i:= 0 to DIM do begin
    bPts[i].Y:= origy - Round(sin(PI2*(round(radian)
                                           mod BODY)/BODY)* yRgePixs);
    radian:= radian + dayinterval;
  end;
  radian:= ageInDays - periodRange;
  for i:= 0 to DIM do begin
    ePts[i].Y:= origy - Round(sin(PI2*(round(radian)
                                           mod EMOTION)/EMOTION)* yRgePixs);
    radian:= radian + dayinterval;
  end;
  radian:= ageInDays - periodRange;
  for i:= 0 to DIM do begin
    sPts[i].Y:= origy - Round(sin(PI2*(round(radian) 
                                           mod SPIRIT)/SPIRIT)* yRgePixs);
    radian:= radian + dayinterval;
  end;
end;

procedure DrawChart(bPts, ePts, sPts: TBIOVector);
var
  i: integer;
begin
  with cFrm.canvas do begin
    Pen.Color:= clBlue;
       moveto(1, (bPts[0].y));
    for i:= 1 to DIM do
      LineTo(i , bPts[i].Y);  
    Pen.Color:= clred;
    moveto(1, (ePts[0].y));
    for i:= 1 to DIM do
      LineTo(i , ePts[i].Y);  
    Pen.Color:= cllime;
    moveto(1, (sPts[0].y));
    for i:= 1 to DIM do
      LineTo(i , sPts[i].Y);  
  end;
end;

procedure PaintBox1Paint(Sender: TObject);
var
  origx, origy: integer;
  xRngPixs, yRngPixs: Integer;
begin
  with cFrm.Canvas do begin
    { Fill background in white }
    Brush.Color:= clBtnFace;
    Brush.Style:= bsSolid;
   { Paint a coordinate cross }
    origx:= (cfrm.Width div 2);
    origy:= (cfrm.Height div 2);
    Pen.Color:= clBlack;
    Pen.Style:= psSolid;
    Pen.Width:= 1;
    MoveTo(1, origy);
    LineTo(cfrm.Width - 1, origy);
    MoveTo(origx, 1);
    LineTo(origx, cFrm.Height - 1);
    { Paint some tickmarks and label the axis }
    Font.Name:= 'Times';
    Font.Size:= 42;
    Font.Color:= clblue;
    xRngPixs:= (cFrm.Width - 20) div 4; { pixels in Pi }
    yRngPixs:= (cFrm.Height - 20) div 2; { pixels in 1 }
    TextOut(origx -2 * xRngPixs +2, origy -210, 'Statistics');
    font.Size:= 12;
    { X axis }
    MoveTo(origx -2 * xRngPixs, origy -4);
    LineTo(origx -2 * xRngPixs, origy +4);
    TextOut(origx -2 * xRngPixs +2, origy +2, '-2p');
    MoveTo(origx -xRngPixs, origy -4);
    LineTo(origx -xRngPixs, origy +4);
    TextOut(origx -xRngPixs +2, origy +2, '-p');
    MoveTo(origx +xRngPixs, origy -4);
    LineTo(origx +xRngPixs, origy +4);
    TextOut(origx +xRngPixs -2 -TextWidth('p'), origy +2, 'p');
    MoveTo(origx +2 * xRngPixs, origy -4);
    LineTo(origx +2 * xRngPixs, origy +4);
    TextOut(origx +2 * xRngPixs -2 -TextWidth('2p'), origy +2, '2p');
    { Y axis }
    MoveTo(origx -4, origy - yRngPixs);
    LineTo(origx +4, origy - yRngPixs);
    TextOut(origx +4, origy - yRngPixs, '1.0');
    MoveTo(origx -4, origy - yRngPixs div 2);
    LineTo(origx +4, origy - yRngPixs div 2);
    TextOut(origx +4, origy - (yRngPixs + TextHeight('1')) div 2, '0.5');
    MoveTo(origx -2, origy + yRngPixs div 2);
    LineTo(origx +2, origy + yRngPixs div 2);
    TextOut(origx +3, origy + (yRngPixs - TextHeight('1')) div 2, '-0.5');
    MoveTo(origx -2, origy + yRngPixs);
    LineTo(origx +2, origy + yRngPixs);
    TextOut(origx +3, origy + yRngPixs - TextHeight('1'), '-1.0');
    TextOut(origx +3, origy + (yRngPixs) -50, now);
    Font.Name:= 'Arial';
    Font.Color:= clBlue;
        TextOut(origx -2 * xRngPixs +2, origy +110, 'body');
    Font.Color:= clred;
        TextOut(origx -2 * xRngPixs +2, origy +130, 'emotion');
    Font.Color:= clLime;
        TextOut(origx -2 * xRngPixs +2, origy +150, 'spirit');
    {re Paint the graph }
    Pen.Color:= clBlue;
    DrawChart(bodyPts, emoPts, spiritPts);
  end;
end;


procedure Variation_Zahlenschloss_4;
//solution is sqr 4!4!4!4!  = 756 with diagonal = 48
var  
  i,k,l,m: byte;
  count: integer;
begin
  i:=1; k:=1;
  l:=1; m:=1;
  count:= 0;
  for i:= 0 to 9 do 
    for k:= 0 to 9 do 
      for l:= 0 to 9 do 
        for m:= 0 to 9 do begin
          writeln(inttostr(i)+inttostr(k)+ inttostr(l)+ inttostr(m))
          inc(count);        
        end;  
    writeln(inttostr(count)+' Variations')
    writeln('----------')
end;

procedure Permutation_Variation_without_2;
//Permutation(Variation without repeating) = nPr = n!/(n-k)!
// two runners with first or second place in a finisher run
var  
  i,k,l,m,n : byte;
  count: integer;
  suma: longint;
  perm: TPerm2;
begin
  perm[1]:= 1;
  perm[2]:= 2;
  perm[3]:= 4;
  perm[4]:= 8;
  perm[5]:= 16
  i:=1; k:=1;
  l:=1; m:=1; n:=1;
  count:= 0;
  suma:= 0;
  for i:= 1 to 5 do 
    for k:= 1 to 5 do 
      for l:= 1 to 5 do 
        for m:= 1 to 5 do 
          for n:= 1 to 5 do begin
          suma:= perm[i]+perm[k]+perm[l]+perm[m]+perm[n]
         //writeln(inttostr(suma)) 1+2+4+8+16=31; 1+2 together
          if (suma = 31) and 
           ((i+k = 3) or (k+l = 3) and (l+m = 3) and (m+n = 3)) then begin
            writeln(inttostr(i)+inttostr(k)+ inttostr(l)+ inttostr(m)
                                   +inttostr(n))
            inc(count);        
          end; 
         end;  
    writeln(inttostr(count)+' Perm Variations')
    writeln('----------')
end;


procedure Combination_without_3;
//binominal coefficient)= nCr = nPr / k!
var  
  i,k,l,m,n : byte;
  count: integer;
begin
  i:=1; k:=1;
  l:=1; m:=1; n:=1;
  count:= 0;
  for i:= 0 to 1 do 
    for k:= 0 to 1 do 
      for l:= 0 to 1 do 
        for m:= 0 to 1 do 
          for n:= 0 to 1 do 
          if i+k+l+m+n = 2 then begin 
            writeln(inttostr(i)+inttostr(k)+ inttostr(l)+ inttostr(m)
                             +inttostr(n))
            inc(count);        
          end;  
    writeln(inttostr(count)+' Combinations without')
    writeln('----------')
end;

procedure sudoku_permutation_1;
//solution is sqr 4!4!4!4!  = 756 with diagonal = 48
var  
   perm: TPerm;
   resu: array[1..24] of Tperm;
   i,k,l,m: byte;
   count, suma: integer;
begin
perm[1]:= 1;
perm[2]:= 2;
perm[3]:= 4;
perm[4]:= 8;
i:=1; k:=1; l:=1; m:=1;
count:= 0;
suma:= 0;
writeln('((((((((((((((start of full sudokus)))))))))))))))');
 for i:= 1 to 4 do 
   for k:= 1 to 4 do 
     for l:= 1 to 4 do 
       for m:= 1 to 4 do begin
         //writeln(inttostr(perm[i])+inttostr(perm[k])+inttostr(perm[l])+
         //inttostr(perm[m]))
         suma:= perm[i]+perm[k]+perm[l]+perm[m]
         if suma = 15 then begin
         //writeln(inttoStr(suma))
           inc(count);
           resu[count][1]:= perm[i]
           resu[count][2]:= perm[k]
           resu[count][3]:= perm[l]
           resu[count][4]:= perm[m]
           writeln(inttostr(resu[count][1])+inttostr(resu[count][2])+
                   inttostr(resu[count][3])+inttostr(resu[count][4]))        
         end;  
            //write(inttostr(perm[m]));
          //write('-')
       end
       writeln('----------end of single lines-----------')
       writeln('');
     
   count:= 0;
   suma:= 0;    
   for i:= 1 to 24 do 
     for k:= 1 to 24 do 
       for l:= 1 to 24 do 
         for m:= 1 to 24 do begin
           //writeln(inttostr(perm[i])+inttostr(perm[k])+inttostr(perm[l])+
             //inttostr(perm[m]))
            suma:=0;
            if (resu[i][1]+resu[k][1]+resu[l][1]+resu[m][1] = 15) and
               (resu[i][2]+resu[k][2]+resu[l][2]+resu[m][2] = 15) and
               (resu[i][3]+resu[k][3]+resu[l][3]+resu[m][3] = 15) and
               (resu[i][4]+resu[k][4]+resu[l][4]+resu[m][4] = 15) and
               //check also diagonals  
               (resu[i][1]+resu[k][2]+resu[l][3]+resu[m][4] = 15) and
               (resu[m][1]+resu[l][2]+resu[k][3]+resu[i][4] = 15) then begin
              //writeln(inttoStr(suma))
                 inc(count);
                 write(inttostr(count)) 
                 writeln(inttostr(resu[i][1])+inttostr(resu[i][2])+
                         inttostr(resu[i][3])+inttostr(resu[i][4]))        
                 writeln(inttostr(resu[k][1])+inttostr(resu[k][2])+
                         inttostr(resu[k][3])+inttostr(resu[k][4]))        
                 writeln(inttostr(resu[l][1])+inttostr(resu[l][2])+
                         inttostr(resu[l][3])+inttostr(resu[l][4]))        
                 writeln(inttostr(resu[m][1])+inttostr(resu[m][2])+
                        inttostr(resu[m][3])+inttostr(resu[m][4]))        

                 writeln('-----------') 
            end; 
         end;
    writeln('sudokus: '+inttostr(count))       
end;


procedure EscapefromForm(sender: TObject; var Key: Char);
begin  
  if key=#27 then cFrm.close;
end;

procedure LoadForm;
begin
  //ageinDays:= strtoint(readln('how old are you in days ?'));
  cFrm:= TForm.create(self);
  with cFrm do begin
    caption:= 'STAT BIORHYTHMUS() for ' + Now;
    BorderStyle:= bsDialog;
    height:= 440;
    width:= 660;
    onPaint:= @PaintBox1Paint;
    onKeyPress:= @EscapefromForm;
    show;
  end 
end;

// main calc & plot
begin
  //LoadForm;
  //CalculateGraph(bodyPts, emoPts, spiritPts);
  //DrawChart(bodyPts, emoPts, spiritPts);
  //Sudoku_permutation_1;
  Permutation_Variation_without_2;
  //Combination_without_3;
  //Variation_Zahlenschloss_4;
end.

just maXbox
         ____    ___   _      ____    _   _   _
        |  _ \  |  _| | |    |  _ \  | | | | | |
        | | . | | |_  | |    | |_| | | |_| | | |
        | | | | |  _| | |    |  __/  |  _  | | |          
        | |_. | | |_  | |__  | |     | | | | | |                      
        |____/  |___| |____| |_|     |_| |_| |_| 
                                     

