Rosetta Code

Idoneal numbers: Difference between revisions

Page Discussion

Idoneal numbers (view source)

Revision as of 17:46, 24 March 2024

15,144 bytes added ,  1 month ago
Added ABC
(→‎{{header|PL/0}}: unnecessary brackets)
(Added ABC)
 
(18 intermediate revisions by 9 users not shown)
Line 1:
{{draft task}}
 
'''[[wp:Idoneal_number|Idoneal numbers]]''' (also called '''suitable''' numbers or '''convenient''' numbers) are the positive integers '''D''' such that any integer expressible in only one way as '''x<sup>2</sup> ± Dy<sup>2</sup>''' (where '''x<sup>2</sup>''' is relatively prime to '''Dy<sup>2</sup>''') is a prime power or twice a prime power.
Line 47:
</syntaxhighlight>
 
{{out}}
<pre>
1 2 3 4 5 6 7 8 9 10 12 13 15
16 18 21 22 24 25 28 30 33 37 40 42 45
48 57 58 60 70 72 78 85 88 93 102 105 112
120 130 133 165 168 177 190 210 232 240 253 273 280
312 330 345 357 385 408 462 520 760 840 1320 1365 1848
</pre>
 
=={{header|ABC}}==
<syntaxhighlight lang="abc">
HOW TO RETURN a over b: RETURN floor( a / b )
 
HOW TO REPORT is.idoneal n:
PUT 1 IN idoneal
PUT 0 IN a
PUT n over 2 IN max.a
WHILE idoneal = 1 AND a < max.a:
PUT a + 1 IN a
PUT a IN b
PUT n IN c
PUT 0 IN sum
PUT 1 IN again
WHILE b < c AND b < n - 1 AND sum <= n AND idoneal = 1:
PUT b + 1 IN b
PUT a * b IN ab
PUT ( n - ab ) over ( a + b ) IN c
PUT ab + ( c * ( b + a ) ) IN sum
IF c > b AND sum = n:
PUT 0 IN idoneal
REPORT idoneal = 1
 
PUT 0 IN count
PUT 0 IN n
WHILE count < 65:
PUT n + 1 IN n
IF is.idoneal n:
WRITE n >> 5
PUT count + 1 IN count
IF count mod 13 = 0: WRITE /
</syntaxhighlight>
{{out}}
<pre>
Line 119 ⟶ 160:
FOR n WHILE count < max count DO
BOOL idoneal := TRUE;
FOR a TO n -OVER 2 WHILE idoneal DO
FOR b FROM a + 1 TO n - 1
WHILE INT ab = a * b;
Line 125 ⟶ 166:
INT sum = ab + ( c * ( b + a ) );
sum <= n
AND b < c
AND ( idoneal := c <= b OR sum /= n )
DO SKIP OD
Line 143 ⟶ 185:
312 330 345 357 385 408 462 520 760 840 1320 1365 1848
</pre>
 
=={{header|ALGOL W}}==
<syntaxhighlight lang="algolw">
begin % find idoneal numbers - numbers that cannot be written as ab + bc + ac %
% where 0 < a < b < c %
% there are 65 known idoneal numbers %
 
integer count, MAX_COUNT, n;
MAX_COUNT := 65;
count := 0;
n := 0;
while count < MAX_COUNT do begin
logical idoneal;
integer a;
n := n + 1;
idoneal := true;
a := 1;
while ( a + 2 ) < n and idoneal do begin
integer b;
b := a + 1;
while begin
integer ab, sum;
ab := a * b;
sum := 0;
if ab < n then begin
integer c;
c := ( n - ab ) div ( a + b );
sum := ab + ( c * ( b + a ) );
if c > b and sum = n then idoneal := false;
b := b + 1
end if_ab_lt_n ;
sum <= n and idoneal and ab < n
end do begin end;
a := a + 1
end;
if idoneal then begin
count := count + 1;
writeon( i_w := 4, s_w := 0, " ", n );
if count rem 13 = 0 then write()
end if_idoneal
end while_count_lt_MAX_COUNT
end.
</syntaxhighlight>
{{out}}
<pre>
1 2 3 4 5 6 7 8 9 10 12 13 15
16 18 21 22 24 25 28 30 33 37 40 42 45
48 57 58 60 70 72 78 85 88 93 102 105 112
120 130 133 165 168 177 190 210 232 240 253 273 280
312 330 345 357 385 408 462 520 760 840 1320 1365 1848
</pre>
 
