Ruth-Aaron numbers: Difference between revisions
Add Mathematica/Wolfram Language implementation
(Added FreeBasic) |
(Add Mathematica/Wolfram Language implementation) |
||
| (6 intermediate revisions by 5 users not shown) | |||
Line 285:
First Ruth-Aaron triple (divisors): 89460294
</pre>
=={{header|Delphi}}==
{{works with|Delphi|6.0}}
{{libheader|SysUtils,StdCtrls}}
<syntaxhighlight lang="Delphi">
{These routines would normally be in a library, but are shown here for clarity}
function IsPrime(N: int64): boolean;
{Fast, optimised prime test}
var I,Stop: int64;
begin
if (N = 2) or (N=3) then Result:=true
else if (n <= 1) or ((n mod 2) = 0) or ((n mod 3) = 0) then Result:= false
else
begin
I:=5;
Stop:=Trunc(sqrt(N+0.0));
Result:=False;
while I<=Stop do
begin
if ((N mod I) = 0) or ((N mod (I + 2)) = 0) then exit;
Inc(I,6);
end;
Result:=True;
end;
end;
procedure StoreNumber(N: integer; var IA: TIntegerDynArray);
{Expand and store number in array}
begin
SetLength(IA,Length(IA)+1);
IA[High(IA)]:=N;
end;
procedure GetPrimeFactors(N: integer; var Facts: TIntegerDynArray);
{Get all the prime factors of a number}
var I: integer;
begin
I:=2;
SetLength(Facts,0);
repeat
begin
if (N mod I) = 0 then
begin
StoreNumber(I,Facts);
N:=N div I;
end
else I:=GetNextPrime(I);
end
until N=1;
end;
procedure GetPrimeDivisors(N: integer; var Facts: TIntegerDynArray);
{Get all unique prime factors of a number}
var I: integer;
begin
I:=2;
SetLength(Facts,0);
repeat
begin
if (N mod I) = 0 then
begin
StoreNumber(I,Facts);
N:=N div I;
while (N mod I) = 0 do N:=N div I;
end
else I:=GetNextPrime(I);
end
until N=1;
end;
{------------------------------------------------------------}
procedure RuthAaronNumbers(Memo: TMemo; UseFactors: boolean);
var N,Sum1,Sum2,Cnt: integer;
var S: string;
function GetFactorSum(N: integer): integer;
{Get the sum of the prime factors or divisors}
var IA: TIntegerDynArray;
var I: integer;
begin
if UseFactors then GetPrimeFactors(N,IA)
else GetPrimeDivisors(N,IA);
Result:=0;
for I:=0 to High(IA) do Result:=Result+IA[I];
end;
begin
Cnt:=0;
S:='';
{Get first sum}
Sum1:=GetFactorSum(1);
for N:=1 to High(integer) do
begin
{Get next sum}
Sum2:=GetFactorSum(N+1);
{Look for matching sums = Ruth-Aaron numbers}
if Sum1=Sum2 then
begin
Inc(Cnt);
S:=S+Format('%6D',[N]);
if Cnt>=30 then break;
If (Cnt mod 10)=0 then S:=S+CRLF;
end;
Sum1:=Sum2;
end;
Memo.Lines.Add(S);
Memo.Lines.Add('Count = '+IntToStr(Cnt));
end;
procedure ShowRuthAaronNumbers(Memo: TMemo);
begin
Memo.Lines.Add('The first 30 Ruth-Aaron numbers using factors');
RuthAaronNumbers(Memo, True);
Memo.Lines.Add('The first 30 Ruth-Aaron numbers using divisors');
RuthAaronNumbers(Memo, False);
end;
</syntaxhighlight>
{{out}}
<pre>
The first 30 Ruth-Aaron numbers using factors
5 8 15 77 125 714 948 1330 1520 1862
2491 3248 4185 4191 5405 5560 5959 6867 8280 8463
10647 12351 14587 16932 17080 18490 20450 24895 26642 26649
Count = 30
The first 30 Ruth-Aaron numbers using divisors
5 24 49 77 104 153 369 492 714 1682
2107 2299 2600 2783 5405 6556 6811 8855 9800 12726
13775 18655 21183 24024 24432 24880 25839 26642 35456 40081
Count = 30
Elapsed Time: 5.991 Sec.
</pre>
Line 614 ⟶ 759:
=={{header|Java}}==
<syntaxhighlight lang="java">
import java.util.ArrayList;
import java.util.BitSet;
Line 797 ⟶ 941:
Ruth Aaron factor triple starts at: 417162
</pre>
=={{header|Mathematica}}/{{header|Wolfram Language}}==
{{trans|Julia}}
<syntaxhighlight lang="Mathematica">
SumPrimeDivisors[n_] := Total[First /@ FactorInteger[n]]
RuthAaron[n_] := SumPrimeDivisors[n] == SumPrimeDivisors[n + 1]
SumPrimeFactors[n_] :=
Total[First[#] * Last[#] & /@ FactorInteger[n]]
RuthAaronFactors[n_] :=
SumPrimeFactors[n] == SumPrimeFactors[n + 1]
RuthAaronSeq := Select[Range[100000], RuthAaron]
RuthAaronFactorSeq := Select[Range[100000], RuthAaronFactors]
Print["30 Ruth Aaron numbers:"]
Print[Take[RuthAaronSeq, 30]]
Print["\n30 Ruth Aaron factor numbers:"]
Print[Take[RuthAaronFactorSeq, 30]]
</syntaxhighlight>
{{out}}
<pre>
30 Ruth Aaron numbers:
{5, 24, 49, 77, 104, 153, 369, 492, 714, 1682, 2107, 2299, 2600, 2783, 5405, 6556, 6811, 8855, 9800, 12726, 13775, 18655, 21183, 24024, 24432, 24880, 25839, 26642, 35456, 40081}
30 Ruth Aaron factor numbers:
{5, 8, 15, 77, 125, 714, 948, 1330, 1520, 1862, 2491, 3248, 4185, 4191, 5405, 5560, 5959, 6867, 8280, 8463, 10647, 12351, 14587, 16932, 17080, 18490, 20450, 24895, 26642, 26649}
</pre>
=={{header|Nim}}==
{{trans|C++}}
<syntaxhighlight lang="Nim">import std/strformat
template isEven(n: Natural): bool = (n and 1) == 0
func primeFactorSum(n: int): int =
var n = n
while n.isEven:
inc result, 2
n = n shr 1
var p = 3
var sq = 9
while sq <= n:
while n mod p == 0:
inc result, p
n = n div p
inc sq, (p + 1) shl 2
inc p, 2
if n > 1:
inc result, n
func primeDivisorSum(n: int): int =
var n = n
if n.isEven:
inc result, 2
n = n shr 1
while n.isEven:
n = n shr 1
var p = 3
var sq = 9
while sq <= n:
if n mod p == 0:
inc result, p
n = n div p
while n mod p == 0:
n = n div p
inc sq, (p + 1) shl 2
inc p, 2
if n > 1:
inc result, n
const Limit = 30
proc firstRuthAaronByFactors() =
echo &"First {Limit} Ruth-Aaron numbers (factors):"
var fsum1, fsum2 = 0
var n = 2
var count = 0
while count < Limit:
fsum2 = primeFactorSum(n)
if fsum1 == fsum2:
inc count
stdout.write &"{n - 1:5}", if count mod 10 == 0: '\n' else: ' '
fsum1 = fsum2
inc n
proc firstRuthAaronByDivisors() =
echo &"\nFirst {Limit} Ruth-Aaron numbers (divisors):"
var dsum1, dsum2 = 0
var n = 2
var count = 0
while count < Limit:
dsum2 = primeDivisorSum(n)
if dsum1 == dsum2:
inc count
stdout.write &"{n - 1:5}", if count mod 10 == 0: '\n' else: ' '
dsum1 = dsum2
inc n
proc firstRuthAaronTripleByFactors() =
var fsum1, fsum2 = 0
var n = 2
while true:
let fsum3 = primeFactorSum(n)
if fsum1 == fsum3 and fsum2 == fsum3:
echo &"\nFirst Ruth-Aaron triple (factors): {n - 2}"
break
fsum1 = fsum2
fsum2 = fsum3
inc n
proc firstRuthAaronTripleByDivisors() =
var dsum1, dsum2 = 0
var n = 2
while true:
let dsum3 = primeDivisorSum(n)
if dsum1 == dsum3 and dsum2 == dsum3:
echo &"\nFirst Ruth-Aaron triple (divisors): {n - 2}"
break
dsum1 = dsum2
dsum2 = dsum3
inc n
firstRuthAaronByFactors()
firstRuthAaronByDivisors()
firstRuthAaronTripleByFactors()
firstRuthAaronTripleByDivisors()
</syntaxhighlight>
{{out}}
<pre>First 30 Ruth-Aaron numbers (factors):
5 8 15 77 125 714 948 1330 1520 1862
2491 3248 4185 4191 5405 5560 5959 6867 8280 8463
10647 12351 14587 16932 17080 18490 20450 24895 26642 26649
First 30 Ruth-Aaron numbers (divisors):
5 24 49 77 104 153 369 492 714 1682
2107 2299 2600 2783 5405 6556 6811 8855 9800 12726
13775 18655 21183 24024 24432 24880 25839 26642 35456 40081
First Ruth-Aaron triple (factors): 417162
First Ruth-Aaron triple (divisors): 89460294
</pre>
Line 802 ⟶ 1,092:
==={{header|Free Pascal}}===
all depends on fast prime decomposition.
<syntaxhighlight lang="pascal">
program RuthAaronNumb;
// gets factors of consecutive integers fast
// limited to 1.2e11
Line 1,197 ⟶ 1,488:
until false
end;
var
T1,T0 : Int64;
Begin
T0 := GetTickCount64;
InitSmallPrimes;
Get_RA_Prime(30,false);
Get_RA_Prime(30,true);
writeln
writeln;
writeln('First Ruth-Aaron triple (factors) :');
T0 := GetTickCount64;
writeln(findfirstTripplesFactor(true):10,' in ',GettickCount64-T0,' ms');
writeln;
writeln('First Ruth-Aaron triple (divisors):');
T0 := GetTickCount64;
writeln(findfirstTripplesFactor(false):10,' in ',GettickCount64-T0,' ms');
end.</syntaxhighlight>
{{out|@TIO.RUN}}
<pre>
First 30 Ruth-Aaron numbers (divisors ):
5 24 49 77 104 153 369 492
Line 1,222 ⟶ 1,519:
5959 6867 8280 8463 10647 12351 14587 16932
17080 18490 20450 24895 26642 26649
used time: 8 ms
First Ruth-Aaron triple (factors) :
417162 in 28 ms
First Ruth-Aaron triple (divisors):
89460294 in 6817 ms
Real time: 7.011 s CPU share: 99.03 %</pre>
=={{header|Perl}}==
Line 1,434 ⟶ 1,733:
However, with nearly 90 million trios of numbers to slog through, it takes around 68 minutes to find the first triple based on divisors.
<syntaxhighlight lang="
import "./seq" for Lst
import "./fmt" for Fmt
| |||