Arithmetic numbers
- Definition
A positive integer n is an arithmetic number if the average of its positive divisors is also an integer.
Clearly all odd primes p must be arithmetic numbers because their only divisors are 1 and p whose sum is even and hence their average must be an integer. However, the prime number 2 is not an arithmetic number because the average of its divisors is 1.5.
- Example
30 is an arithmetic number because its 7 divisors are: [1, 2, 3, 5, 6, 10, 15, 30], their sum is 72 and average 9 which is an integer.
- Task
Calculate and show here:
1. The first 100 arithmetic numbers.
2. The xth arithmetic number where x = 1,000 and x = 10,000.
3. How many of the first x arithmetic numbers are composite.
Note that, technically, the arithmetic number 1 is neither prime nor composite.
- Stretch
Carry out the same exercise in 2. and 3. above for x = 100,000 and x = 1,000,000.
- References
- Wikipedia: Arithmetic number
- OEIS:A003601 - Numbers n such that the average of the divisors of n is an integer
Factor
<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</lang>
- Output:
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
Delphi
<lang Delphi>
program ArithmeiticNumbers;
{$APPTYPE CONSOLE}
procedure ArithmeticNumbers; var N, ArithCnt, CompCnt, DDiv: integer; var DivCnt, Sum, Quot, Rem: integer; begin N:= 1; ArithCnt:= 0; CompCnt:= 0; repeat begin DDiv:= 1; DivCnt:= 0; Sum:= 0; while true do begin Quot:= N div DDiv; Rem:=N mod DDiv; if Quot < DDiv then break; if (Quot = DDiv) and (Rem = 0) then //N is a square begin Sum:= Sum+Quot; DivCnt:= DivCnt+1; break; end; if Rem = 0 then begin Sum:= Sum + DDiv + Quot; DivCnt:= DivCnt+2; end; DDiv:= DDiv+1; end; if (Sum mod DivCnt) = 0 then //N is arithmetic begin ArithCnt:= ArithCnt+1; if ArithCnt <= 100 then begin Write(N:4); if (ArithCnt mod 20) = 0 then WriteLn; end; if DivCnt > 2 then CompCnt:= CompCnt+1; case ArithCnt of 1000, 10000, 100000, 1000000: begin Writeln; Write(N, #9 {tab} ); Write(CompCnt); end; end; end;
N:= N+1;
end
until ArithCnt >= 1000000; WriteLn; end;
begin ArithmeticNumbers; WriteLn('Hit Any Key'); ReadLn; end. </lang>
- Output:
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 1361 782 12953 8458 125587 88219 1228663 905043 Hit Any Key
J
<lang J>factors=: {{ */@>,{(^ [:i.1+])&.>/__ q:y}} isArith=: {{ (= <.) (+/%#) factors|y}}"0</lang>
Task examples: <lang J> examples=: 1+I.isArith 1+i.2e6
10 10$examples 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
(1e3-1){examples NB. 0 is first
1361
(1e4-1){examples
12953
+/0=1 p: (1e3 {. examples) -. 1
782
+/0=1 p: (1e4 {. examples) -. 1
8458
+/0=1 p: (1e5 {. examples) -. 1
88219
+/0=1 p: (1e6 {. examples) -. 1
905043</lang>
Julia
<lang ruby>using Primes
function isarithmetic(n)
f = [one(n)]
for (p,e) in factor(n)
f = reduce(vcat, [f*p^j for j in 1:e], init=f)
end
meandivisorsum = sum(f) / length(f)
return round(meandivisorsum) == meandivisorsum
end
function arithmetic(n)
i, arr = 1, Int[]
while length(arr) < n
isarithmetic(i) && push!(arr, i)
i += 1
end
return arr
end
a1M = arithmetic(1_000_000) composites = [!isprime(i) for i in a1M]
println("The first 100 arithmetic numbers are:") foreach(p -> print(lpad(p[2], 5), p[1] % 20 == 0 ? "\n" : ""), enumerate(a1M[1:100]))
println("\n X Xth in Series Composite") for n in [1000, 10_000, 100_000, 1_000_000]
println(lpad(n, 9), lpad(a1M[n], 12), lpad(sum(composites[2:n]), 14))
end
</lang>
- Output:
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
X Xth in Series Composite
1000 1361 782
10000 12953 8458
100000 125587 88219
1000000 1228663 905043
Pascal
<lang Pascal>
program ArithmeiticNumbers;
procedure ArithmeticNumbers; var N, ArithCnt, CompCnt, DDiv: longint; var DivCnt, Sum, Quot, Rem: longint; begin N:= 1; ArithCnt:= 0; CompCnt:= 0; repeat begin DDiv:= 1; DivCnt:= 0; Sum:= 0; while true do begin Quot:= N div DDiv; Rem:=N mod DDiv; if Quot < DDiv then break; if (Quot = DDiv) and (Rem = 0) then //N is a square begin Sum:= Sum+Quot; DivCnt:= DivCnt+1; break; end; if Rem = 0 then begin Sum:= Sum + DDiv + Quot; DivCnt:= DivCnt+2; end; DDiv:= DDiv+1; end; if (Sum mod DivCnt) = 0 then //N is arithmetic begin ArithCnt:= ArithCnt+1; if ArithCnt <= 100 then begin Write(N:4); if (ArithCnt mod 20) = 0 then WriteLn; end; if DivCnt > 2 then CompCnt:= CompCnt+1; case ArithCnt of 1000, 10000, 100000, 1000000: begin Writeln; Write(N, #9 {tab} ); Write(CompCnt); end; end; end;
N:= N+1;
end
until ArithCnt >= 1000000; WriteLn; end;
begin ArithmeticNumbers; WriteLn('Hit Any Key'); ReadLn; end. </lang>
- Output:
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 1361 782 12953 8458 125587 88219 1228663 905043 Hit Any Key
Phix
with javascript_semantics sequence arithmetic = {1} integer composite = 0 function get_arithmetic(integer nth) integer n = arithmetic[$]+1 while length(arithmetic)<nth do sequence divs = factors(n,1) if remainder(sum(divs),length(divs))=0 then composite += length(divs)>2 arithmetic &= n end if n += 1 end while return arithmetic[nth] end function {} = get_arithmetic(100) printf(1,"The first 100 arithmetic numbers are:\n%s\n", {join_by(arithmetic,1,10," ",fmt:="%3d")}) constant fmt = "The %,dth arithmetic number is %,d up to which %,d are composite.\n" for n in {1e3,1e4,1e5,1e6} do integer nth = get_arithmetic(n) printf(1,fmt,{n,nth,composite}) end for
Aside: You could inline the get_arithmetic() call inside the loop, however the formal language specification does not actually guarantee that the value of composite won't be output as it was before the function call is made. You certainly would not expect get_arithmetic(n,composite) to do anything other than pass the prior value into the function, so for your own sanity you should in general avoid using the visually rather similar get_arithmetic(n),composite, and suchlike, in order to collect/output the completely different post-invocation value. Or and perhaps even better, just simply avoid writing functions with side-effects, and of course were get_arithmetic() a procedure [with side-effects] rather than a function, you would not be tempted to invoke it inline or use any other form of doubtful execution order anyway.
- Output:
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 1,000th arithmetic number is 1,361 up to which 782 are composite. The 10,000th arithmetic number is 12,953 up to which 8,458 are composite. The 100,000th arithmetic number is 125,587 up to which 88,219 are composite. The 1,000,000th arithmetic number is 1,228,663 up to which 905,043 are composite.
Raku
<lang perl6>use Prime::Factor; use Lingua::EN::Numbers;
my @arithmetic = lazy (1..∞).hyper.grep: { my @div = .&divisors; (@div.sum / +@div).narrow ~~ Int }
say "The first { .Int.&cardinal } arithmetic numbers:\n", @arithmetic[^$_].batch(10)».fmt("%{.chars}d").join: "\n" given 1e2;
for 1e3, 1e4, 1e5, 1e6 {
say "\nThe { .Int.&ordinal }: { comma @arithmetic[$_-1] }";
say "Composite arithmetic numbers ≤ { comma @arithmetic[$_-1] }: { comma +@arithmetic[^$_].grep({!.is-prime}) - 1 }";
}</lang>
The first one hundred 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 The one thousandth: 1,361 Composite arithmetic numbers ≤ 1,361: 782 The ten thousandth: 12,953 Composite arithmetic numbers ≤ 12,953: 8,458 The one hundred thousandth: 125,587 Composite arithmetic numbers ≤ 125,587: 88,219 The one millionth: 1,228,663 Composite arithmetic numbers ≤ 1,228,663: 905,043
Wren
<lang ecmascript>import "./math" for Int, Nums import "./fmt" for Fmt import "./sort" for Find
var arithmetic = [1] var primes = [] var limit = 1e6 var n = 3 while (arithmetic.count < limit) {
var divs = Int.divisors(n)
if (divs.count == 2) {
primes.add(n)
arithmetic.add(n)
} else {
var mean = Nums.mean(divs)
if (mean.isInteger) arithmetic.add(n)
}
n = n + 1
} System.print("The first 100 arithmetic numbers are:") Fmt.tprint("$3d", arithmetic[0..99], 10)
for (x in [1e3, 1e4, 1e5, 1e6]) {
var last = arithmetic[x-1]
Fmt.print("\nThe $,dth arithmetic number is: $,d", x, last)
var pcount = Find.nearest(primes, last) + 1
if (!Int.isPrime(last)) pcount = pcount - 1
var comp = x - pcount - 1 // 1 is not composite
Fmt.print("The count of such numbers <= $,d which are composite is $,d.", last, comp)
}</lang>
- Output:
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 1,000th arithmetic number is: 1,361 The count of such numbers <= 1,361 which are composite is 782. The 10,000th arithmetic number is: 12,953 The count of such numbers <= 12,953 which are composite is 8,458. The 100,000th arithmetic number is: 125,587 The count of such numbers <= 125,587 which are composite is 88,219. The 1,000,000th arithmetic number is: 1,228,663 The count of such numbers <= 1,228,663 which are composite is 905,043.
XPL0
<lang XPL0>int N, ArithCnt, CompCnt, Div, DivCnt, Sum, Quot; [Format(4, 0); N:= 1; ArithCnt:= 0; CompCnt:= 0; repeat Div:= 1; DivCnt:= 0; Sum:= 0;
loop [Quot:= N/Div;
if Quot < Div then quit;
if Quot = Div and rem(0) = 0 then \N is a square
[Sum:= Sum+Quot; DivCnt:= DivCnt+1; quit];
if rem(0) = 0 then
[Sum:= Sum + Div + Quot;
DivCnt:= DivCnt+2;
];
Div:= Div+1;
];
if rem(Sum/DivCnt) = 0 then \N is arithmetic
[ArithCnt:= ArithCnt+1;
if ArithCnt <= 100 then
[RlOut(0, float(N));
if rem(ArithCnt/20) = 0 then CrLf(0);
];
if DivCnt > 2 then CompCnt:= CompCnt+1;
case ArithCnt of 1000, 10_000, 100_000, 1_000_000:
[CrLf(0);
IntOut(0, N); ChOut(0, 9\tab\);
IntOut(0, CompCnt);
]
other;
];
N:= N+1;
until ArithCnt >= 1_000_000; ]</lang>
- Output:
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 1361 782 12953 8458 125587 88219 1228663 905043