Untouchable numbers: Difference between revisions

Added FreeBASIC
m (→‎{{header|Pascal}}: reduced to only calc sum of divisors nearly halves time on TIO.RUN.Longer list of count of untouchable numbers)
(Added FreeBASIC)
 
(10 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.
<langsyntaxhighlight lang="pascal">program UntouchableNumbers;
program UntouchableNumbers;
{$IFDEF FPC}
{$MODE DELPHI} {$OPTIMIZATION ON,ALL} {$COPERATORS ON}
{$CODEALIGN proc=16,loop=4}
{$ELSE}
{$APPTYPE CONSOLE}
Line 903 ⟶ 1,145:
;
const
MAXPRIME = 1742537;
//100*1000*1000;//10*1000*1000;//5*1000*1000;//1000*1000;
//sqr(MaxPrime) = 3e12
LIMIT = 5*1000*1000;
LIMIT_mul = trunc(exp(ln(LIMIT)/3))+1;
//384;//152;//104;//64;
LIMIT_mul = 104;
 
//######################################################################
//gets sum of divisors of consecutive integers fast
const
SizePrDeFe = 16*8192;//*size of(tprimeFac) =16 byte 2 Mb ~ level 3 cache
Line 921 ⟶ 1,161:
 
tPrimeDecompField = array[0..SizePrDeFe-1] of tprimeFac;
 
tPrimes = array[0..65535] of Uint32;
tPrimes = array[0..1 shl 17-1] of Uint32;
 
var
Line 929 ⟶ 1,170:
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. #0..65535.Sieving only odd numbers
const
MAXLIMIT = (821641-1) shr 1;
var
pr : array[0..MAXLIMITMAXPRIME] of byte;
p,j,d,flipflop :NativeUInt;
Begin
Line 946 ⟶ 1,221:
until pr[p]= 0;
j := (p+1)*p*2;
if j>MAXLIMITMAXPRIME then
BREAK;
d := 2*p+1;
Line 952 ⟶ 1,227:
pr[j] := 1;
j += d;
until j>MAXLIMITMAXPRIME;
until false;
 
Line 958 ⟶ 1,233:
SmallPrimes[2] := 5;
j := 3;
d := 7;
flipflop := (2+1)-1;//7+2*2->11+2*1->13 ,17 ,19 , 23
p := 3;
Line 964 ⟶ 1,238:
if pr[p] = 0 then
begin
SmallPrimes[j] := d2*p+1;
inc(j);
end;
d += 2*flipflop;
p+=flipflop;
flipflop := 3-flipflop;
until (p > MAXLIMITMAXPRIME) OR (j>High(SmallPrimes));
end;
 
Line 1,129 ⟶ 1,402:
if pdfIDX >= SizePrDeFe then
if Not(NextSieve) then
Begin
writeln('of limits ');
EXIT(NIL);
end;
result := @PrimeDecompField[pdfIDX];
inc(pdfIDX);
Line 1,141 ⟶ 1,417:
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;
 
function CheckPrime(n:Uint64;prmEndIdx:NativeInt;pUntouch:pByte):NativeInt;
var
i,k: NativeInt;
Begin
//n= prime,n+1 would be marked by n*n with proper factors 1,n
//here n is aready n+1
pUntouch[n] := 1;
//marked by prime*n with proper factors 1,(prime),n
For i := 0 to prmEndIdx do
begin
k := smallprimes[i]+n;
If k > LIMIT then
Begin
dec(prmEndIdx);
BREAK;
end;
pUntouch[k] := 1;
end;
result := prmEndIdx;
end;
 
Line 1,178 ⟶ 1,438:
Untouch : array of byte;
pUntouch: pByte;
puQW : pQword;
T0:Int64;
n,k,lim,prmEndIdx : NativeInt;
Begin
if sqrt(LIMIT_mul*LIMIT) >=MAXPRIME then
setlength(untouch,LIMIT+1);
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;
prmEndIdx := 0;
repeat
inc(prmEndIdx);
until smallprimes[prmEndIdx] > trunc(sqrt(Limit));
writeln('LIMIT = ',Numb2USA(IntToStr(LIMIT)));
writeln(prmEndIdx:10,smallprimes[prmEndIdx]:10);
writeln('factor beyond LIMIT ',LIMIT_mul);
 
n := 0;
Init_Sieve(n);
 
pUntouch[0] := 1;
pUntouch[1] := 1;//all primes
repeat
Line 1,206 ⟶ 1,472:
pUntouch[k] := 1
else
if n>3 thenbegin
//n-1 is prime p
prmEndIdx := CheckPrime(n,prmEndIdx,pUntouch);
//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);
T0 := GetTickCount64-T0;
end.</syntaxhighlight>
writeln('runtime ',T0/1000:0:3,' s');
k := 0;
lim :=10;
for n := 0 to LIMIT DIV 10 do
Begin
if n = lim then
Begin
writeln(lim:10,k:10);
lim *= 10;
end;
k += 1-pUntouch[n];
end;
lim := 2*LIMIT DIV 10;
for n := LIMIT DIV 10+1 to LIMIT do
Begin
if n = lim then
Begin
writeln(lim:10,k:10);
lim += LIMIT DIV 10;
end;
k += 1-pUntouch[n];
end;
end.</lang>
{{out}}
<pre>
TIO.RUN
LIMIT = 5,000,000
factor beyond LIMIT 171
331 2237
runtime for n smaller than LIMIT 0.204 s
factor beyond LIMIT 104
Check the rest 850,000,000
runtime for n<= LIMIT 0.272 s
runtime 32.643 s
Check the rest 515,000,000
100 5
runtime 19.052 s
10 200 2 10
100 300 5 22
1000 400 89 30
10000 500 1212 38
100000 13863 600 48
1000000 150232 700 55
1500000 227297 800 69
2000000 305290 900 80
2500000 383422
3000000 462110
3500000 540769
4000000 619638
4500000 698504
5000000 777672
 
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
Line 1,292 ⟶ 1,593:
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 1,332 ⟶ 1,644:
printf($fmt, scalar @untouchable, $limit) and last if $limit == ($p *= 10)
}
}</langsyntaxhighlight>
{{out}}
<pre>Number of untouchable numbers ≤ 2000 : 196
Line 1,358 ⟶ 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,418 ⟶ 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,456 ⟶ 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,499 ⟶ 1,811:
}
}
printf "%6d untouchable numbers were found ≤ %7d\n", +@untouchable, limit</langsyntaxhighlight>
{{out}}
<pre>
Line 1,544 ⟶ 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,604 ⟶ 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,641 ⟶ 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,670 ⟶ 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,685 ⟶ 1,995:
}
}
Fmt.print("$,6d untouchable numbers were found <= $,d", untouchable.count, limit)</langsyntaxhighlight>
 
{{out}}
Line 1,717 ⟶ 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>
2,123

edits