Rosetta Code

Untouchable numbers: Difference between revisions

Page Discussion

Untouchable numbers (view source)

Revision as of 18:03, 26 March 2024

19,993 bytes added ,  1 month ago
Added FreeBASIC
(→‎{{header|ALGOL 68}}: Use ALGOL 68-primes)
(Added FreeBASIC)
 
(13 intermediate revisions by 4 users not shown)
Line 72:
Note that under Windows (and possibly under Linux), Algol 68G requires that the heap size be increased in order to allow arrays big enough to handle 100 000 and 1 000 000 untouchable numbers. See [[ALGOL_68_Genie#Using_a_Large_Heap]].
{{libheader|ALGOL 68-primes}}
<langsyntaxhighlight lang="algol68">BEGIN # find some untouchable numbers - numbers not equal to the sum of the #
# proper divisors of any +ve integer #
INT max untouchable = 1 000 000;
Line 157:
# show the counts of untouchable numbers #
show untouchable statistics
END</langsyntaxhighlight>
{{out}}
<pre>
Line 181:
13863 to 100000
150232 to 1000000
</pre>
 
=={{header|C}}==
Run time around 14 seconds on my Core i7 machine.
<syntaxhighlight lang="c">#include <stdio.h>
#include <stdlib.h>
#include <stdbool.h>
#include <locale.h>
 
bool *primeSieve(int limit) {
int i, p;
limit++;
// True denotes composite, false denotes prime.
bool *c = calloc(limit, sizeof(bool)); // all false by default
c[0] = true;
c[1] = true;
for (i = 4; i < limit; i += 2) c[i] = true;
p = 3; // Start from 3.
while (true) {
int p2 = p * p;
if (p2 >= limit) break;
for (i = p2; i < limit; i += 2 * p) c[i] = true;
while (true) {
p += 2;
if (!c[p]) break;
}
}
return c;
}
 
int main() {
const int limit = 1000000;
int i, j, n, uc = 2, p = 10, m = 63, ul = 151000;
bool *c = primeSieve(limit);
n = m * limit + 1;
int *sumDivs = (int *)calloc(n, sizeof(int));
for (i = 1; i < n; ++i) {
for (j = i; j < n; j += i) sumDivs[j] += i;
}
bool *s = (bool *)calloc(n, sizeof(bool)); // all false
for (i = 1; i < n; ++i) {
int sum = sumDivs[i] - i; // proper divs sum
if (sum <= n) s[sum] = true;
}
free(sumDivs);
int *untouchable = (int *)malloc(ul * sizeof(int));
untouchable[0] = 2;
untouchable[1] = 5;
for (n = 6; n <= limit; n += 2) {
if (!s[n] && c[n-1] && c[n-3]) untouchable[uc++] = n;
}
setlocale(LC_NUMERIC, "");
printf("List of untouchable numbers <= 2,000:\n");
for (i = 0; i < uc; ++i) {
j = untouchable[i];
if (j > 2000) break;
printf("%'6d ", j);
if (!((i+1) % 10)) printf("\n");
}
printf("\n\n%'7d untouchable numbers were found <= 2,000\n", i);
for (i = 0; i < uc; ++i) {
j = untouchable[i];
if (j > p) {
printf("%'7d untouchable numbers were found <= %'9d\n", i, p);
p *= 10;
if (p == limit) break;
}
}
printf("%'7d untouchable numbers were found <= %'d\n", uc, limit);
free(c);
free(s);
free(untouchable);
return 0;
}</syntaxhighlight>
 
{{out}}
<pre>
List of untouchable numbers <= 2,000:
2 5 52 88 96 120 124 146 162 188
206 210 216 238 246 248 262 268 276 288
290 292 304 306 322 324 326 336 342 372
406 408 426 430 448 472 474 498 516 518
520 530 540 552 556 562 576 584 612 624
626 628 658 668 670 708 714 718 726 732
738 748 750 756 766 768 782 784 792 802
804 818 836 848 852 872 892 894 896 898
902 926 934 936 964 966 976 982 996 1,002
1,028 1,044 1,046 1,060 1,068 1,074 1,078 1,080 1,102 1,116
1,128 1,134 1,146 1,148 1,150 1,160 1,162 1,168 1,180 1,186
1,192 1,200 1,212 1,222 1,236 1,246 1,248 1,254 1,256 1,258
1,266 1,272 1,288 1,296 1,312 1,314 1,316 1,318 1,326 1,332
1,342 1,346 1,348 1,360 1,380 1,388 1,398 1,404 1,406 1,418
1,420 1,422 1,438 1,476 1,506 1,508 1,510 1,522 1,528 1,538
1,542 1,566 1,578 1,588 1,596 1,632 1,642 1,650 1,680 1,682
1,692 1,716 1,718 1,728 1,732 1,746 1,758 1,766 1,774 1,776
1,806 1,816 1,820 1,822 1,830 1,838 1,840 1,842 1,844 1,852
1,860 1,866 1,884 1,888 1,894 1,896 1,920 1,922 1,944 1,956
1,958 1,960 1,962 1,972 1,986 1,992
 
196 untouchable numbers were found <= 2,000
2 untouchable numbers were found <= 10
5 untouchable numbers were found <= 100
89 untouchable numbers were found <= 1,000
1,212 untouchable numbers were found <= 10,000
13,863 untouchable numbers were found <= 100,000
150,232 untouchable numbers were found <= 1,000,000
</pre>
 
Line 186 ⟶ 292:
This solution implements [[Talk:Untouchable_numbers#Nice_recursive_solution]]
===The Function===
<langsyntaxhighlight lang="cpp">
// Untouchable Numbers : Nigel Galloway - March 4th., 2021;
#include <functional>
Line 212 ⟶ 318:
}
};
</syntaxhighlight>
</lang>
===The Task===
;Less than 2000
<langsyntaxhighlight lang="cpp">
int main(int argc, char *argv[]) {
int c{0}; auto n{uT{2000}}; for(auto g=n.nxt(0); g; g=n.nxt(*g+1)){if(c++==30){c=1; printf("\n");} printf("%4d ",*g);} printf("\n");
}
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 231 ⟶ 337:
</pre>
;Count less than or equal 100000
<langsyntaxhighlight lang="cpp">
int main(int argc, char *argv[]) {
int z{100000}; auto n{uT{z}}; cout<<"untouchables below "<<z<<"->"<<n.count()<<endl;
}
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 242 ⟶ 348:
</pre>
;Count less than or equal 1000000
<langsyntaxhighlight lang="cpp">
int main(int argc, char *argv[]) {
int z{1000000}; auto n{uT{z}}; cout<<"untouchables below "<<z<<"->"<<n.count()<<endl;
}
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 253 ⟶ 359:
</pre>
;Count less than or equal 2000000
<langsyntaxhighlight lang="cpp">
int main(int argc, char *argv[]) {
int z{2000000}; auto n{uT{z}}; cout<<"untouchables below "<<z<<"->"<<n.count()<<endl;
}
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 270 ⟶ 376:
{{libheader| System.SysUtils}}
{{Trans|Go}}
<syntaxhighlight lang="delphi">
<lang Delphi>
program Untouchable_numbers;
 
Line 393 ⟶ 499:
writeln(cu:7, ' untouchable numbers were found <= ', cl);
readln;
end.</langsyntaxhighlight>
 
=={{header|FreeBASIC}}==
<syntaxhighlight lang="vbnet">Const max_untouchable = 1e6
 
Dim Shared untouchable(1 To max_untouchable) As Uinteger
For i As Uinteger = 1 To Ubound(untouchable)
untouchable(i) = True
Next i
 
Sub show_untouchable_statistics()
Dim As Uinteger i, cnt = 0
For i = 1 To Ubound(untouchable)
If untouchable(i) Then cnt += 1
If i = 10 Orelse i = 100 Orelse i = 1000 Orelse i = 10000 Orelse i = 1e5 Then
Print Using "###,### untouchable numbers were found <= #,###,###"; cnt; i
End If
Next i
End Sub
 
Sub print_untouchables(n As Uinteger)
Print Using "List of untouchable numbers <= #,###:"; n
Dim As Uinteger i, cnt = 0
For i = 1 To n
If untouchable(i) Then
Print Using "##,###"; i;
cnt += 1
Print Iif(cnt Mod 16 = 0, !"\n", " ");
End If
Next i
Print: Print
Print Using "###,### untouchable numbers were found <= #,###,###"; cnt; n
End Sub
 
Dim As Uinteger i, j
untouchable(1) = False
untouchable(3) = False
For i = 7 To Ubound(untouchable) Step 2
untouchable(i) = False
Next i
 
Dim Shared spd(1 To max_untouchable * 64) As Uinteger
Dim As Uinteger ub = Ubound(spd)
For i = 1 To ub
spd(i) = 1
Next i
For i = 2 To ub
For j = i + i To ub Step i
spd(j) += i
Next j
Next i
For i = 1 To ub
If spd(i) <= Ubound(untouchable) Then untouchable(spd(i)) = False
Next i
 
' Show the untouchable numbers up to 2000
print_untouchables(2000)
' Show the counts of untouchable numbers
show_untouchable_statistics()
 
Sleep</syntaxhighlight>
 
=={{header|F_Sharp|F#}}==
Line 399 ⟶ 565:
This task uses [[Extensible_prime_generator#The_functions|Extensible Prime Generator (F#)]].<br>
It implements [[Talk:Untouchable_numbers#Nice_recursive_solution]]
<langsyntaxhighlight lang="fsharp">
// Applied dendrology. Nigel Galloway: February 15., 2021
let uT a=let N,G=Array.create(a+1) true, [|yield! primes64()|>Seq.takeWhile((>)(int64 a))|]
Line 409 ⟶ 575:
|_->N.[0]<-false; N
fL (fG 1L 0L 0) [fN 1L 0L 1]
</syntaxhighlight>
</lang>
===The Task===
;Less than 2000
<langsyntaxhighlight lang="fsharp">
uT 2000|>Array.mapi(fun n g->(n,g))|>Array.filter(fun(_,n)->n)|>Array.chunkBySize 30|>Array.iter(fun n->n|>Array.iter(fst>>printf "%5d");printfn "")
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 426 ⟶ 592:
</pre>
;Count less than or equal 100000
<langsyntaxhighlight lang="fsharp">
printfn "%d" (uT 100000|>Array.filter id|>Array.length)
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 435 ⟶ 601:
</pre>
;Count less than or equal 1000000
<langsyntaxhighlight lang="fsharp">
printfn "%d" (uT 1000000|>Array.filter id|>Array.length)
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 444 ⟶ 610:
</pre>
;Count less than or equal 2000000
<langsyntaxhighlight lang="fsharp">
printfn "%d" (uT 2000000|>Array.filter id|>Array.length)
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 453 ⟶ 619:
</pre>
;Count less than or equal 3000000
<langsyntaxhighlight lang="fsharp">
<lang fsharp>
printfn "%d" (uT 3000000|>Array.filter id|>Array.length)
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 464 ⟶ 629:
 
=={{header|Go}}==
===Version1 ===
This was originally based on the Wren example but has been modified somewhat to find untouchable numbers up to 1 million rather than 100,000 in a reasonable time. On my machine, the former (with a sieve factor of 63) took 31 minutes 9 seconds and the latter (with a sieve factor of 14) took 6.2 seconds.
This was originally based on the Wren Version 1 example but has been modified somewhat to find untouchable numbers up to 1 million rather than 100,000 in a reasonable time. On my machine, the former (with a sieve factor of 63) took 31 minutes 9 seconds and the latter (with a sieve factor of 14) took 6.2 seconds.
<lang go>package main
<syntaxhighlight lang="go">package main
 
import "fmt"
Line 577 ⟶ 743:
cl := commatize(limit)
fmt.Printf("%7s untouchable numbers were found <= %s\n", cu, cl)
}</langsyntaxhighlight>
 
{{out}}
Line 610 ⟶ 776:
13,863 untouchable numbers were found <= 100,000
150,232 untouchable numbers were found <= 1,000,000
</pre>
 
===Version 2===
{{trans|C}}
{{libheader|Go-rcu}}
This version uses a much more efficient algorithm for calculating the sums of divisors in bulk.
 
Run time for finding untouchable numbers up to 1 million is now only 11 seconds which (surprisingly) is faster than C itself on the same machine.
 
Also, since the first version was written, some of the functions used have now been incorporated into the above library.
<syntaxhighlight lang="go">package main
 
import (
"fmt"
"rcu"
)
 
func main() {
limit := 1000000
m := 63
c := rcu.PrimeSieve(limit, false)
n := m*limit + 1
sumDivs := make([]int, n)
for i := 1; i < n; i++ {
for j := i; j < n; j += i {
sumDivs[j] += i
}
}
s := make([]bool, n) // all false
for i := 1; i < n; i++ {
sum := sumDivs[i] - i // proper divs sum
if sum <= n {
s[sum] = true
}
}
untouchable := []int{2, 5}
for n := 6; n <= limit; n += 2 {
if !s[n] && c[n-1] && c[n-3] {
untouchable = append(untouchable, n)
}
}
fmt.Println("List of untouchable numbers <= 2,000:")
count := 0
for i := 0; untouchable[i] <= 2000; i++ {
fmt.Printf("%6s", rcu.Commatize(untouchable[i]))
if (i+1)%10 == 0 {
fmt.Println()
}
count++
}
fmt.Printf("\n\n%7s untouchable numbers were found <= 2,000\n", rcu.Commatize(count))
p := 10
count = 0
for _, n := range untouchable {
count++
if n > p {
cc := rcu.Commatize(count - 1)
cp := rcu.Commatize(p)
fmt.Printf("%7s untouchable numbers were found <= %9s\n", cc, cp)
p = p * 10
if p == limit {
break
}
}
}
cu := rcu.Commatize(len(untouchable))
cl := rcu.Commatize(limit)
fmt.Printf("%7s untouchable numbers were found <= %s\n", cu, cl)
}</syntaxhighlight>
 
{{out}}
<pre>
Same as Version 1.
</pre>
 
=={{header|J}}==
<syntaxhighlight lang="j">
<lang J>
factor=: 3 : 0 NB. explicit
'primes powers'=. __&q: y
Line 629 ⟶ 868:
candidates=: 5 , [: +: [: #\@i. >.@-: NB. within considered range, all but one candidate are even.
spds=:([:sum_of_proper_divisors"0(#\@i.-.i.&.:(p:inv))@*:)f. NB. remove primes which contribute 1
</syntaxhighlight>
</lang>
We may revisit to correct the larger untouchable tallies. The straightforward algorithm presented is a little bit efficient, and, I claim, the verb <tt>(candidates-.spds)</tt> produces the full list of untouchable numbers up to its argument. It considers the sum of proper divisors through the argument squared, less primes. Since J is an algorithm description language, it may be "fairer" to state in J that "more resources required" than in some other language. [https://www.eecg.utoronto.ca/~jzhu/csc326/readings/iverson.pdf]
 
Line 683 ⟶ 922:
but the 512,000,000 sieved below is just from doubling 1,000,000 and running the sieve until we get 150232 for the number
of untouchables under 1,000,000.
<langsyntaxhighlight lang="julia">using Primes
 
function properfactorsum(n)
Line 716 ⟶ 955:
println("The count of untouchable numbers ≤ $N is: ", count(x -> untouchables[x], 1:N))
end
</langsyntaxhighlight>{{out}}
<pre>
The untouchable numbers ≤ 2000 are:
Line 749 ⟶ 988:
 
=={{header|Mathematica}}/{{header|Wolfram Language}}==
<langsyntaxhighlight Mathematicalang="mathematica">f = DivisorSigma[1, #] - # &;
limit = 10^5;
c = Not /@ PrimeQ[Range[limit]];
Line 780 ⟶ 1,019:
Count[untouchable, _?(LessEqualThan[1000])]
Count[untouchable, _?(LessEqualThan[10000])]
Count[untouchable, _?(LessEqualThan[100000])]</langsyntaxhighlight>
{{out}}
<pre>2 246 342 540 714 804 964 1102 1212 1316 1420 1596 1774 1884
Line 804 ⟶ 1,043:
 
=={{header|Nim}}==
I borrowed some ideas from Go version 1, but keep the limit to 100_000 as in Wren version 1.
<langsyntaxhighlight Nimlang="nim">import math, strutils
 
const
Line 867 ⟶ 1,106:
if lim == Lim1:
# Emit last message.
echo CountMessage.format(count, lim)</langsyntaxhighlight>
 
{{out}}
Line 888 ⟶ 1,127:
There are 1212 untouchable numbers ≤ 10000.
There are 13863 untouchable numbers ≤ 100000.</pre>
 
=={{header|Pascal}}==
modified [[Factors_of_an_integer#using_Prime_decomposition]] to calculate only sum of divisors<BR>
Appended a list of count of untouchable numbers out of math.dartmouth.edu/~carlp/uupaper3.pdf<BR>
Nigel is still right, that this procedure is not the way to get proven results.
<syntaxhighlight lang="pascal">program UntouchableNumbers;
program UntouchableNumbers;
{$IFDEF FPC}
{$MODE DELPHI} {$OPTIMIZATION ON,ALL} {$COPERATORS ON}
{$CODEALIGN proc=16,loop=4}
{$ELSE}
{$APPTYPE CONSOLE}
{$ENDIF}
uses
sysutils,strutils
{$IFDEF WINDOWS},Windows{$ENDIF}
;
const
MAXPRIME = 1742537;
//sqr(MaxPrime) = 3e12
LIMIT = 5*1000*1000;
LIMIT_mul = trunc(exp(ln(LIMIT)/3))+1;
 
const
SizePrDeFe = 16*8192;//*size of(tprimeFac) =16 byte 2 Mb ~ level 3 cache
type
tdigits = array [0..31] of Uint32;
tprimeFac = packed record
pfSumOfDivs,
pfRemain : Uint64;
end;
tpPrimeFac = ^tprimeFac;
 
tPrimeDecompField = array[0..SizePrDeFe-1] of tprimeFac;
 
tPrimes = array[0..1 shl 17-1] of Uint32;
 
var
{$ALIGN 16}
PrimeDecompField :tPrimeDecompField;
{$ALIGN 16}
SmallPrimes: tPrimes;
pdfIDX,pdfOfs: NativeInt;
TD : Int64;
 
procedure OutCounts(pUntouch:pByte);
var
n,cnt,lim,deltaLim : NativeInt;
Begin
n := 0;
cnt := 0;
deltaLim := 100;
lim := deltaLim;
repeat
cnt += 1-pUntouch[n];
if n = lim then
Begin
writeln(Numb2USA(IntToStr(lim)):13,' ',Numb2USA(IntToStr(cnt)):12);
lim += deltaLim;
if lim = 10*deltaLim then
begin
deltaLim *=10;
lim := deltaLim;
writeln;
end;
end;
 
inc(n);
until n > LIMIT;
end;
 
function OutN(n:UInt64):UInt64;
begin
write(Numb2USA(IntToStr(n)):15,' dt ',(GettickCount64-TD)/1000:5:3,' s'#13);
TD := GettickCount64;
result := n+LIMIT;
end;
 
//######################################################################
//gets sum of divisors of consecutive integers fast
procedure InitSmallPrimes;
//get primes. Sieving only odd numbers
var
pr : array[0..MAXPRIME] of byte;
p,j,d,flipflop :NativeUInt;
Begin
SmallPrimes[0] := 2;
fillchar(pr[0],SizeOf(pr),#0);
p := 0;
repeat
repeat
p +=1
until pr[p]= 0;
j := (p+1)*p*2;
if j>MAXPRIME then
BREAK;
d := 2*p+1;
repeat
pr[j] := 1;
j += d;
until j>MAXPRIME;
until false;
 
SmallPrimes[1] := 3;
SmallPrimes[2] := 5;
j := 3;
flipflop := (2+1)-1;//7+2*2->11+2*1->13 ,17 ,19 , 23
p := 3;
repeat
if pr[p] = 0 then
begin
SmallPrimes[j] := 2*p+1;
inc(j);
end;
p+=flipflop;
flipflop := 3-flipflop;
until (p > MAXPRIME) OR (j>High(SmallPrimes));
end;
 
function CnvtoBASE(var dgt:tDigits;n:Uint64;base:NativeUint):NativeInt;
//n must be multiple of base aka n mod base must be 0
var
q,r: Uint64;
i : NativeInt;
Begin
fillchar(dgt,SizeOf(dgt),#0);
i := 0;
n := n div base;
result := 0;
repeat
r := n;
q := n div base;
r -= q*base;
n := q;
dgt[i] := r;
inc(i);
until (q = 0);
//searching lowest pot in base
result := 0;
while (result<i) AND (dgt[result] = 0) do
inc(result);
inc(result);
end;
 
function IncByOneInBase(var dgt:tDigits;base:NativeInt):NativeInt;
var
q :NativeInt;
Begin
result := 0;
q := dgt[result]+1;
if q = base then
repeat
dgt[result] := 0;
inc(result);
q := dgt[result]+1;
until q <> base;
dgt[result] := q;
result +=1;
end;
 
procedure CalcSumOfDivs(var pdf:tPrimeDecompField;var dgt:tDigits;n,k,pr:Uint64);
var
fac,s :Uint64;
j : Int32;
Begin
//j is power of prime
j := CnvtoBASE(dgt,n+k,pr);
repeat
fac := 1;
s := 1;
repeat
fac *= pr;
dec(j);
s += fac;
until j<= 0;
with pdf[k] do
Begin
pfSumOfDivs *= s;
pfRemain := pfRemain DIV fac;
end;
j := IncByOneInBase(dgt,pr);
k += pr;
until k >= SizePrDeFe;
end;
 
function SieveOneSieve(var pdf:tPrimeDecompField):boolean;
var
dgt:tDigits;
i,j,k,pr,n,MaxP : Uint64;
begin
n := pdfOfs;
if n+SizePrDeFe >= sqr(SmallPrimes[High(SmallPrimes)]) then
EXIT(FALSE);
//init
for i := 0 to SizePrDeFe-1 do
begin
with pdf[i] do
Begin
pfSumOfDivs := 1;
pfRemain := n+i;
end;
end;
//first factor 2. Make n+i even
i := (pdfIdx+n) AND 1;
IF (n = 0) AND (pdfIdx<2) then
i := 2;
 
repeat
with pdf[i] do
begin
j := BsfQWord(n+i);
pfRemain := (n+i) shr j;
pfSumOfDivs := (Uint64(1) shl (j+1))-1;
end;
i += 2;
until i >=SizePrDeFe;
//i now index in SmallPrimes
i := 0;
maxP := trunc(sqrt(n+SizePrDeFe))+1;
repeat
//search next prime that is in bounds of sieve
if n = 0 then
begin
repeat
inc(i);
pr := SmallPrimes[i];
k := pr-n MOD pr;
if k < SizePrDeFe then
break;
until pr > MaxP;
end
else
begin
repeat
inc(i);
pr := SmallPrimes[i];
k := pr-n MOD pr;
if (k = pr) AND (n>0) then
k:= 0;
if k < SizePrDeFe then
break;
until pr > MaxP;
end;
 
//no need to use higher primes
if pr > maxP then
BREAK;
 
CalcSumOfDivs(pdf,dgt,n,k,pr);
until false;
 
//correct sum of & count of divisors
for i := 0 to High(pdf) do
Begin
with pdf[i] do
begin
j := pfRemain;
if j <> 1 then
pfSumOFDivs *= (j+1);
end;
end;
result := true;
end;
 
function NextSieve:boolean;
begin
dec(pdfIDX,SizePrDeFe);
inc(pdfOfs,SizePrDeFe);
result := SieveOneSieve(PrimeDecompField);
end;
 
function GetNextPrimeDecomp:tpPrimeFac;
begin
if pdfIDX >= SizePrDeFe then
if Not(NextSieve) then
Begin
writeln('of limits ');
EXIT(NIL);
end;
result := @PrimeDecompField[pdfIDX];
inc(pdfIDX);
end;
 
function Init_Sieve(n:NativeUint):boolean;
//Init Sieve pdfIdx,pdfOfs are Global
begin
pdfIdx := n MOD SizePrDeFe;
pdfOfs := n-pdfIdx;
result := SieveOneSieve(PrimeDecompField);
end;
//gets sum of divisors of consecutive integers fast
//######################################################################
 
procedure CheckRest(n: Uint64;pUntouch:pByte);
var
k,lim : Uint64;
begin
lim := 2*LIMIT;
repeat
k := GetNextPrimeDecomp^.pfSumOfDivs-n;
inc(n);
if Not(ODD(k)) AND (k<=LIMIT) then
pUntouch[k] := 1;
// showing still alive not for TIO.RUN
// if n >= lim then lim := OutN(n);
until n >LIMIT_mul*LIMIT;
end;
 
var
Untouch : array of byte;
pUntouch: pByte;
puQW : pQword;
T0:Int64;
n,k : NativeInt;
Begin
if sqrt(LIMIT_mul*LIMIT) >=MAXPRIME then
Begin
writeln('Need to extend count of primes > ',
trunc(sqrt(LIMIT_mul*LIMIT))+1);
HALT(0);
end;
 
setlength(untouch,LIMIT+8+1);
pUntouch := @untouch[0];
//Mark all odd as touchable
puQW := @pUntouch[0];
For n := 0 to LIMIT DIV 8 do puQW[n] := $0100010001000100;
 
InitSmallPrimes;
T0 := GetTickCount64;
writeln('LIMIT = ',Numb2USA(IntToStr(LIMIT)));
writeln('factor beyond LIMIT ',LIMIT_mul);
 
n := 0;
Init_Sieve(n);
 
pUntouch[1] := 1;//all primes
repeat
k := GetNextPrimeDecomp^.pfSumOfDivs-n;
inc(n);//n-> n+1
if k <= LIMIT then
begin
If k <> 1 then
pUntouch[k] := 1
else
begin
//n-1 is prime p
//mark p*p
pUntouch[n] := 1;
//mark 2*p
//5 marked by prime 2 but that is p*p, but 4 has factor sum = 3
pUntouch[n+2] := 1;
end;
end;
until n > LIMIT-2;
//unmark 5 and mark 0
puntouch[5] := 0;
pUntouch[0] := 1;
 
//n=limit-1
k := GetNextPrimeDecomp^.pfSumOfDivs-n;
inc(n);
If (k <> 1) AND (k<=LIMIT) then
pUntouch[k] := 1
else
pUntouch[n] := 1;
//n=limit
k := GetNextPrimeDecomp^.pfSumOfDivs-n;
If Not(odd(k)) AND (k<=LIMIT) then
pUntouch[k] := 1;
 
 
n:= limit+1;
writeln('runtime for n<= LIMIT ',(GetTickCount64-T0)/1000:0:3,' s');
writeln('Check the rest ',Numb2USA(IntToStr((LIMIT_mul-1)*Limit)));
TD := GettickCount64;
CheckRest(n,pUntouch);
writeln('runtime ',(GetTickCount64-T0)/1000:0:3,' s');
T0 := GetTickCount64-T0;
 
OutCounts(pUntouch);
end.</syntaxhighlight>
{{out}}
<pre>
TIO.RUN
LIMIT = 5,000,000
factor beyond LIMIT 171
runtime for n smaller than LIMIT 0.204 s
Check the rest 850,000,000
runtime 32.643 s
100 5
200 10
300 22
400 30
500 38
600 48
700 55
800 69
900 80
 
1,000 89
2,000 196
3,000 318
4,000 443
5,000 570
6,000 689
7,000 801
8,000 936
9,000 1,082
 
10,000 1,212
20,000 2,566
30,000 3,923
40,000 5,324
50,000 6,705
60,000 8,153
70,000 9,586
80,000 10,994
90,000 12,429
 
100,000 13,863
200,000 28,572
300,000 43,515
400,000 58,459
500,000 73,565
600,000 88,828
700,000 104,062
800,000 119,302
900,000 134,758
 
1,000,000 150,232
2,000,000 305,290
3,000,000 462,110
4,000,000 619,638
5,000,000 777,672
 
Real time: 32.827 s CPU share: 99.30 %
//url=https://math.dartmouth.edu/~carlp/uupaper3.pdf
100000 13863
200000 28572
300000 43515
400000 58459
500000 73565
600000 88828
700000 104062
800000 119302
900000 134758
1000000 150232
2000000 305290
3000000 462110
4000000 619638
5000000 777672
6000000 936244
7000000 1095710
8000000 1255016
9000000 1414783
10000000 1574973
20000000 3184111
30000000 4804331
40000000 6430224
50000000 8060163
60000000 9694467
70000000 11330312
80000000 12967239
90000000 14606549
100000000 16246940
 
... at home up to 1E8
50,000,000 8,060,163
60,000,000 9,694,467
70,000,000 11,330,312
80,000,000 12,967,239
90,000,000 14,606,549
 
100,000,000 16,246,940
 
real 18m51,234s
</pre>
 
=={{header|Perl}}==
{{libheader|ntheory}}
<langsyntaxhighlight lang="perl">use strict;
use warnings;
use enum qw(False True);
Line 927 ⟶ 1,644:
printf($fmt, scalar @untouchable, $limit) and last if $limit == ($p *= 10)
}
}</langsyntaxhighlight>
{{out}}
<pre>Number of untouchable numbers ≤ 2000 : 196
Line 953 ⟶ 1,670:
 
=={{header|Phix}}==
<!--<langsyntaxhighlight Phixlang="phix">(phixonline)-->
<span style="color: #008080;">constant</span> <span style="color: #000000;">limz</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">8</span><span style="color: #0000FF;">,</span><span style="color: #000000;">9</span><span style="color: #0000FF;">,</span><span style="color: #000000;">18</span><span style="color: #0000FF;">,</span><span style="color: #000000;">64</span><span style="color: #0000FF;">}</span> <span style="color: #000080;font-style:italic;">-- found by experiment</span>
Line 1,013 ⟶ 1,730:
<span style="color: #000000;">untouchable</span><span style="color: #0000FF;">(</span><span style="color: #000000;">2000</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">10</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">6</span><span style="color: #0000FF;">-(</span><span style="color: #7060A8;">platform</span><span style="color: #0000FF;">()==</span><span style="color: #004600;">JS</span><span style="color: #0000FF;">))</span>
<!--</langsyntaxhighlight>-->
{{out}}
<pre>
Line 1,051 ⟶ 1,768:
Borrow the proper divisors routine from [https://rosettacode.org/wiki/Proper_divisors#Raku here].
{{trans|Wren}}
<syntaxhighlight lang="raku" perl6line># 20210220 Raku programming solution
 
sub propdiv (\x) {
Line 1,094 ⟶ 1,811:
}
}
printf "%6d untouchable numbers were found ≤ %7d\n", +@untouchable, limit</langsyntaxhighlight>
{{out}}
<pre>
Line 1,139 ⟶ 1,856:
 
This version of REXX would need a 64-bit version to calculate the number of untouchable numbers for one million.
<langsyntaxhighlight lang="rexx">/*REXX pgm finds N untouchable numbers (numbers that can't be equal to any aliquot sum).*/
parse arg n cols tens over . /*obtain optional arguments from the CL*/
if n='' | n=="," then n=2000 /*Not specified? Then use the default.*/
Line 1,199 ⟶ 1,916:
end /*m*/ /* [↑] process an even integer. ___*/
if q.m==j then return s + m /*Was J a square? If so, add √ J */
return s /* No, just return. */</langsyntaxhighlight>
{{out|output|text=&nbsp; when using the default inputs:}}
<pre>
Line 1,236 ⟶ 1,953:
 
=={{header|Wren}}==
{{libheader|Wren-seq}}
{{libheader|Wren-math}}
{{libheader|Wren-fmt}}
Not an easy task as, even allowing for the prime tests, it's difficult to know how far you need to sieve to get the right answers. The parameters here were found by trial and error.
===Version 1===
<lang ecmascript>import "/math" for Int, Nums
Run time about 70 seconds on my Core i7 machine.
import "/seq" for Lst
<syntaxhighlight lang="wren">import "./fmtmath" for FmtInt, Nums
import "./fmt" for Fmt
 
var sieve = Fn.new { |n|
Line 1,265 ⟶ 1,982:
 
System.print("List of untouchable numbers <= 2,000:")
for Fmt.tprint(chunk"$,6d", in Lst.chunks(untouchable.where { |n| n <= 2000 }.toList, 10)) {
Fmt.print("$,6d", chunk)
}
System.print()
Fmt.print("$,6d untouchable numbers were found <= 2,000", untouchable.count { |n| n <= 2000 })
Line 1,280 ⟶ 1,995:
}
}
Fmt.print("$,6d untouchable numbers were found <= $,d", untouchable.count, limit)</langsyntaxhighlight>
 
{{out}}
Line 1,312 ⟶ 2,027:
1,212 untouchable numbers were found <= 10,000
13,863 untouchable numbers were found <= 100,000
</pre>
 
===Version 2===
{{trans|C}}
This version uses a much more efficient algorithm for calculating the sums of divisors in bulk.
 
Run time for untouchable numbers up to 100,000 (m = 14) is now only 1.4 seconds and 1,000,000 (m = 63) is reached in 132 seconds.
<syntaxhighlight lang="wren">import "./math" for Int, Nums
import "./fmt" for Fmt
 
var limit = 1e6
var m = 63
var c = Int.primeSieve(limit, false)
var n = m * limit + 1
var sumDivs = List.filled(n, 0)
for (i in 1...n) {
var j = i
while (j < n) {
sumDivs[j] = sumDivs[j] + i
j = j + i
}
}
var s = List.filled(n, false)
for (i in 1...n) {
var sum = sumDivs[i] - i // proper divs sum
if (sum <= n) s[sum] = true
}
var untouchable = [2, 5]
n = 6
while (n <= limit) {
if (!s[n] && c[n-1] && c[n-3]) untouchable.add(n)
n = n + 2
}
System.print("List of untouchable numbers <= 2,000:")
Fmt.tprint("$,6d", untouchable.where { |n| n <= 2000 }, 10)
System.print()
Fmt.print("$,7d untouchable numbers were found <= 2,000", untouchable.count { |n| n <= 2000 })
var p = 10
var count = 0
for (n in untouchable) {
count = count + 1
if (n > p) {
Fmt.print("$,7d untouchable numbers were found <= $,9d", count-1, p)
p = p * 10
if (p == limit) break
}
}
Fmt.print("$,7d untouchable numbers were found <= $,d", untouchable.count, limit)</syntaxhighlight>
 
{{out}}
As Version 1, plus:
<pre>
150,232 untouchable numbers were found <= 1,000,000
</pre>
Jjuanhdez
2,123

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/307844...362949"