Data commit
This commit is contained in:
Ingy döt Net
parent
7387c8f97b
commit
cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
89
Task/Amicable-pairs/Pascal/amicable-pairs-1.pas
Normal file
89
Task/Amicable-pairs/Pascal/amicable-pairs-1.pas
Normal file
|
|
@ -0,0 +1,89 @@
|
|||
Program SumOfFactors; uses crt; {Perpetrated by R.N.McLean, December MCMXCV}
|
||||
//{$DEFINE ShowOverflow}
|
||||
{$IFDEF FPC}
|
||||
{$MODE DELPHI}//tested with lots = 524*1000*1000 takes 75 secs generating KnownSum
|
||||
{$ENDIF}
|
||||
var outf: text;
|
||||
const Limit = 2147483647;
|
||||
const lots = 20000; {This should be much bigger, but problems apply.}
|
||||
var KnownSum: array[1..lots] of longint;
|
||||
Function SumF(N: Longint): Longint;
|
||||
var f,f2,s,ulp: longint;
|
||||
Begin
|
||||
if n <= lots then SumF:=KnownSum[N] {Hurrah!}
|
||||
else
|
||||
begin {This is really crude...}
|
||||
s:=1; {1 is always a factor, but N is not.}
|
||||
f:=2;
|
||||
f2:=f*f;
|
||||
while f2 < N do
|
||||
begin
|
||||
if N mod f = 0 then
|
||||
begin {We have a divisor, and its friend.}
|
||||
ulp:=f + (N div f);
|
||||
if s > Limit - ulp then begin SumF:=-666; exit; end;
|
||||
s:=s + ulp;
|
||||
end;
|
||||
f:=f + 1;
|
||||
f2:=f*f;
|
||||
end;
|
||||
if f2 = N then {A perfect square gets its factor in once only.}
|
||||
if s <= Limit - f then s:=s + f
|
||||
else begin SumF:=-667; exit; end;
|
||||
SumF:=s;
|
||||
end;
|
||||
End;
|
||||
var i,j,l,sf,fs: LongInt;
|
||||
const enuff = 666; {Only so much sociability.}
|
||||
var trail: array[0..enuff] of longint;
|
||||
BEGIN
|
||||
ClrScr;
|
||||
WriteLn('Chasing Chains of Sums of Factors of Numbers.');
|
||||
for i:=1 to lots do KnownSum[i]:=1; {Sigh. KnownSum:=1;}
|
||||
|
||||
{start summing every divisor }
|
||||
for i:=2 to lots do
|
||||
begin
|
||||
j:=i + i;
|
||||
While j <= lots do {Sigh. For j:=i + i:Lots:i do KnownSum[j]:=KnownSum[j] + i;}
|
||||
begin
|
||||
KnownSum[j]:=KnownSum[j] + i;
|
||||
j:=j + i;
|
||||
end;
|
||||
end;
|
||||
|
||||
{Enough preparation.}
|
||||
Assign(outf,'Factors.txt'); ReWrite(Outf);
|
||||
WriteLn(Outf,'Chasing Chains of Sums of Factors of Numbers.');
|
||||
|
||||
for i:=2 to lots do {Search.}
|
||||
begin
|
||||
l:=0;
|
||||
sf:=SumF(i);
|
||||
while (sf > i) and (l < enuff) do
|
||||
begin
|
||||
l:=l + 1;
|
||||
trail[l]:=sf;
|
||||
sf:=SumF(sf);
|
||||
end;
|
||||
if l >= enuff then writeln('Rope ran out! ',i);
|
||||
{$IFDEF ShowOverflow}
|
||||
if sf < 0 then writeln('Overflow with ',i);
|
||||
{$ENDIF}
|
||||
if i = sf then {A loop?}
|
||||
begin {Yes. Reveal its members.}
|
||||
trail[0]:=i; {The first.}
|
||||
if l = 0 then write('Perfect!! ')
|
||||
else if l = 1 then write('Amicable! ')
|
||||
else write('Sociable: ');
|
||||
for j:=0 to l do Write(Trail[j],',');
|
||||
WriteLn;
|
||||
if l = 0 then write(outf,'Perfect!! ')
|
||||
else if l = 1 then write(outf,'Amicable! ')
|
||||
else write(outf,'Sociable: ');
|
||||
for j:=0 to l do write(outf,Trail[j],',');
|
||||
WriteLn(outf);
|
||||
end;
|
||||
end;
|
||||
Close (outf);
|
||||
END.
|
||||
232
Task/Amicable-pairs/Pascal/amicable-pairs-2.pas
Normal file
232
Task/Amicable-pairs/Pascal/amicable-pairs-2.pas
Normal file
|
|
@ -0,0 +1,232 @@
|
|||
program AmicablePairs;
|
||||
{$IFDEF FPC}
|
||||
{$MODE DELPHI}
|
||||
{$H+}
|
||||
{$ELSE}
|
||||
{$APPTYPE CONSOLE}
|
||||
{$ENDIF}
|
||||
uses
|
||||
sysutils;
|
||||
const
|
||||
MAX = 20000;
|
||||
//MAX = 20*1000*1000;
|
||||
type
|
||||
tValue = LongWord;
|
||||
tpValue = ^tValue;
|
||||
tPower = array[0..31] of tValue;
|
||||
tIndex = record
|
||||
idxI,
|
||||
idxS : Uint64;
|
||||
end;
|
||||
|
||||
var
|
||||
Indices : array[0..511] of tIndex;
|
||||
//primes up to 65536 enough until 2^32
|
||||
primes : array[0..6542] of tValue;
|
||||
|
||||
procedure InitPrimes;
|
||||
// sieve of erathosthenes without multiples of 2
|
||||
type
|
||||
tSieve = array[0..(65536-1) div 2] of ansichar;
|
||||
var
|
||||
ESieve : ^tSieve;
|
||||
idx,i,j,p : LongINt;
|
||||
Begin
|
||||
new(ESieve);
|
||||
fillchar(ESieve^[0],SizeOF(tSieve),#1);
|
||||
primes[0] := 2;
|
||||
idx := 1;
|
||||
|
||||
//sieving
|
||||
j := 1;
|
||||
p := 2*j+1;
|
||||
repeat
|
||||
if Esieve^[j] = #1 then
|
||||
begin
|
||||
i := (2*j+2)*j;// i := (sqr(p) -1) div 2;
|
||||
if i > High(tSieve) then
|
||||
BREAK;
|
||||
repeat
|
||||
ESIeve^[i] := #0;
|
||||
inc(i,p);
|
||||
until i > High(tSieve);
|
||||
end;
|
||||
inc(j);
|
||||
inc(p,2);
|
||||
until j >High(tSieve);
|
||||
|
||||
//collecting
|
||||
For i := 1 to High(tSieve) do
|
||||
IF Esieve^[i] = #1 then
|
||||
Begin
|
||||
primes[idx] := 2*i+1;
|
||||
inc(idx);
|
||||
IF idx>High(primes) then
|
||||
BREAK;
|
||||
end;
|
||||
dispose(Esieve);
|
||||
end;
|
||||
|
||||
procedure Su_append(n,factor:tValue;var su:string);
|
||||
var
|
||||
q,p : tValue;
|
||||
begin
|
||||
p := 0;
|
||||
repeat
|
||||
q := n div factor;
|
||||
IF q*factor<>n then
|
||||
Break;
|
||||
inc(p);
|
||||
n := q;
|
||||
until false;
|
||||
IF p > 0 then
|
||||
IF p= 1 then
|
||||
su:= su+IntToStr(factor)+'*'
|
||||
else
|
||||
su:= su+IntToStr(factor)+'^'+IntToStr(p)+'*';
|
||||
end;
|
||||
|
||||
procedure ProperDivs(n: Uint64);
|
||||
//output of prime factorization
|
||||
var
|
||||
su : string;
|
||||
primNo : tValue;
|
||||
p:tValue;
|
||||
|
||||
begin
|
||||
str(n:8,su);
|
||||
su:= su +' [';
|
||||
primNo := 0;
|
||||
p := primes[0];
|
||||
repeat
|
||||
Su_Append(n,p,su);
|
||||
inc(primNo);
|
||||
p := primes[primNo];
|
||||
until (p=0) OR (p*p >= n);
|
||||
p := n;
|
||||
Su_Append(n,p,su);
|
||||
su[length(su)] := ']';
|
||||
writeln(su);
|
||||
end;
|
||||
|
||||
procedure AmPairOutput(cnt:tValue);
|
||||
var
|
||||
i : tValue;
|
||||
r_max,r_min,r : double;
|
||||
begin
|
||||
r_max := 1.0;
|
||||
r_min := 16.0;
|
||||
For i := 0 to cnt-1 do
|
||||
with Indices[i] do
|
||||
begin
|
||||
r := IdxS/IDxI;
|
||||
writeln(i+1:4,IdxI:16,IDxS:16,' ratio ',r:10:7);
|
||||
IF r < 1 then
|
||||
begin
|
||||
writeln(i);
|
||||
readln;
|
||||
halt;
|
||||
end;
|
||||
if r_max < r then
|
||||
r_max := r
|
||||
else
|
||||
if r_min > r then
|
||||
r_min := r;
|
||||
IF cnt < 20 then
|
||||
begin
|
||||
ProperDivs(IdxI);
|
||||
ProperDivs(IdxS);
|
||||
end;
|
||||
end;
|
||||
writeln(' min ratio ',r_min:12:10); writeln(' max ratio ',r_max:12:10);
|
||||
end;
|
||||
|
||||
procedure SumOFProperDiv(n: tValue;var SumOfProperDivs:tValue);
|
||||
// calculated by prime factorization
|
||||
var
|
||||
i,q, primNo, Prime,pot : tValue;
|
||||
SumOfDivs: tValue;
|
||||
begin
|
||||
i := N;
|
||||
SumOfDivs := 1;
|
||||
primNo := 0;
|
||||
Prime := Primes[0];
|
||||
q := i DIV Prime;
|
||||
repeat
|
||||
if q*Prime = i then
|
||||
Begin
|
||||
pot := 1;
|
||||
repeat
|
||||
i := q;
|
||||
q := i div Prime;
|
||||
Pot := Pot * Prime+1;
|
||||
until q*Prime <> i;
|
||||
SumOfDivs := SumOfDivs * pot;
|
||||
end;
|
||||
Inc(primNo);
|
||||
Prime := Primes[primNo];
|
||||
q := i DIV Prime;
|
||||
|
||||
{check if i already prime}
|
||||
if Prime > q then
|
||||
begin
|
||||
prime := i;
|
||||
q := 1;
|
||||
end;
|
||||
until i = 1;
|
||||
SumOfProperDivs := SumOfDivs - N;
|
||||
end;
|
||||
|
||||
function Check:tValue;
|
||||
const
|
||||
//going backwards
|
||||
DIV23 : array[0..5] of byte =
|
||||
//== 5,4,3,2,1,0
|
||||
(1,0,0,0,1,0);
|
||||
|
||||
var
|
||||
i,s,k,n : tValue;
|
||||
idx : nativeInt;
|
||||
begin
|
||||
n := 0;
|
||||
idx := 3;
|
||||
For i := 2 to MAX do
|
||||
begin
|
||||
//must be divisble by 2 or 3 ( n < High(tValue) < 1e14 )
|
||||
IF DIV23[idx] = 0 then
|
||||
begin
|
||||
SumOFProperDiv(i,s);
|
||||
//only 24.7...%
|
||||
IF s>i then
|
||||
Begin
|
||||
SumOFProperDiv(s,k);
|
||||
IF k = i then
|
||||
begin
|
||||
With indices[n] do
|
||||
begin
|
||||
idxI := i;
|
||||
idxS := s;
|
||||
end;
|
||||
inc(n);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
dec(idx);
|
||||
IF idx < 0 then
|
||||
idx := high(DIV23);
|
||||
end;
|
||||
result := n;
|
||||
end;
|
||||
|
||||
var
|
||||
T2,T1: TDatetime;
|
||||
APcnt: tValue;
|
||||
begin
|
||||
InitPrimes;
|
||||
T1:= time;
|
||||
APCnt:= Check;
|
||||
T2:= time;
|
||||
AmPairOutput(APCnt);
|
||||
writeln('Time to find amicable pairs ',FormatDateTime('HH:NN:SS.ZZZ' ,T2-T1));
|
||||
{$IFNDEF UNIX} readln;{$ENDIF}
|
||||
end.
|
||||
241
Task/Amicable-pairs/Pascal/amicable-pairs-3.pas
Normal file
241
Task/Amicable-pairs/Pascal/amicable-pairs-3.pas
Normal file
|
|
@ -0,0 +1,241 @@
|
|||
program AmicPair;
|
||||
{find amicable pairs in a limited region 2..MAX
|
||||
beware that >both< numbers must be smaller than MAX
|
||||
there are 455 amicable pairs up to 524*1000*1000
|
||||
correct up to
|
||||
#437 460122410
|
||||
}
|
||||
//optimized for freepascal 2.6.4 32-Bit
|
||||
{$IFDEF FPC}
|
||||
{$MODE DELPHI}
|
||||
{$OPTIMIZATION ON,peephole,cse,asmcse,regvar}
|
||||
{$CODEALIGN loop=1,proc=8}
|
||||
{$ELSE}
|
||||
{$APPTYPE CONSOLE}
|
||||
{$ENDIF}
|
||||
|
||||
uses
|
||||
sysutils;
|
||||
|
||||
type
|
||||
tValue = LongWord;
|
||||
tpValue = ^tValue;
|
||||
tDivSum = array[0..0] of tValue;// evil, but dynamic arrays are slower
|
||||
tpDivSum = ^tDivSum;
|
||||
tPower = array[0..31] of tValue;
|
||||
tIndex = record
|
||||
idxI,
|
||||
idxS : tValue;
|
||||
end;
|
||||
var
|
||||
power,
|
||||
PowerFac : tPower;
|
||||
ds : array of tValue;
|
||||
Indices : array[0..511] of tIndex;
|
||||
DivSumField : tpDivSum;
|
||||
MAX : tValue;
|
||||
|
||||
procedure Init;
|
||||
var
|
||||
i : LongInt;
|
||||
begin
|
||||
DivSumField[0]:= 0;
|
||||
For i := 1 to MAX do
|
||||
DivSumField[i]:= 1;
|
||||
end;
|
||||
|
||||
procedure ProperDivs(n: tValue);
|
||||
//Only for output, normally a factorication would do
|
||||
var
|
||||
su,so : string;
|
||||
i,q : tValue;
|
||||
begin
|
||||
su:= '1';
|
||||
so:= '';
|
||||
i := 2;
|
||||
while i*i <= n do
|
||||
begin
|
||||
q := n div i;
|
||||
IF q*i -n = 0 then
|
||||
begin
|
||||
su:= su+','+IntToStr(i);
|
||||
IF q <> i then
|
||||
so:= ','+IntToStr(q)+so;
|
||||
end;
|
||||
inc(i);
|
||||
end;
|
||||
writeln(' [',su+so,']');
|
||||
end;
|
||||
|
||||
procedure AmPairOutput(cnt:tValue);
|
||||
var
|
||||
i : tValue;
|
||||
r : double;
|
||||
begin
|
||||
r := 1.0;
|
||||
For i := 0 to cnt-1 do
|
||||
with Indices[i] do
|
||||
begin
|
||||
writeln(i+1:4,IdxI:12,IDxS:12,' ratio ',IdxS/IDxI:10:7);
|
||||
if r < IdxS/IDxI then
|
||||
r := IdxS/IDxI;
|
||||
IF cnt < 20 then
|
||||
begin
|
||||
ProperDivs(IdxI);
|
||||
ProperDivs(IdxS);
|
||||
end;
|
||||
end;
|
||||
writeln(' max ratio ',r:10:4);
|
||||
end;
|
||||
|
||||
function Check:tValue;
|
||||
var
|
||||
i,s,n : tValue;
|
||||
begin
|
||||
n := 0;
|
||||
For i := 1 to MAX do
|
||||
begin
|
||||
//s = sum of proper divs (I) == sum of divs (I) - I
|
||||
s := DivSumField^[i];
|
||||
IF (s <=MAX) AND (s>i) AND (DivSumField^[s]= i)then
|
||||
begin
|
||||
With indices[n] do
|
||||
begin
|
||||
idxI := i;
|
||||
idxS := s;
|
||||
end;
|
||||
inc(n);
|
||||
end;
|
||||
end;
|
||||
result := n;
|
||||
end;
|
||||
|
||||
Procedure CalcPotfactor(prim:tValue);
|
||||
//PowerFac[k] = (prim^(k+1)-1)/(prim-1) == Sum (i=0..k) prim^i
|
||||
var
|
||||
k: tValue;
|
||||
Pot, //== prim^k
|
||||
PFac : Int64;
|
||||
begin
|
||||
Pot := prim;
|
||||
PFac := 1;
|
||||
For k := 0 to High(PowerFac) do
|
||||
begin
|
||||
PFac := PFac+Pot;
|
||||
IF (POT > MAX) then
|
||||
BREAK;
|
||||
PowerFac[k] := PFac;
|
||||
Pot := Pot*prim;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure InitPW(prim:tValue);
|
||||
begin
|
||||
fillchar(power,SizeOf(power),#0);
|
||||
CalcPotfactor(prim);
|
||||
end;
|
||||
|
||||
function NextPotCnt(p: tValue):tValue;
|
||||
//return the first power <> 0
|
||||
//power == n to base prim
|
||||
var
|
||||
i : tValue;
|
||||
begin
|
||||
result := 0;
|
||||
repeat
|
||||
i := power[result];
|
||||
Inc(i);
|
||||
IF i < p then
|
||||
BREAK
|
||||
else
|
||||
begin
|
||||
i := 0;
|
||||
power[result] := 0;
|
||||
inc(result);
|
||||
end;
|
||||
until false;
|
||||
power[result] := i;
|
||||
end;
|
||||
|
||||
procedure Sieve(prim: tValue);
|
||||
var
|
||||
actNumber,idx : tValue;
|
||||
begin
|
||||
//sieve with "small" primes
|
||||
while prim*prim <= MAX do
|
||||
begin
|
||||
InitPW(prim);
|
||||
Begin
|
||||
//actNumber = actual number = n*prim
|
||||
actNumber := prim;
|
||||
idx := prim;
|
||||
while actNumber <= MAX do
|
||||
begin
|
||||
dec(idx);
|
||||
IF idx > 0 then
|
||||
DivSumField^[actNumber] *= PowerFac[0]
|
||||
else
|
||||
Begin
|
||||
DivSumField^[actNumber] *= PowerFac[NextPotCnt(prim)+1];
|
||||
idx := Prim;
|
||||
end;
|
||||
inc(actNumber,prim);
|
||||
end;
|
||||
end;
|
||||
//next prime
|
||||
repeat
|
||||
inc(prim);
|
||||
until DivSumField^[prim]= 1;//(DivSumField[prim] = 1);
|
||||
end;
|
||||
|
||||
//sieve with "big" primes, only one factor is possible
|
||||
while 2*prim <= MAX do
|
||||
begin
|
||||
InitPW(prim);
|
||||
Begin
|
||||
actNumber := prim;
|
||||
idx := PowerFac[0];
|
||||
while actNumber <= MAX do
|
||||
begin
|
||||
DivSumField^[actNumber] *= idx;
|
||||
inc(actNumber,prim);
|
||||
end;
|
||||
end;
|
||||
repeat
|
||||
inc(prim);
|
||||
until DivSumField^[prim]= 1;
|
||||
end;
|
||||
|
||||
For idx := 2 to MAX do
|
||||
dec(DivSumField^[idx],idx);
|
||||
end;
|
||||
|
||||
var
|
||||
T2,T1,T0: TDatetime;
|
||||
APcnt: tValue;
|
||||
i: NativeInt;
|
||||
begin
|
||||
MAX := 20000;
|
||||
IF ParamCount > 0 then
|
||||
MAX := StrToInt(ParamStr(1));
|
||||
setlength(ds,MAX);
|
||||
DivSumField := @ds[0];
|
||||
T0:= time;
|
||||
For i := 1 to 1 do
|
||||
Begin
|
||||
Init;
|
||||
Sieve(2);
|
||||
end;
|
||||
T1:= time;
|
||||
|
||||
APCnt := Check;
|
||||
T2:= time;
|
||||
AmPairOutput(APCnt);
|
||||
writeln(APCnt,' amicable pairs til ',MAX);
|
||||
writeln('Time to calc sum of divs ',FormatDateTime('HH:NN:SS.ZZZ' ,T1-T0));
|
||||
writeln('Time to find amicable pairs ',FormatDateTime('HH:NN:SS.ZZZ' ,T2-T1));
|
||||
setlength(ds,0);
|
||||
{$IFNDEF UNIX}
|
||||
readln;
|
||||
{$ENDIF}
|
||||
end.
|
||||
Loading…
Add table
Add a link
Reference in a new issue