ft.pas

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

{Copyright:      Hagen Reddmann  mailto:[e-mail]
 Author:         Hagen Reddmann
 Remarks:        public domain
 known Problems: none
 Version:        1.4, Delphi 5
 Description:    different Algortihms to compute the Factorial N! to arbitary value

 Comments:       Thanks to Peter Luchny, my employer :)
                 All below factorial functions are based on the JAVA Sources at
                 http://www.luschny.de/math/factorial/FastFactorialFunctions.htm

                 The math library use for multiplication and squaring the
                 School Method, COMBA, Karatsuba, Toom-Cook-3 and
                 Sch鰊hage/Strassen modular FFT
                   "Schnelle Multiplikation grosser Zahlen"
                   by Arnold Sch鰊hage and Volker Strassen, Computing 7, p. 281-292, 1971.
                 For the Division we use Knuth Normalized Method and Karatsuba Division
                   "Fast Recursive Division"
                   Christoph Burnikel & Joachim Ziegler
                   MPI-I-98-1-022        October 1998
                   Forschungsbericht     Research Report
                   Max Planck Institut f黵 Informatik
                 where a asymmetric splitting method is used without shifts, contrary to above paper.
                 The Square Root use a recursive karatsuba square root with remainder
                   INRIA, "Karatsuba Square Root" by Paul Zimmermann
                   Research Report No 3805, file: RR-3805.ps
                 where we asymmetric split.
                 All above methods works generaly asymmetric each for his own numberrange.

                 The library runs on Intel PC and Windows and is currently NOT portable :(
                 All sources use Delphi-Pascal and assmbler.

 * THIS SOFTWARE IS PROVIDED BY THE AUTHORS ''AS IS'' AND ANY EXPRESS
 * OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
 * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 * ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE
 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
 * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
 * OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
 * EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
}

unit FT;

interface

implementation

uses Math, Windows, SysUtils, IniFiles, ConsoleForm, NMath, NInts, NCombi, Prime;

type
  TFactorial = procedure(var A: IInteger; N: Cardinal; const M: IInteger = nil);

var
  R: IInteger;  // last computed result, as global var make's things easier

procedure DoDisplay;
// display last computed result as decimal String
var
  C: Char;
  S: String;
