const
BigNumLen = 5000; {12041}
type
BigNum = array[1..BigNumLen] of byte;
{ bnDigitsCount }
function bnDigitsCount(var bn: BigNum): integer;
var i: integer;
begin
for i:=BigNumLen downto 1 do
begin
if (bn[i]=0) then continue
else
begin
bnDigitsCount := i;
break;
end;
end;
end;
{ bnWrite }
procedure bnWrite(var bn: BigNum);
var i: integer;
sz: boolean;
begin
sz := true;
for i:=BigNumLen downto 1 do
begin
if sz and (bn[i]=0) then continue
else sz:=false;
Write(bn[i], ' shl ', 8*(i-1), ' ' );
end;
if sz then Write('0');
end;
procedure bnWriteLn(var bn: BigNum);
begin
bnWrite(bn); Writeln;
end;
{ bnZero }
procedure bnZero(var bn:BigNum);
begin
FillChar(bn, BigNumLen, 0);
end;
{ bnAssign }
procedure bnAssign(var bn:BigNum; value: byte);
begin
bnZero(bn);
bn[1] := value;
end;
procedure bnAssignBn(var bn, value: BigNum);
begin
Move(value, bn, BigNumLen);
end;
{ bnSum }
function bnSum(var bn1,bn2,bn: Bignum; se: boolean): byte;
var i: integer;
rem: word;
begin
if @bn<>@bn1 then bnZero(bn);
rem:=0;
for i:= 1 to BigNumLen do
begin
rem := rem + bn1[i] + bn2[i];
bn[i] := rem and $00FF; {shl 8 shr 8; {mod 256;}
rem := rem shr 8; {div 256;}
end;
if se then if rem<>0 then Writeln('bnSum Error too big result for BigNum[',BigNumLen,']');
bnSum := rem;
end;
{ bnSub }
function bnSub(var bn1,bn2, bn: Bignum; se: boolean): byte;
var i: integer;
rem: word;
begin
if @bn<>@bn1 then bnZero(bn);
rem:=0;
for i:= 1 to BigNumLen do
begin
rem := $0100 + rem + bn1[i] - bn2[i];
bn[i] := rem and $00FF; {mod 10;}
rem := rem shr 8 - 1;
end;
if se then if rem<>0 then Writeln('bnSub Error bn1<bn2');
bnSub := rem;
end;
{ bnMult }
function bnMult(var bn1, bn2, bn: Bignum; se: boolean): byte;
var i,j,bn1c,bn2c: integer;
rem: word;
begin
if @bn=@bn1 then
begin
Write('bnMult b1 = bn');
bnMult := 255;
halt;
end;
bnZero(bn);
bn1c := bnDigitsCount(bn1);
bn2c := bnDigitsCount(bn2);
if se then if (bn1c+bn2c>BigNumLen) then WriteLn('bnMult Could be Error bn1*bn2>BigNum');
for i:= 1 to bn2c do
begin
rem:=0;
for j:= 1 to bn1c+1 do
begin
if j>BigNumLen then
begin
if se then WriteLn('bnMult Error Occured bn1*bn2>BigNum');
rem := 255;
break;
end;
rem := rem + bn[j+i-1] + bn2[i]*bn1[j];
bn[j+i-1] := rem and $00FF; {mod 10;}
rem := rem shr 8; {div 10;}
end;
end;
bnMult := rem;
end;
{ bnCompare }
function bnCompare(var bn1, bn2: BigNum): integer;
var i: integer;
begin
bnCompare := 0;
for i:= BigNumLen downto 1 do
begin
if bn1[i]=bn2[i] then continue;
if bn1[i]>bn2[i] then bnCompare:=1
else bnCompare:=-1;
break;
end;
end;
{ bnMod }
{ function bnMod(var bn1, bn2, bn: BigNum): byte;
var
bn1dc, bn2dc, cnt: integer;
begin
end; }
var
Mp, Li, Li2: BigNum;
bv,bm: BigNum;
lidc, mpdc, i,p: integer;
cnt,cnt2,c2, c, cc: longint;
begin
Write('Calc');
bnAssign(Mp, 2);
{bnWriteLn(Mp);}
p:=7; { 2, 3, 5, 7, 13, 17, 19, 31, 61, 89,}
{ 107, 127, 521, 607, 1279, 2203, 2281,}
{ 3217, 4253, 4423, 9689, 9941, 11213, 19937 }
for i := 2 to p do { Mp:= 2^p }
begin
bnSum(Mp, Mp, Mp, true); { Mp := Mp+Mp; }
{bnWriteln(Mp);}
end;
bnAssign(bv, 1);
bnSub(Mp, bv, Mp, true); { Mp := Mp-1; }
{bnWriteln(Mp); WriteLn;}
mpdc := bnDigitsCount(Mp);
bnAssign(Li, 4); { Li := 4; }
c := 0;
bnZero(bm);
for i:=2 to p-1 do { L(i+1) := (Li^2-2) mod Mp }
begin
bnAssign(bv, 2);
bnMult(Li, Li, Li2, true); { Li := Li^2 }
bnSub(Li2, bv, Li, true); { Li := Li^2 - 2 }
lidc := bnDigitsCount(Li);
cnt2 := lidc - mpdc +1;
while cnt2>0 do
begin
{Writeln('lidc = ', lidc, ' cnt2 = ', cnt2, ' c = ', c, ' cc = ', cc);}
bm[cnt2] := 1; { bm := 256^cnt2 }
if bnMult(bm, Mp, bv, false)=0 then
begin
repeat
until bnSub(Li, bv, Li, false)<>0;
bnSum(Li, bv, Li, false);
end;
bm[cnt2] := 0; { bm := 0 }
cnt2 := cnt2 - 1;
end; { Li := Li^2 - 2 mod Mp }
Writeln('L{',i,'} of ',p-1, ' sub count = ',c);
end;
Writeln('count of subs = ', c);
Write('L(p-1) = '); BnWriteLn(Li); Writeln;
bnZero(bv);
if bnCompare(Li, bv) = 0 then
begin
Writeln('2 ^ ',p , ' - 1 is Prime number, so');
Writeln('2 ^ ',p-1 , ' * (2 ^ ', p ,' - 1) is Perfect number');
end else
begin
Writeln('2 ^ ',p , ' - 1 is not Prime number, so');
Writeln('2 ^ ',p-1 , ' * (2 ^ ', p ,' - 1) is not Perfect number');
end;
readln;
end.
|
