Arithmetic numbers: Difference between revisions
fix alphabetical ordering
m (→{{header|AppleScript}}: Minor refinement for input < 4.) |
Not a robot (talk | contribs) (fix alphabetical ordering) |
||
Line 1,322:
user 0m4.116s
sys 0m0.003s</pre>
=={{header|Delphi}}==
Line 1,623 ⟶ 1,511:
.
</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}}==
| |||