ft.pas

cipher 5.1。一个几乎包含了所有常见的加密算法的控件

procedure Comporial;
begin
  DoN(@NComporial, 'Comporial');
end;

procedure HalfFactorial;
begin
  DoN(@NHalfFactorial, 'HalfFactorial');
end;

procedure HalfComporial;
begin
  DoN(@NHalfComporial, 'HalfComporial');
end;

procedure HalfPrimorial;
begin
  DoN(@NHalfPrimorial, 'HalfPrimorial');
end;

procedure HalfBinomial;
begin
  DoN(@NHalfBinomial, 'HalfBinomial');
end;

procedure SelfTest;
begin
  WriteLn(#20'Selftest of Factorial procedures runs, please wait...');
  NTestCombi;
  WriteLn(#4'all ok :)'#0);
end;

procedure SpeedTest;
var
  A,B: IInteger;
  T1,T2,S1,S2: Double;
  N,I: Cardinal;
  C1,C2: Char;
begin
  Write(#22);
  WriteLn(#4'Karatsuba'#0', '#2'Toom-3'#0', '#3'Sch鰊hage Strassen FFT'#0);
  WriteLn('Bit Size':10, 'Sqr (ms)':10, 'Mul (ms)':10, 'Ratio':8, 'Sqr/Digit':14, 'Mul/Digit':14);
  S1 := 0;
  S2 := 0;
  N := 32;
  repeat
    I := N div 32;
    C1 := #0;
    if I >= NBreakEven(5) then C1 := #4;
    if I >= NBreakEven(6) then C1 := #2;
    if I >= NBreakEven(7) then C1 := #3;
    C2 := #0;
    if I >= NBreakEven(1) then C2 := #4;
    if I >= NBreakEven(2) then C2 := #2;
    if I >= NBreakEven(3) then C2 := #3;
    NRnd(A, N);
    StartTimer;
    NSqr(A);
    T1 := Ticks;
    NRnd(A, N);
    NRnd(B, N);
    StartTimer;
    NMul(A, B);
    Cycles;
    T2 := Ticks;
    WriteLn(#22, N:10, C1, T1:10:4,#0, C2, T2:10:4,#0, T1/T2:8:2, T1 / N * 32:14:6, T2 / N * 32:14:6);
    S1 := S1 + T1;
    S2 := S2 + T2;
    WriteLn( #29, S1 / S2:14:6);
    Inc(N, N);
  until N > 1024 * 1024 * 128;
end;

procedure About;
begin
  WriteLn(#22);
  WriteLn(  '------------------------------------------------');
  WriteLn(#3'Different algorithms to compute the factorial N!');
  WriteLn(  '    and similar functions to arbitary value.'#0);
  WriteLn(  '------------------------------------------------');
  WriteLn;
  WriteLn(  'Copyright : '#2'Hagen Reddmann'#0);
  WriteLn(  'Author    : '#2'Hagen Reddmann, mailto:[e-mail]'#0);
  WriteLn;
  WriteLn(  'Remarks   : public domain');
  WriteLn(  'Version   : 1.6, Delphi 5');
  WriteLn(  'Released  : 9.3.2002');
  WriteLn;
  with TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini')) do
  try
    WriteLn(  'URL       : ', ReadString('Options', 'URL', 'unknown'));
  finally
    Free;
  end;
end;

function NPrd(var A: IInteger; const T: array of Integer; const M: IInteger = nil): Boolean;
var
  I,J,K,L,N: Integer;
  BreakEven: Integer;
  P: IInteger;
  S: array[0..32] of IInteger; // 32 + 1 IInteger for max. range
begin
  BreakEven := NBreakEven(1) * 2;
  J := 0;
  K := 0;
  N := 0;
  NSet(P, 1);
  for I := Low(T) to High(T) do
    if T[I] > 0 then
    begin
      NMul(P, T[I]);
      if M <> nil then NMod(P, M);
      if NSize(P, piLong) >= BreakEven then
      begin
        if M <> nil then NMod(P, M);
        NSwp(P, S[J]);
        Inc(J);
        Inc(K);
        L := K;
        while L and 1 = 0 do
        begin
          Dec(J);
          NMul(S[J -1], S[J]);
          if M <> nil then NMod(S[J -1], M);
          L := L shr 1;
        end;
        NSet(P, 1);
      end;
      Inc(N);
    end;
  if M <> nil then NMod(P, M);
  NSwp(S[J], P);
  while J > 0 do
  begin
    NMul(S[J -1], S[J]);
    if M <> nil then NMod(S[J -1], M);
    Dec(J);
  end;
  NSwp(S[0], A);
  Result := N > 0;
end;


procedure NLuschny_Factorial(var A: IInteger; N: Cardinal);

  function omegaSwingHighBound(N: Integer): Integer;
  begin
    if n < 4 then Result := 6
      else Result := Floor(Sqrt(N) + N / (Log2(n) -1));
  end;

var
  listLength: array of Integer;
  listPrime: array of array of Integer;
  tower: array of Integer;
  bound: array of Integer;

  procedure PrimeFactors(N: Integer);
  var
    maxBound, lastList, start, list, prime, i, np, k, q: Integer;
    sieve: TSmallPrimeSieve;
  begin
    maxBound := N div 3;
    lastList := Length(listPrime) -1;
    if tower[1] = 2 then start := 1 else start := 0;
    sieve := Primes;
    NAutoRelease(sieve);
    i := 2;
    prime := sieve[i];
    for list := start to Length(listPrime) -1 do
    begin
      while Prime <= tower[list +1] do
      begin
        listPrime[list, listLength[list]] := prime;
        inc(listLength[list]);
        if prime <= maxBound then
        begin
          np := n;
          repeat
            k := lastList;
            np := np div prime;
            q := np;
            repeat
              if Odd(q) then
              begin
                listPrime[k, listLength[k]] := prime;
                inc(listlength[k]);
              end;
              Dec(k);
              q := q shr 1;
            until (q = 0) or (prime > bound[k]);
          until prime > np;
        end;
        inc(I);
        prime := sieve[I];
      end;
    end;
  end;

  procedure iterQuad;
  var
    init,i,listLen: Integer;
    B: IInteger;
  begin
    if listLength[0] = 0 then init := 1 else init := 3;
    NSet(A, init);
    listLen := Length(listPrime);
    for i := 1 to listLen -1 do
    begin
      NSqr(A);
      SetLength(listPrime[i], listlength[i]);
      NPrd(B, listPrime[I]);
      NMul(A, B);
    end;
  end;

var
  lgN,j,hN: Integer;
begin
  if N < 20 then
  begin
    NFactorial(A, N);
    Exit;
  end;

  lgN := NLog2(N);
  j := lgN;
  hN := N;

  SetLength(listPrime, lgN);
  SetLength(listLength, lgN);
  SetLength(bound, lgN);
  SetLength(tower, lgN +1);

  while True do
  begin
    tower[j] := hn;
    if hN = 1 then Break;
    Dec(j);
    bound[j] := hN div 3;
    SetLength(listPrime[j], omegaSwingHighBound(hN));
    hN := hN shr 1;
  end;
  tower[0] := 2;
  primeFactors(N);
  iterQuad;
  NShl(A, N - Cardinal(NBitWeight(N)));
end;

procedure Luschny;
begin
  DoFactorial(@NLuschny_Factorial);
end;

procedure ShortestPath;
var
  N,E: Cardinal;
  T: TPowerTable;
  I,L,J,P: Integer;
  S,K,V: String;
begin
  Write(#2'Input N!'#0); N := Trunc(ReadNumber);
  N := NPowerTable(T, N);
  E := 0;
  for I := 0 to High(T) do
    if (T[I].B > 0) and (T[I].E > E) then
      E := T[I].E;
  if E > 0 then
  begin
    S := '';
    E := 1 shl NLog2(E);
    while E <> 0 do
    begin
      if S <> '' then S := #3'('#0 + S + #3')'#0'^2 * '#10;
      K := StringOfChar('*', 1024 *8);
      P := 1;
      L := Length(K);
      for I := 0 to High(T) do
        if T[I].E and E <> 0 then
        begin
          V := IntToStr(T[I].B);
          J := Length(V);
          if P + J > L then
          begin
            K := K + StringOfChar('*', 1024 *8);
            L := Length(K);
          end;
          Move(V[1], K[P], J);
          Inc(P, J +1);
          NCalcCheck;
        end;
      SetLength(K, P -2);
      S := S + #1 + K + #0;
      E := E shr 1;
    end;
    S := S + ' * 2^' + IntToStr(N);
  end else
    S := '2^' + IntToStr(N);
  WriteLn(S);
end;

resourcestring
  sFactorial = 'Factorial\';
  sOthers    = 'Others(n)\';
  sOthersKN  = 'Others(k,n)\';
  sOthersH   = 'Others([n/2])\';
  sSpecial   = 'Special\';
initialization
  SysUtils.DecimalSeparator := '.';

  RegisterProc(sFactorial + 'Moessner', '', Moessner);
  RegisterProc(sFactorial + 'Naive', '', Naive);
  RegisterProc(sFactorial + 'Recursive Product', '', Recursive);
  RegisterProc(sFactorial + 'Divide and Conquer', '', DivideAndConquer);
  RegisterProc(sFactorial + 'Jason GMP', '', FactJason_GMP);
  RegisterProc(sFactorial + 'Binomial', '', FactBinomial);
  RegisterProc(sFactorial + 'Sch鰊hage', '', Schoenhage);
  RegisterProc(sFactorial + 'Luschny', '', Luschny);
  RegisterProc(sFactorial + 'N1');
  RegisterProc(sFactorial + 'Display last result', '', DoShow);
  RegisterProc(sFactorial + 'Display shortest Primepower path for N!', '', ShortestPath);

  RegisterProc(sOthers + 'OddFactorial, n! / 2^i', '', OddFactorial);
  RegisterProc(sOthers + 'Factorial, n!', '', Factorial);
  RegisterProc(sOthers + 'Comporial, n! / Pr(2,n)', '', Comporial);
  RegisterProc(sOthers + 'Primorial, Pr(2,N)', '', Primorial);

  RegisterProc(sOthersKN + 'Product, n! / k!', '', Product);
  RegisterProc(sOthersKN + 'Primorial, Pr(k, n)', '', PrimeProduct);
  RegisterProc(sOthersKN + 'Binomial, n! / (k!(n-k)!)', '', Binomial);
  RegisterProc(sOthersKN + 'Permutation,  n! / (n-k)!', '', Permutation);

  RegisterProc(sOthersH + 'Half Factorial, n! / [n/2]!', '', HalfFactorial);
  RegisterProc(sOthersH + 'Half Comporial, n! / ([n/2]! Pr([n/2]+1,n))', '', HalfComporial);
  RegisterProc(sOthersH + 'Half Primorial, Pr(n) / Pr([n/2]+1)', '', HalfPrimorial);
  RegisterProc(sOthersH + 'Half Binomial,  n! / ([n/2]! (n-[n/2])!)', '', HalfBinomial);

  RegisterProc(sSpecial + 'About', '', About);
  RegisterProc(sSpecial + 'Combinatoric Selftest', '', SelfTest);
  RegisterProc(sSpecial + 'Speedcomparsion Sqr and Mul', '', SpeedTest);

//  Primes.LoadCache('d:\prime.cache');
end.