=={{header|Arturo}}==
 
<syntaxhighlight lang="arturo">idoneal?: function [n][
loop 1..n 'a [
loop (a+1)..n 'b [
if n < a*b + a + b -> break
loop (b+1)..n 'c [
s: sum @[a*b b*c a*c]
if s = n -> return false
if s > n -> break
]
]
]
return true
]
 
idoneals: select 1..1850 => idoneal?
 
loop split.every: 13 idoneals 'x ->
print map x 's -> pad to :string s 4</syntaxhighlight>
 
{{out}}
 
<pre> 1 2 3 4 5 6 7 8 9 10 12 13 15
16 18 21 22 24 25 28 30 33 37 40 42 45
48 57 58 60 70 72 78 85 88 93 102 105 112
120 130 133 165 168 177 190 210 232 240 253 273 280
312 330 345 357 385 408 462 520 760 840 1320 1365 1848</pre>
 
=={{header|BASIC}}==
Line 174 ⟶ 296:
<pre>Same as the original entry FreeBASIC.</pre>
 
==={{header|FreeBASIC}}===
{{trans|Wren}} - original version
{{trans|Pascal}} - version with minimized multiplications
<syntaxhighlight lang="freebasic">Function isIdonealOrg(n As Uinteger) As Boolean
Dim As Uinteger a, b, c, sum
For a = 1 To n
For b = a+1 To n
If (a*b + a + b > n) Then Exit For
For c = b+1 To n
sum = a*b + b*c + a*c
If sum = n Then Return false
If sum > n Then Exit For
Next c
Next b
Next a
Return true
End Function
 
Function isIdoneal(n As Uinteger) As Boolean
Dim As Uinteger a, b, c, axb, ab, sum
For a = 1 To n
ab = a+a
axb = a*a
For b = a+1 To n
axb += a
ab +=1
sum = axb + b*ab
If (sum > n) Then Exit For
For c = b+1 To n
sum += ab
If (sum = n) Then Return false
If (sum > n) Then Exit For
Next c
Next b
Next a
Return true
End Function
 
Dim As Double t0 = Timer
Dim r As Byte = 0
Print "The 65 known Idoneal numbers:"
For n As Uinteger = 1 To 1850
If isIdonealOrg(n) Then
Print Using "#####"; n;
r += 1
If r Mod 13 = 0 Then Print
End If
Next n
Print !"\nTime:"; (Timer - t0); Chr(10)
 
Dim As Double t1 = Timer
For n As Uinteger = 1 To 1850
If isIdoneal(n) Then
Print Using "#####"; n;
r += 1
If r Mod 13 = 0 Then Print
End If
Next n
Print !"\n\nTime:"; (Timer - t1)
Sleep</syntaxhighlight>
{{out}}
<pre>'Tested in jdoodle.com
 
The 65 known Idoneal numbers:
1 2 3 4 5 6 7 8 9 10 12 13 15
16 18 21 22 24 25 28 30 33 37 40 42 45
48 57 58 60 70 72 78 85 88 93 102 105 112
120 130 133 165 168 177 190 210 232 240 253 273 280
312 330 345 357 385 408 462 520 760 840 1320 1365 1848
0.5490732192993164 ms per run
 