begin
  Write(#20);
  WriteLn( Ticks:10:0, ' ms, ', NDigitCount(R, NStrFormat.Base, False), ' Digits, CRC = ', IntToHEX(NCRC(R), 8));
  Write(#2, 'do You want to display the number (Y,N):', #0); ReadLn(C);
  Write(#11);
  if UpCase(C) = 'Y' then
  begin
    StartTimer;
    S := NStr(R);
    WriteLn( Ticks:10:0, ' ms for string conversion' );
    WriteLn( S );
  end;
end;

procedure DoShow;
// shows last computed result again, but now we can choose the Numberbase
var
  B: Byte;
  S: String;
begin
  Write(#20);
  Write(#2, 'please input Number Base (2-64):', #0); ReadLn(B);
  StartTimer;
  S := NStr(R, B);
  WriteLn( Ticks:10:0, ' ms for string conversion' );
  WriteLn( S );
end;

resourcestring
  sNToBig = 'N must be 0 <= N < 2^32';
  sKToBig = 'K must be 0 <= K < 2^32';

const
  MaxCardinal = $FFFFFFFF;

procedure DoFactorial(Factorial: TFactorial);
// Wrapper to call the different Factorial procedures
var
  N,Step: Double;
  Mul,I: Integer;
  S: String;
  D,T: Double;
begin
  Write(#20);
  Write(#2, 'Input N (12, 1e5, 2^8) :', #0); N := Abs(Trunc(ReadNumber));
  if N > MaxCardinal then NRaise(@sNtoBig);
  Write(#2, 'Repeat by  (+1000, *2) :', #0); ReadLn(S);
  Step := 0;
  S := Trim(S);
  if S <> '' then
  begin
    Mul := Pos('*', S);
    if Mul > 0 then Delete(S, 1, Mul);
    I := Pos('^', S);
    if I > 0 then Step := Power(StrToFloat(Copy(S, 1, I-1)), StrToFloat(Copy(S, I +1, MaxInt)))
      else Step := StrToFloat(S);
  end else
  begin
    Mul := 0;
    Write(#11#11);
  end;
  WriteLn(#3'compute ',N:10:0,'!'#0, ', press ESC to abort');
  D := 0;
  repeat
    StartTimer;
    Factorial(R, Round(N));
    T := Ticks;
    if Step <> 0 then
    begin
      Write(Round(N):10, '!', T:10:2, ' ms, ', NDigitCount(R):10, ' digits, ', IntToHEX(NCRC(R), 8):12);
      if D <> 0 then Write( T / D:10:2);
      WriteLn;
      D := T;
      if Mul > 0 then N := N * Step
        else N := N + Step;
    end else
    begin
      N := 0;
      DoDisplay;
    end;
  until (N < 1) or (N > MaxCardinal);
end;

// wrappers for the Console Menusystem
procedure Moessner;
begin
  DoFactorial(@NFactorial_Moessner);
end;

procedure Naive;
begin
  DoFactorial(@NFactorial_Naive);
end;

procedure Recursive;
begin
  DoFactorial(@NFactorial_Recursive);
end;

procedure DivideAndConquer;
begin
  DoFactorial(@NFactorial_DivideAndConquer);
end;

procedure FactBinomial;
begin
  DoFactorial(@NFactorial_Binomial);
end;

procedure FactJason_GMP;
begin
  DoFactorial(@NFactorial_Jason_GMP);
end;

procedure Schoenhage;
begin
  DoFactorial(@NFactorial);
end;

type
  TProcN  = procedure(var A: IInteger; N: Cardinal; const M: IInteger = nil);
  TProcNK = procedure(var A: IInteger; N,K: Cardinal; const M: IInteger = nil);

procedure DoN(Proc: TProcN; const Name: String);
var
  N,Step: Double;
  Mul: Integer;
  S: String;
  C,D: Char;
  M: IInteger;
begin
  Write(#20);
  C := #0;
  Write(#2, 'Input N  (12, 1e5, 2^8) :', #0); N := Abs(Trunc(ReadNumber));
  if N > Maxcardinal then NRaise(@sNtoBig);
  Write(#2, 'Repeat by   (+1000, *2) :', #0); ReadLn(S);
  Step := 0;
  S := Trim(S);
  if S <> '' then
  begin
    Mul := Pos('*', S);
    if Mul > 0 then Delete(S, 1, Mul);
    Step := StrToFloat(S);
    Write(#2, 'Display results   (Y/N) :', #0); ReadLn(C);
    if UpCase(C) = 'Y' then
    begin
      Write(#2, 'mod 1e10          (Y/N) :', #0); ReadLn(D);
      if UpCase(D) = 'Y' then NPow(M, 10, 10);
    end;
  end else
  begin
    Mul := 0;
    Write(#11#11);
  end;
  WriteLn(#3'compute ',Name,'(',Round(N),')'#0, ', press ESC to abort');
  repeat
    StartTimer;
    Proc(R, Round(N), M);
    Cycles;
    if Step <> 0 then
    begin
      WriteLn(Round(N):10, Ticks:10:2, ' ms, ', NDigitCount(R):10, ' digits, ', IntToHEX(NCRC(R), 8):12);
      if UpCase(C) = 'Y' then WriteLn(#1, NStr(R), #0);
      if Mul > 0 then N := N * Step
        else N := N + Step;
    end else
    begin
      N := 0;
      DoDisplay;
    end;
  until N < 1;
end;

procedure DoNK(Proc: TProcNK; const Name: String);
var
  N,K,Step: Double;
  Mul: Integer;
  S: String;
  C,D: Char;
  M: IInteger;
  IsPrimorial: Boolean;
begin
  Write(#20);
  C := #0;
  IsPrimorial := @Proc = @NPrimorial;
  if IsPrimorial then
  begin
    Write(#2, 'Input K (12, 1e5, 2^8) :', #0); N := Abs(Trunc(ReadNumber));
    if N > MaxCardinal then NRaise(@sNtoBIG);
    Write(#2, 'Input N                :', #0); K := Abs(Trunc(ReadNumber));
    if K > MaxCardinal then NRaise(@sKtoBIG);
  end else
  begin
    Write(#2, 'Input N (12, 1e5, 2^8) :', #0); N := Abs(Trunc(ReadNumber));
    if N > MaxCardinal then NRaise(@sNtoBIG);
    Write(#2, 'Input K                :', #0); K := Abs(Trunc(ReadNumber));
    if K > MaxCardinal then NRaise(@sKtoBIG);
  end;
  Write(#2, 'Repeat by  (+1000, *2) :', #0); ReadLn(S);
  Step := 0;
  S := Trim(S);
  if S <> '' then
  begin
    Mul := Pos('*', S);
    if Mul > 0 then Delete(S, 1, Mul);
    Step := StrToFloat(S);
    Write(#2, 'Display results  (Y/N) :', #0); ReadLn(C);
    if UpCase(C) = 'Y' then
    begin
      Write(#2, 'mod 1e10         (Y/N) :', #0); ReadLn(D);
      if UpCase(D) = 'Y' then NPow(M, 10, 10);
    end;
  end else
  begin
    Mul := 0;
    Write(#11#11#11);
  end;
  WriteLn(#3'compute ',Name,'(',Round(N),',',Round(K),')'#0, ', press ESC to abort');
  repeat
    StartTimer;
    Proc(R, Round(N), Round(K), M);
    Cycles;
    if Step <> 0 then
    begin
      WriteLn(Round(N):10, Round(K):10, Ticks:10:2, ' ms, ', NDigitCount(R):10, ' digits, ', IntToHEX(NCRC(R), 8):12);
      if UpCase(C) = 'Y' then WriteLn(#1, NStr(R), #0);
      if IsPrimorial then
        if Mul > 0 then N := N * Step
          else N := N + Step
      else
        if Mul > 0 then K := K * Step
          else K := K + Step;
    end else
    begin
      if IsPrimorial then K := 0 else N := 0;
      DoDisplay;
    end;
    if IsPrimorial then
      if (N < 1) or (N > K) then Break else
    else
      if (K < 1) or (K > N) then Break;
  until False;
end;

procedure OddFactorial;
begin
  DoN(@NOddFactorial, 'OddFactorial');
end;

procedure Factorial;
begin
  DoN(@NFactorial, 'Factorial');
end;

procedure Primorial;

  procedure DoPrimorial(var A: IInteger; N: Cardinal; const M: IInteger);
  begin
    NPrimorial(A, 1, N, M);
  end;

begin
  DoN(@DoPrimorial, 'Primorial');
end;

procedure Binomial;
begin
  DoNK(@NBinomial, 'Binomial');
end;

procedure Product;
begin
  DoNK(@NProduct, 'Product');
end;

procedure PrimeProduct;
begin
  DoNK(@NPrimorial, 'Primorial');
end;

procedure Permutation;
begin
  DoNK(@NPermutation, 'Permutation');
end;