Update all new Tasks
This commit is contained in:
Ingy döt Net
parent
00a190b0a6
commit
91df62d461
5697 changed files with 93386 additions and 804 deletions
232
Task/Amicable-pairs/Pascal/amicable-pairs-1.pascal
Normal file
232
Task/Amicable-pairs/Pascal/amicable-pairs-1.pascal
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 char;
|
||||
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.
|
||||
210
Task/Amicable-pairs/Pascal/amicable-pairs-2.pascal
Normal file
210
Task/Amicable-pairs/Pascal/amicable-pairs-2.pascal
Normal file
|
|
@ -0,0 +1,210 @@
|
|||
program AmicablePairs;
|
||||
{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;
|
||||
const
|
||||
//MAX = 20000;
|
||||
{$IFDEF UNIX} MAX = 524*1000*1000;{$ELSE}MAX = 499*1000*1000;{$ENDIF}
|
||||
type
|
||||
tValue = LongWord;
|
||||
tpValue = ^tValue;
|
||||
tPower = array[0..31] of tValue;
|
||||
tIndex = record
|
||||
idxI,
|
||||
idxS : tValue;
|
||||
end;
|
||||
tdpa = array[0..2] of LongWord;
|
||||
var
|
||||
power : tPower;
|
||||
PowerFac : tPower;
|
||||
DivSumField : array[0..MAX] of tValue;
|
||||
Indices : array[0..511] of tIndex;
|
||||
DpaCnt : tdpa;
|
||||
|
||||
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
|
||||
fillchar(DpaCnt,SizeOf(dpaCnt),#0);
|
||||
n := 0;
|
||||
For i := 1 to MAX do
|
||||
begin
|
||||
//s = sum of proper divs (I) == sum of divs (I) - I
|
||||
s := DivSumField[i]-i;
|
||||
IF (s <=MAX) AND (s>i) then
|
||||
begin
|
||||
IF DivSumField[s]-s = i then
|
||||
begin
|
||||
With indices[n] do
|
||||
begin
|
||||
idxI := i;
|
||||
idxS := s;
|
||||
end;
|
||||
inc(n);
|
||||
end;
|
||||
end;
|
||||
inc(DpaCnt[Ord(s>=i)-Ord(s<=i)+1]);
|
||||
end;
|
||||
result := n;
|
||||
end;
|
||||
|
||||
Procedure CalcPotfactor(prim:tValue);
|
||||
//PowerFac[k] = (prim^(k+1)-1)/(prim-1) == Sum (i=1..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;inline;
|
||||
//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;
|
||||
|
||||
function Sieve(prim: tValue):tValue;
|
||||
//simple version
|
||||
var
|
||||
actNumber : tValue;
|
||||
begin
|
||||
while prim <= MAX do
|
||||
begin
|
||||
InitPW(prim);
|
||||
//actNumber = actual number = n*prim
|
||||
//power == n to base prim
|
||||
actNumber := prim;
|
||||
while actNumber < MAX do
|
||||
begin
|
||||
DivSumField[actNumber] := DivSumField[actNumber] *PowerFac[NextPotCnt(prim)];
|
||||
inc(actNumber,prim);
|
||||
end;
|
||||
//next prime
|
||||
repeat
|
||||
inc(prim);
|
||||
until (DivSumField[prim] = 1);
|
||||
end;
|
||||
result := prim;
|
||||
end;
|
||||
|
||||
var
|
||||
T2,T1,T0: TDatetime;
|
||||
APcnt: tValue;
|
||||
|
||||
begin
|
||||
T0:= time;
|
||||
Init;
|
||||
Sieve(2);
|
||||
T1:= time;
|
||||
APCnt := Check;
|
||||
T2:= time;
|
||||
AmPairOutput(APCnt);
|
||||
writeln(DpaCnt[0]:10,' deficient');
|
||||
writeln(DpaCnt[1]:10,' perfect');
|
||||
writeln(DpaCnt[2]:10,' abundant');
|
||||
writeln(DpaCnt[2]/DpaCnt[0]:14:10,' ratio abundant/deficient ');
|
||||
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));
|
||||
{$IFNDEF UNIX}
|
||||
readln;
|
||||
{$ENDIF}
|
||||
end.
|
||||
Loading…
Add table
Add a link
Reference in a new issue