1 2 3 4 5 6 7 8 9 10 12 13 15
16 18 21 22 24 25 28 30 33 37 40 42 45
48 57 58 60 70 72 78 85 88 93 102 105 112
120 130 133 165 168 177 190 210 232 240 253 273 280
312 330 345 357 385 408 462 520 760 840 1320 1365 1848
0.3645658493041992 ms per run</pre>
 
==={{header|Liberty BASIC}}===
{{trans|XPL0}}
{{works with|Just BASIC}}
<syntaxhighlight lang="libertybasic">
' Idoneal numbers
n = 1: c = 0
do
if isIdoneal(n) then
print using("#####", n);
c = c + 1
if c mod 13 = 0 then print
end if
n = n + 1
loop until c >= 65
print
end
 
function isIdoneal(n)
'Return -1 if n is an Idoneal number, 0 otherwise
for a = 1 to n
for b = a + 1 to n
ab = a * b
s = a + b
if ab + s > n then
b = n
else
for c = b + 1 to n
t = ab + c * s
if t = n then isIdoneal = 0: exit function
if t > n then c = n
next
end if
next b
next a
isIdoneal = -1
end function
</syntaxhighlight>
{{out}}
<pre>
1 2 3 4 5 6 7 8 9 10 12 13 15
16 18 21 22 24 25 28 30 33 37 40 42 45
48 57 58 60 70 72 78 85 88 93 102 105 112
120 130 133 165 168 177 190 210 232 240 253 273 280
312 330 345 357 385 408 462 520 760 840 1320 1365 1848
</pre>
 
==={{header|Yabasic}}===
Line 207 ⟶ 453:
{{out}}
<pre>Same as the original entry FreeBASIC.</pre>
 
=={{header|C}}==
{{trans|Raku}}
<syntaxhighlight lang="c">#include <stdio.h>
#include <stdbool.h>
 
bool isIdoneal(int n) {
int a, b, c, sum;
for (a = 1; a < n; ++a) {
for (b = a + 1; b < n; ++b) {
if (a*b + a + b > n) break;
for (c = b + 1; c < n; ++c) {
sum = a*b + b*c + a*c;
if (sum == n) return false;
if (sum > n) break;
}
}
}
return true;
}
 
int main() {
int n, count = 0;
for (n = 1; n <= 1850; ++n) {
if (isIdoneal(n)) {
printf("%4d ", n);
if (!(++count % 13)) printf("\n");
}
}
return 0;
}</syntaxhighlight>
 
{{out}}
<pre>
1 2 3 4 5 6 7 8 9 10 12 13 15
16 18 21 22 24 25 28 30 33 37 40 42 45
48 57 58 60 70 72 78 85 88 93 102 105 112
120 130 133 165 168 177 190 210 232 240 253 273 280
312 330 345 357 385 408 462 520 760 840 1320 1365 1848
</pre>
 
