mathslib.pas

Delphi的大数运算演示 pudn上大多是VC的 所以传个Delphi的

        break;
      end;
    end
    else
    begin
      if ((i = 0) and includezero and (Digits[i] = 0)) or ((i > 0) and (Digits[i] = 0))
      then
      begin
        Result := False;
        break;
      end;
    end;
  end;
end;


{************** GetNextPandigital}
function GetNextPandigital(size: integer; var Digits: array of integer): boolean;
  {Generates 9 or 10 digit permutations of digits in decreasing sequence,
   Input parameter "size" is the number of digits to generate (2 to 10).
   Output placed in open array "digits",  so index value of k refers
   to (k+1)th entry.
   Result is true until all values have been returned.
   Initialize "digits" array with 9,8,7,6,5,4,3,2,1,0 (10 digit pandigitals) or
   9,8,7,6,5,4,3,2,1 (9 digit "almost" pandigitals) before first call.
  }
  procedure swap(i: integer; j: integer);
  {swap digits[i] and digits[j]}
  var
    temp: integer;
  begin
    temp      := Digits[i];
    Digits[i] := Digits[j];
    Digits[j] := temp;
  end;

var
  k, j, r, s: integer;
begin
  k := size - 2; {start at next-to-last}
  {find the last decreasing-order pair}
  while (k >= 0) and (Digits[k] > Digits[k + 1]) do
    Dec(k);
  if k < 0 then
    Result := False {if none in decreasing order, we're done}
  else
  begin
    j := size - 1; {find the rightmost digit less than digits[k]}
    while Digits[k] > Digits[j] do
      j := j - 1;
    swap(j, k); {and swap them}
    r := size - 1;
    s := k + 1;  {from there to the end, swap end digits toward the center}
    while r > s do
    begin
      swap(r, s);
      r := r - 1;
      s := s + 1;
    end;
    Result := True;  {magic!}
  end;
end;


{************** GetPrevPandigital}
function GetPrevPandigital(size: integer; var Digits: array of integer): boolean;
  {Generates 9 or 10 digit permutations of digits in decreasing sequence,
   Input parameter "size" is the number of digits to generate (2 to 10).
   Output placed in open array "digits",  so index value of k refers
   to (k+1)th entry.
   Result is true until all values have been returned.
   Initialize "digits" array with 9,8,7,6,5,4,3,2,1,0 (10 digit pandigitals) or
   9,8,7,6,5,4,3,2,1 (9 digit "almost" pandigitals) before first call.
  }
  procedure swap(i: integer; j: integer);
  {swap digits[i] and digits[j]}
  var
    temp: integer;
  begin
    temp      := Digits[i];
    Digits[i] := Digits[j];
    Digits[j] := temp;
  end;

var
  k, j, r, s: integer;
begin
  k := size - 2; {start at next-to-last}
  {find the last decreasing-order pair}
  while (k >= 0) and (Digits[k] < Digits[k + 1]) do
    Dec(k);
  if k < 0 then
    Result := False {if none in decreasing order, we're done}
  else
  begin
    j := size - 1; {find the rightmost digit less than digits[k]}
    while Digits[k] < Digits[j] do
      j := j - 1;
    swap(j, k); {and swap them}
    r := size - 1;
    s := k + 1;  {from there to the end, swap end digits toward the center}
    while r > s do
    begin
      swap(r, s);
      r := r - 1;
      s := s + 1;
    end;
    Result := True;  {magic!}
  end;
end;


{*********** IsPalindrome *************}
function isPalindrome(n: int64): boolean;
var
  s: string;
  i: integer;
begin
  s      := IntToStr(n);
  Result := True;
  for i := 1 to length(s) div 2 do
  begin
    if not (s[i] = s[length(s) + 1 - i]) then
    begin
      Result := False;
      break;
    end;
  end;
end;


{**************** NextPermute *************}
function nextpermute(var a: array of byte): boolean;
   {
   SEPA: A Simple, Efficient Permutation Algorithm
   Jeffrey A. Johnson, Brigham Young University-Hawaii Campus
   http://www.cs.byuh.edu/~johnsonj/permute/soda_submit.html
  }
  {My new favorite - short, fast,  understandable  and requires no data
  structures or intialization, each output is generated as the
  next permutation after the permutation passed!}

var
  i, j, key, temp, rightmost: integer;
begin
    {1. Find Key, the leftmost byte of rightmost in-sequence pair
        If none found, we are done}

  {  Characters to the right of key are the "tail"}
    {  Example 1432 -
       Step 1:  check pair 3,2 - not in sequence
               check pair 4,3 - not in sequence
               check pair 1,4 - in sequence ==> key is a[0]=1, tail is 432

    }
  rightmost := high(a);
  i := rightmost - 1; {Start at right end -1}
  while (i >= 0) and (a[i] >= a[i + 1]) do
    Dec(i); {Find in-sequence pair}
  if i >= 0 then  {Found it, so there is another permutation}
  begin
    Result := True;
    key    := a[i];

    {2A. Find rightmost in tail that is > key}
    j := rightmost;
    while (j > i) and (a[j] < a[i]) do
      Dec(j);
    {2B. and swap them} a[i] := a[j];
    a[j] := key;
      {Example - 1432  1=key 432=tail
       Step 2:  check 1 vs 2,  2 > 1 so swap them producing 2431}

    {3. Sort tail characters in ascending order}
      {   By definition, the tail is in descending order now,
          so we can do a swap sort by exchanging first with last,
          second with next-to-last, etc.}
      {Example - 2431  431=tail
        Step 3:
                 compare 4 vs 1 - 4 is greater so swap producing 2134
                 tail sort is done.

                final array = 2134
     }
    Inc(i);
    j := rightmost; {point i to tail start, j to tail end}
    while j > i do
    begin
      if a[i] > a[j] then
      begin {swap}
        temp := a[i];
        a[i] := a[j];
        a[j] := temp;
      end;
      Inc(i);
      Dec(j);
    end;
  end
  else
    Result := False; {else please don't call me any more!}
end;


function GeneratePentagon(n: integer): integer;
begin
  Result := n * (3 * n - 1) div 2;
end;

(*
function IsPolygonal(T:int64):intset;
{from http://mathworld.wolfram.com/PolygonalNumber.html}
var
  test:byte;
  n:int64;
  s2,s:int64;
begin
 result:=[];
  test:=3;
  while test<=8 do
  begin
    s2:=8*(test-2)*T+(test-4)*(test-4);
    s:=trunc(sqrt(0.0+s2));
    if  s*s=s2 then
    begin {s2 is a perfect square do the number is Test-ogonal};
      result:=result+[test];
    end;
    inc(test);
  end;
end;
*)
function getpolygonal(p, r: int64): int64;
begin
  case p of
    3: Result := (r * (r + 1) div 2);
    4: Result := (r * r);
    5: Result := (r * (3 * r - 1) div 2);
    6: Result := (r * (2 * r - 1));
    7: Result := (r * (5 * r - 3) div 2);
    8: Result := (r * (3 * r - 2));
    else
      Result := 0;
  end;
end;

function IsPolygonal(T: int64; var rank: array of integer): boolean;
  {from http://mathworld.wolfram.com/PolygonalNumber.html}
var
  test:  byte;
  r:     int64;
  s2, s: int64;
begin
  Result := False;
  test   := 3;
  while test <= 8 do
  begin
    s2 := 8 * (test - 2) * T + (test - 4) * (test - 4);
    s  := trunc(sqrt(0.0 + s2));
    if s * s = s2 then  {it could be a polygonal}
    begin
      {s2 is a perfect square do the number could be Test-ogonal};
      r := (s + test - 4) div (2 * (test - 2));
      if getpolygonal(test, r) <> T then
        r := 0;
      Result := True;
    end
    else
      r := 0;
    rank[test] := r;
    Inc(test);
  end;
end;

function MakePolyName(t: integer): string;
  {make polygonal figure name from numbe}
begin
  Result := '';
  case t of
    3: Result := ' triangular';
    4: Result := ' square    ';
    5: Result := ' pentagonal';
    6: Result := ' hexagonal ';
    7: Result := ' heptagonal';
    8: Result := ' octagonal ';
    else
      Result := 'Unknown';
  end;
end;


function IsPentagon(p: integer): boolean;
var
  n: integer;
begin
  n      := Round(sqrt(2 * p / 3));
  Result := p = n * (3 * n - 1) div 2;
end;

(*
Triangle   P3,n=n(n+1)/2   1, 3, 6, 10, 15, ...
Square   P4,n=n2   1, 4, 9, 16, 25, ...
Pentagonal   P5,n=n(3n