Arithmetic numbers: Difference between revisions
Added Oberon-07
(→{{Scala}}: fix typo) |
(Added Oberon-07) |
||
(6 intermediate revisions by 3 users not shown) | |||
Line 288:
The 10000th arithmetic number: 12953
Of the first 10000 arithmetic numbers, 8458 are composite.</pre>
=={{header|AppleScript}}==
<syntaxhighlight lang="applescript">on isArithmetic(n)
if (n < 4) then
if (n < 0) then return {arithmetic:false, composite:missing value}
return {arithmetic:(n mod 2 = 1), composite:false}
end if
set factorSum to 1 + n
set factorCount to 2
set sqrt to n ^ 0.5
set limit to sqrt div 1
if (limit = sqrt) then
set factorSum to factorSum + limit
set factorCount to 3
set limit to limit - 1
end if
repeat with i from 2 to limit
if (n mod i = 0) then
set factorSum to factorSum + i + n div i
set factorCount to factorCount + 2
end if
end repeat
return {arithmetic:(factorSum mod factorCount = 0), composite:(factorCount > 2)}
end isArithmetic
on task()
set output to {linefeed & "The first 100 arithmetic numbers are:"}
set {n, hitCount, compositeCount, pad} to {0, 0, 0, " "}
repeat 10 times
set row to {}
set targetCount to hitCount + 10
repeat until (hitCount = targetCount)
set n to n + 1
tell isArithmetic(n) to if (its arithmetic) then
set hitCount to hitCount + 1
if (its composite) then set compositeCount to compositeCount + 1
set row's end to text -4 thru -1 of (pad & n)
end if
end repeat
set output's end to join(row, "")
end repeat
repeat with targetCount in {1000, 10000, 100000, 1000000}
repeat while (hitCount < targetCount)
set n to n + 1
tell isArithmetic(n) to if (its arithmetic) then
set hitCount to hitCount + 1
if (its composite) then set compositeCount to compositeCount + 1
end if
end repeat
set output's end to (linefeed & "The " & targetCount & "th arithmetic number is " & n) & ¬
(linefeed & "(" & compositeCount & " composite numbers up to here)")
end repeat
return join(output, linefeed)
end task
on join(lst, delim)
set astid to AppleScript's text item delimiters
set AppleScript's text item delimiters to delim
set txt to lst as text
set AppleScript's text item delimiters to astid
return txt
end join
task()</syntaxhighlight>
{{output}}
<syntaxhighlight lang="applescript">"
The first 100 arithmetic numbers are:
1 3 5 6 7 11 13 14 15 17
19 20 21 22 23 27 29 30 31 33
35 37 38 39 41 42 43 44 45 46
47 49 51 53 54 55 56 57 59 60
61 62 65 66 67 68 69 70 71 73
77 78 79 83 85 86 87 89 91 92
93 94 95 96 97 99 101 102 103 105
107 109 110 111 113 114 115 116 118 119
123 125 126 127 129 131 132 133 134 135
137 138 139 140 141 142 143 145 147 149
The 1000th arithmetic number is 1361
(782 composite numbers up to here)
The 10000th arithmetic number is 12953
(8458 composite numbers up to here)
The 100000th arithmetic number is 125587
(88219 composite numbers up to here)
The 1000000th arithmetic number is 1228663
(905043 composite numbers up to here)"</syntaxhighlight>
=={{header|ARM Assembly}}==
Line 1,057 ⟶ 1,149:
Number of composite arithmetic numbers <= 1228663: 905043
</pre>
=={{header|C#}}==
{{trans|Java}}
<syntaxhighlight lang="C#">
using System;
using System.Collections.Generic;
using System.Linq;
public class ArithmeticNumbers
{
public static void Main(string[] args)
{
int arithmeticCount = 0;
int compositeCount = 0;
int n = 1;
while (arithmeticCount <= 1_000_000)
{
var factors = Factors(n);
int sum = factors.Sum();
if (sum % factors.Count == 0)
{
arithmeticCount++;
if (factors.Count > 2)
{
compositeCount++;
}
if (arithmeticCount <= 100)
{
Console.Write($"{n,3}{(arithmeticCount % 10 == 0 ? "\n" : " ")}");
}
if (new[] { 1_000, 10_000, 100_000, 1_000_000 }.Contains(arithmeticCount))
{
Console.WriteLine();
Console.WriteLine($"{arithmeticCount}th arithmetic number is {n}");
Console.WriteLine($"Number of composite arithmetic numbers <= {n}: {compositeCount}");
}
}
n++;
}
}
private static HashSet<int> Factors(int number)
{
var result = new HashSet<int> { 1, number };
int i = 2;
int j;
while ((j = number / i) >= i)
{
if (i * j == number)
{
result.Add(i);
result.Add(j);
}
i++;
}
return result;
}
}
</syntaxhighlight>
{{out}}
<pre>
1 3 5 6 7 11 13 14 15 17
19 20 21 22 23 27 29 30 31 33
35 37 38 39 41 42 43 44 45 46
47 49 51 53 54 55 56 57 59 60
61 62 65 66 67 68 69 70 71 73
77 78 79 83 85 86 87 89 91 92
93 94 95 96 97 99 101 102 103 105
107 109 110 111 113 114 115 116 118 119
123 125 126 127 129 131 132 133 134 135
137 138 139 140 141 142 143 145 147 149
1000th arithmetic number is 1361
Number of composite arithmetic numbers <= 1361: 782
10000th arithmetic number is 12953
Number of composite arithmetic numbers <= 12953: 8458
100000th arithmetic number is 125587
Number of composite arithmetic numbers <= 125587: 88219
1000000th arithmetic number is 1228663
Number of composite arithmetic numbers <= 1228663: 905043
</pre>
=={{header|C++}}==
Line 1,144 ⟶ 1,323:
sys 0m0.003s</pre>
=={{header|
<syntaxhighlight lang="cowgol">include "cowgol.coh";
const MAX := 13000;
var divisorSum: uint16[MAX+1];
var divisorCount: uint8[MAX+1];
sub CalculateDivisorSums() is
MemZero(&divisorSum[0] as [uint8], @bytesof divisorSum);
MemZero(&divisorCount[0] as [uint8], @bytesof divisorCount);
var div: @indexof divisorSum := 1;
while div <= MAX loop
var num := div;
while num <= MAX loop
divisorSum[num] := divisorSum[num] + div;
divisorCount[num] := divisorCount[num] + 1;
end loop;
end sub;
sub NextArithmetic(n: uint16): (r: uint16) is
r := n + 1;
while divisorSum[r] % divisorCount[r] as uint16 != 0 loop
r := r + 1;
end loop;
end sub;
sub Composite(n: uint16): (r: uint8) is
r := 0;
if n>1 and divisorSum[n] != n+1 then
r := 1;
end if;
end sub;
var current: uint16 := 0;
var nth: uint16 := 0;
var composites: uint16 := 0;
CalculateDivisorSums();
print("First 100 arithmetic numbers:\n");
while nth < 10000 loop
current := NextArithmetic(current);
nth := nth + 1;
composites := composites + Composite(current) as uint16;
if nth <= 100 then
print_i16(current);
if nth % 5 == 0 then
print_nl();
else
print_char('\t');
end if;
end if;
if nth == 1000 or nth == 10000 then
print_nl();
print(": ");
print_i16(composites);
print("
end if;
end loop;</syntaxhighlight>
{{out}}
<pre>
11
19
27
42 43 44 45 46
47 49 51 53 54
55 56 57 59 60
61 62 65 66 67
68 69 70 71 73
77 78 79 83 85
86 87 89 91 92
93 94 95 96 97
99 101 102 103 105
107 109 110 111 113
114 115 116 118 119
123 125 126 127 129
131 132 133 134 135
137 138 139 140 141
142 143 145 147 149
1000: 1361 782 composites
10000: 12953 8458 composites</pre>
=={{header|Delphi}}==
<syntaxhighlight lang="delphi">
Line 1,444 ⟶ 1,606:
.
</syntaxhighlight>
=={{header|Factor}}==
{{works with|Factor|0.99 2022-04-03}}
<syntaxhighlight lang="factor">USING: combinators formatting grouping io kernel lists
lists.lazy math math.functions math.primes math.primes.factors
math.statistics math.text.english prettyprint sequences
tools.memory.private ;
: arith? ( n -- ? ) divisors mean integer? ;
: larith ( -- list ) 1 lfrom [ arith? ] lfilter ;
: arith ( m -- seq ) larith ltake list>array ;
: composite? ( n -- ? ) dup 1 > swap prime? not and ;
: ordinal ( n -- str ) [ commas ] keep ordinal-suffix append ;
: info. ( n -- )
{
[ ordinal "%s arithmetic number: " printf ]
[ arith dup last commas print ]
[ commas "Number of composite arithmetic numbers <= %s: " printf ]
[ drop [ composite? ] count commas print nl ]
} cleave ;
"First 100 arithmetic numbers:" print
100 arith 10 group simple-table. nl
{ 3 4 5 6 } [ 10^ info. ] each</syntaxhighlight>
{{out}}
<pre>
First 100 arithmetic numbers:
1 3 5 6 7 11 13 14 15 17
19 20 21 22 23 27 29 30 31 33
35 37 38 39 41 42 43 44 45 46
47 49 51 53 54 55 56 57 59 60
61 62 65 66 67 68 69 70 71 73
77 78 79 83 85 86 87 89 91 92
93 94 95 96 97 99 101 102 103 105
107 109 110 111 113 114 115 116 118 119
123 125 126 127 129 131 132 133 134 135
137 138 139 140 141 142 143 145 147 149
1,000th arithmetic number: 1,361
Number of composite arithmetic numbers <= 1,000: 782
10,000th arithmetic number: 12,953
Number of composite arithmetic numbers <= 10,000: 8,458
100,000th arithmetic number: 125,587
Number of composite arithmetic numbers <= 100,000: 88,219
1,000,000th arithmetic number: 1,228,663
Number of composite arithmetic numbers <= 1,000,000: 905,043
</pre>
=={{header|FreeBASIC}}==
{{trans|Delphi}}
<syntaxhighlight lang="freebasic">' Rosetta Code problem: https://rosettacode.org/wiki/Arithmetic_numbers
' by Jjuanhdez, 06/2022
Dim As Double t0 = Timer
Dim As Integer N = 1, ArithCnt = 0, CompCnt = 0
Dim As Integer Div, DivCnt, Sum, Quot
Print "The first 100 arithmetic numbers are:"
Do
Div = 1 : DivCnt = 0 : Sum = 0
Do
Quot = N / Div
If Quot < Div Then Exit Do
If Quot = Div AndAlso (N Mod Div) = 0 Then 'N is a square
Sum += Quot
DivCnt += 1
Exit Do
End If
If (N Mod Div) = 0 Then
Sum += Div + Quot
DivCnt += 2
End If
Div += 1
Loop
If (Sum Mod DivCnt) = 0 Then 'N is arithmetic
ArithCnt += 1
If ArithCnt <= 100 Then
Print Using "####"; N;
If (ArithCnt Mod 20) = 0 Then Print
End If
If DivCnt > 2 Then CompCnt += 1
Select Case ArithCnt
Case 1e3
Print Using !"\nThe #######th arithmetic number is #####,### up to which ###,### are composite."; ArithCnt; N; CompCnt
Case 1e4, 1e5, 1e6
Print Using "The #######th arithmetic number is #####,### up to which ###,### are composite."; ArithCnt; N; CompCnt
End Select
End If
N += 1
Loop Until ArithCnt >= 1e6
Print !"\nTook"; Timer - t0; " seconds on i5 @3.20 GHz"
Sleep</syntaxhighlight>
{{out}}
<pre>The first 100 arithmetic numbers are:
1 3 5 6 7 11 13 14 15 17 19 20 21 22 23 27 29 30 31 33
35 37 38 39 41 42 43 44 45 46 47 49 51 53 54 55 56 57 59 60
61 62 65 66 67 68 69 70 71 73 77 78 79 83 85 86 87 89 91 92
93 94 95 96 97 99 101 102 103 105 107 109 110 111 113 114 115 116 118 119
123 125 126 127 129 131 132 133 134 135 137 138 139 140 141 142 143 145 147 149
The 1000th arithmetic number is 1,361 up to which 782 are composite.
The 10000th arithmetic number is 12,953 up to which 8,458 are composite.
The 100000th arithmetic number is 125,587 up to which 88,219 are composite.
The 1000000th arithmetic number is 1,228,663 up to which 905,043 are composite.
Took 38.42344779999985 seconds on i5 @3.20 GHz</pre>
=={{header|FutureBasic}}==
Line 2,061 ⟶ 2,334:
</pre>
=={{header|Modula-2}}==
<syntaxhighlight lang="modula2">MODULE ArithmeticNumbers;
FROM InOut IMPORT WriteString, WriteCard, WriteLn;
CONST
Max = 13000;
VAR
divSum: ARRAY [1..Max] OF CARDINAL;
divCount: ARRAY [1..Max] OF CHAR;
current, count, composites: CARDINAL;
PROCEDURE CalculateDivisorSums;
VAR div, num: CARDINAL;
BEGIN
FOR num := 1 TO Max DO
divSum[num] := 0;
divCount[num] := CHR(0)
END;
FOR div := 1 TO Max DO
num := div;
WHILE num <= Max DO
INC(divSum[num], div);
INC(divCount[num]);
INC(num, div)
END
END
END CalculateDivisorSums;
PROCEDURE Next(n: CARDINAL): CARDINAL;
BEGIN
REPEAT INC(n) UNTIL (divSum[n] MOD ORD(divCount[n])) = 0;
RETURN n
END Next;
PROCEDURE Composite(n: CARDINAL): BOOLEAN;
BEGIN
RETURN (n>1) AND (divSum[n] # n+1)
END Composite;
BEGIN
CalculateDivisorSums;
WriteString("First 100 arithmetic numbers:");
WriteLn;
current := 0;
FOR count := 1 TO 10000 DO
current := Next(current);
IF Composite(current) THEN INC(composites) END;
IF count <= 100 THEN
WriteCard(current, 5);
IF count MOD 10 = 0 THEN WriteLn END
END;
IF (count = 1000) OR (count = 10000) THEN
WriteCard(count, 5);
WriteString(": ");
WriteCard(current, 5);
WriteString(", ");
WriteCard(composites, 5);
WriteString(" composites");
WriteLn
END;
END
END ArithmeticNumbers.</syntaxhighlight>
{{out}}
<pre>First 100 arithmetic numbers:
1 3 5 6 7 11 13 14 15 17
19 20 21 22 23 27 29 30 31 33
35 37 38 39 41 42 43 44 45 46
47 49 51 53 54 55 56 57 59 60
61 62 65 66 67 68 69 70 71 73
77 78 79 83 85 86 87 89 91 92
93 94 95 96 97 99 101 102 103 105
107 109 110 111 113 114 115 116 118 119
123 125 126 127 129 131 132 133 134 135
137 138 139 140 141 142 143 145 147 149
1000: 1361, 782 composites
10000: 12953, 8458 composites</pre>
=={{header|Nim}}==
<syntaxhighlight lang="Nim">import std/strformat
Line 2,127 ⟶ 2,480:
1000000th arithmetic number: 1228663
Number of composite arithmetic numbers ⩽ 1228663: 905043
</pre>
=={{header|Oberon-07}}==
{{Trans|Modula-2}}
<syntaxhighlight lang="modula2">
MODULE ArithmeticNumbers;
IMPORT Out;
CONST
Max = 130000;
VAR divSum: ARRAY Max + 1 OF INTEGER;
divCount: ARRAY Max + 1 OF CHAR;
current, count, composites: INTEGER;
PROCEDURE CalculateDivisorSums;
VAR div, num: INTEGER;
BEGIN
FOR num := 1 TO Max DO
divSum[num] := 0;
divCount[num] := CHR(0)
END;
FOR div := 1 TO Max DO
num := div;
WHILE num <= Max DO
divSum[num] := divSum[num] + div;
divCount[num] := CHR(ORD(divCount[num]) + 1);
num := num + div
END
END
END CalculateDivisorSums;
PROCEDURE Next(n: INTEGER): INTEGER;
BEGIN
REPEAT n := n + 1 UNTIL (divSum[n] MOD ORD(divCount[n])) = 0;
RETURN n
END Next;
PROCEDURE Composite(n: INTEGER): BOOLEAN;
BEGIN
RETURN (n>1) & (divSum[n] # n+1)
END Composite;
BEGIN
CalculateDivisorSums;
Out.String("First 100 arithmetic numbers:");
Out.Ln;
current := 0;
FOR count := 1 TO 100000 DO
current := Next(current);
IF Composite(current) THEN composites := composites + 1 END;
IF count <= 100 THEN
Out.Int(current, 5);
IF count MOD 10 = 0 THEN Out.Ln END
END;
IF (count = 1000) OR (count = 10000) OR (count = 100000) THEN
Out.Int(count, 6);
Out.String("th: ");
Out.Int(current, 6);
Out.String(", ");
Out.Int(composites, 6);
Out.String(" composites");
Out.Ln
END;
END
END ArithmeticNumbers.
</syntaxhighlight>
{{out}}
<pre>
First 100 arithmetic numbers:
1 3 5 6 7 11 13 14 15 17
19 20 21 22 23 27 29 30 31 33
35 37 38 39 41 42 43 44 45 46
47 49 51 53 54 55 56 57 59 60
61 62 65 66 67 68 69 70 71 73
77 78 79 83 85 86 87 89 91 92
93 94 95 96 97 99 101 102 103 105
107 109 110 111 113 114 115 116 118 119
123 125 126 127 129 131 132 133 134 135
137 138 139 140 141 142 143 145 147 149
1000th: 1361, 782 composites
10000th: 12953, 8458 composites
100000th: 125587, 88219 composites
</pre>
|