=={{header|C#|CSharp}}==
Line 292 ⟶ 578:
312 330 345 357 385 408 462 520 760 840 1320 1365 1848</pre>
 
=={{header|FreeBASIC}}==
{{trans|Wren}} - original version
{{trans|Pascal}} - version with minimized multiplications
<syntaxhighlight lang="freebasic">Function isIdonealOrg(n As Uinteger) As Boolean
Dim As Uinteger a, b, c, sum
For a = 1 To n
For b = a+1 To n
If (a*b + a + b > n) Then Exit For
For c = b+1 To n
sum = a*b + b*c + a*c
If sum = n Then Return false
If sum > n Then Exit For
Next c
Next b
Next a
Return true
End Function
 
=={{header|EasyLang}}==
Function isIdoneal(n As Uinteger) As Boolean
{{trans|Lua}}
Dim As Uinteger a, b, c, axb, ab, sum
<syntaxhighlight lang=easylang>
maxCount = 65
For a = 1 To n
while count < maxCount
ab = a+a
n axb += a*a1
For bidoneal = a+1 To n
a axb += a1
while a + 2 < n and idoneal = ab +=1
sumb = axba + b*ab1
repeat
If (sum > n) Then Exit For
ab = a For c =* b+1 To n
sum += ab0
if ab If (sum =< n) Then Return false
c If= (sumn >- nab) Thendiv Exit(a For+ b)
Nextsum = ab + c * (b + a)
Next if c > b and sum = n
idoneal = 0
Next a
Return true .
b += 1
End Function
.
until sum > n or idoneal = 0 or ab >= n
.
a += 1
.
if idoneal = 1
count += 1
write " " & n
.
.
</syntaxhighlight>
 
Dim As Double t0 = Timer
Dim r As Byte = 0
Print "The 65 known Idoneal numbers:"
For n As Uinteger = 1 To 1850
If isIdonealOrg(n) Then
Print Using "#####"; n;
r += 1
If r Mod 13 = 0 Then Print
End If
Next n
Print !"\nTime:"; (Timer - t0); Chr(10)
 
=={{header|FutureBasic}}==
Dim As Double t1 = Timer
<syntaxhighlight lang="futurebasic">
For n As Uinteger = 1 To 1850
local fn IsIdoneal( n as long ) as BOOL
If isIdoneal(n) Then
long a, b, c, sum
Print Using "#####"; n;
BOOL result r += 1NO
If r Mod 13 = 0 Then Print
for a End= If1 to n
for b = a + 1 to n
Next n
if ( a * b + a + b > n ) then break
Print !"\n\nTime:"; (Timer - t1)
for c = b + 1 to n
Sleep</syntaxhighlight>
sum = a * b + b * c + a * c
{{out}}
if ( sum = n ) then result = NO : exit fn
<pre>'Tested in jdoodle.com
if ( sum > n ) then break
next
next
next
result = YES
end fn = result
 
 
long r, n
 
r = 0
print "The 65 known Idoneal numbers:"
for n = 1 to 1850
if ( fn IsIdoneal( n ) == YES )
printf @"%5ld\b", n
r++
if r mod 13 == 0 then print
end if
next
 
HandleEvents
</syntaxhighlight>
{{output}}
<pre>
The 65 known Idoneal numbers:
1 2 3 4 5 6 7 8 9 10 12 13 15
Line 362 ⟶ 654:
120 130 133 165 168 177 190 210 232 240 253 273 280
312 330 345 357 385 408 462 520 760 840 1320 1365 1848
</pre>
0.5490732192993164 ms per run
 
1 2 3 4 5 6 7 8 9 10 12 13 15
16 18 21 22 24 25 28 30 33 37 40 42 45
48 57 58 60 70 72 78 85 88 93 102 105 112
120 130 133 165 168 177 190 210 232 240 253 273 280
312 330 345 357 385 408 462 520 760 840 1320 1365 1848
0.3645658493041992 ms per run</pre>
 
=={{header|Go}}==
Line 479 ⟶ 764:
120 130 133 165 168 177 190 210 232 240 253 273 280
312 330 345 357 385 408 462 520 760 840 1320 1365 1848
</pre>
 
=={{header|Julia}}==
{{Trans|Action!}}
<syntaxhighlight lang="julia">
begin # find idoneal numbers - numbers that cannot be written as ab + bc + ac
# where 0 < a < b < c
# there are 65 known idoneal numbers
local count = 0
local maxCount = 65
local n = 0
local iNumbers = collect( 1 : maxCount )
while count < maxCount
n += 1
local idoneal = true
local a = 1
while ( a + 2 ) < n && idoneal
local b = a + 1
while true
local ab = a * b
local sum = 0
if ab < n
local c = ( n - ab ) ÷ ( a + b )
sum = ab + ( c * ( b + a ) )
if c > b && sum == n
idoneal = false
end
b += 1
end
if sum > n || idoneal == 0 || ab >= n
break
end
end
a += 1
end
if idoneal
count += 1
iNumbers[ count ] = n
end
end
println( iNumbers )
end
</syntaxhighlight>
 
{{out}}
<pre>
[1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 12, 13, 15, 16, 18, 21, 22, 24, 25, 28, 30, 33, 37, 40, 42, 45, 48, 57, 58, 60, 70, 72, 78, 85, 88, 93, 102, 105, 112, 120, 130, 133, 165, 168, 177, 190, 210, 232, 240, 253, 273, 280, 312, 330, 345, 357, 385, 408, 462, 520, 760, 840, 1320, 1365, 1848]
</pre>
 
=={{header|Lua}}==
{{Trans|Action!}}
<syntaxhighlight lang="lua">
do -- find idoneal numbers - numbers that cannot be written as ab + bc + ac
-- where 0 < a < b < c
-- there are 65 known idoneal numbers
local count = 0
local maxCount = 65
local n = 0
while count < maxCount do
n = n + 1
local idoneal = true
local a = 1
while ( a + 2 ) < n and idoneal do
local b = a + 1
repeat
local ab = a * b
local sum = 0
if ab < n then
local c = math.floor( ( n - ab ) / ( a + b ) )
sum = ab + ( c * ( b + a ) )
if c > b and sum == n then
idoneal = false
end
b = b + 1
end
until sum > n or not idoneal or ab >= n
a = a + 1
end
if idoneal then
count = count + 1
io.write( string.format( " %4d", n ) )
if count % 13 == 0 then io.write( "\n" ) end
end
end
end
</syntaxhighlight>
{{out}}
<pre>
1 2 3 4 5 6 7 8 9 10 12 13 15
16 18 21 22 24 25 28 30 33 37 40 42 45
48 57 58 60 70 72 78 85 88 93 102 105 112
120 130 133 165 168 177 190 210 232 240 253 273 280
312 330 345 357 385 408 462 520 760 840 1320 1365 1848
</pre>
 
=={{header|MiniScript}}==
<syntaxhighlight lang="miniscript">
isIdoneal = function(n)
for a in range(1, n)
for b in range(a + 1, n)
if a * b + a + b > n then break
for c in range(b + 1, n)
sum3 = a * b + b * c + a * c
if sum3 == n then return false
if sum3 > n then break
end for
end for
end for
return true
end function
 
idoneals = []
for n in range(1, 2000)
if isIdoneal(n) then idoneals.push(n)
end for
 
print idoneals.join(", ")
</syntaxhighlight>
{{out}}
<pre>
1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 12, 13, 15, 16, 18, 21, 22, 24, 25, 28, 30, 33, 37, 40, 42, 45, 48, 57, 58, 60, 70, 72, 78, 85, 88, 93, 102, 105, 112, 120, 130, 133, 165, 168, 177, 190, 210, 232, 240, 253, 273, 280, 312, 330, 345, 357, 385, 408, 462, 520, 760, 840, 1320, 1365, 1848
</pre>
 
=={{header|Nim}}==
To do something different, we use a sieve. This is more efficient as the computations are done only once. But, in this case, this doesn’t change a lot.
<syntaxhighlight lang=Nim>import std/[algorithm, math, strformat]
 
const N = 2000
 
var isIdoneal: array[1..N, bool]
isIdoneal.fill(true)
 
for a in 1..sqrt(N / 3).int:
var p = a * (a + 1)
for b in (a + 1)..(N div (3 * a)):
var n = p + (a + b) * (b + 1)
while n <= N:
isIdoneal[n] = false
inc n, a + b
inc p, a
 
var idx = 0
for n in 1..N:
if isIdoneal[n]:
inc idx
stdout.write &"{n:>4}"
stdout.write if idx mod 13 == 0: '\n' else: ' '
echo()
</syntaxhighlight>
 
{{out}}
<pre> 1 2 3 4 5 6 7 8 9 10 12 13 15
16 18 21 22 24 25 28 30 33 37 40 42 45
48 57 58 60 70 72 78 85 88 93 102 105 112
120 130 133 165 168 177 190 210 232 240 253 273 280
312 330 345 357 385 408 462 520 760 840 1320 1365 1848
</pre>
 
Line 738 ⟶ 1,179:
1365
1848
</pre>
 
=={{header|PL/M}}==
{{works with|8080 PL/M Compiler}} ... under CP/M (or an emulator)
<syntaxhighlight lang="plm">
100H: /* FIND IDONEAL NUMBERS - NUMBERS THAT CANNOT BE WRITTEN */
/* AS AB + BC + AC WHERE 0 < A < B < C */
/* THERE ARE 65 KNOWN IDONEAL NUMBERS */
 
/* CP/M BDOS SYSTEM CALL AND I/O ROUTINES */
BDOS: PROCEDURE( FN, ARG ); DECLARE FN BYTE, ARG ADDRESS; GOTO 5; END;
PR$CHAR: PROCEDURE( C ); DECLARE C BYTE; CALL BDOS( 2, C ); END;
PR$STRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9, S ); END;
PR$NL: PROCEDURE; CALL PR$CHAR( 0DH ); CALL PR$CHAR( 0AH ); END;
PR$NUMBER: PROCEDURE( N ); /* PRINTS A NUMBER IN THE MINIMUN FIELD WIDTH */
DECLARE N ADDRESS;
DECLARE V ADDRESS, N$STR ( 6 )BYTE, W BYTE;
V = N;
W = LAST( N$STR );
N$STR( W ) = '$';
N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
DO WHILE( ( V := V / 10 ) > 0 );
N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
END;
CALL PR$STRING( .N$STR( W ) );
END PR$NUMBER;
 
/* TASK */
 
DECLARE TRUE LITERALLY '0FFH', FALSE LITERALLY '0';
DECLARE ( COUNT, N, A, B, C, AB, SUM ) ADDRESS;
DECLARE ( IDONEAL, FINISHED ) BYTE;
DECLARE MAX$COUNT LITERALLY '65';
 
COUNT, N = 0;
DO WHILE COUNT < MAX$COUNT;
N = N + 1;
IDONEAL = TRUE;
A = 1;
DO WHILE ( A + 2 ) < N AND IDONEAL;
B = A + 1;
FINISHED = FALSE;
DO WHILE NOT FINISHED;
AB = A * B;
SUM = 0;
IF AB < N THEN DO;
C = ( N - AB ) / ( A + B );
SUM = AB + ( C * ( B + A ) );
IF C > B AND SUM = N THEN IDONEAL = FALSE;
B = B + 1;
END;
FINISHED = SUM > N OR NOT IDONEAL OR AB >= N;
END;
A = A + 1;
END;
IF IDONEAL THEN DO;
CALL PR$CHAR( ' ' );
IF N < 10 THEN CALL PR$CHAR( ' ' );
IF N < 100 THEN CALL PR$CHAR( ' ' );
IF N < 1000 THEN CALL PR$CHAR( ' ' );
CALL PR$NUMBER( N );
IF ( COUNT := COUNT + 1 ) MOD 13 = 0 THEN CALL PR$NL;
END;
END;
 
EOF
</syntaxhighlight>
{{out}}
<pre>
1 2 3 4 5 6 7 8 9 10 12 13 15
16 18 21 22 24 25 28 30 33 37 40 42 45
48 57 58 60 70 72 78 85 88 93 102 105 112
120 130 133 165 168 177 190 210 232 240 253 273 280
312 330 345 357 385 408 462 520 760 840 1320 1365 1848
</pre>
 
Line 898 ⟶ 1,413:
{{trans|Raku}}
{{libheader|Wren-fmt}}
<syntaxhighlight lang="ecmascriptwren">import "./fmt" for Fmt
 
var isIdoneal = Fn.new { |n|
Tigerofdarkness
3,021

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/337673...362793"