Idoneal numbers
You are encouraged to solve this task according to the task description, using any language you may know.
Idoneal numbers (also called suitable numbers or convenient numbers) are the positive integers D such that any integer expressible in only one way as x2 ± Dy2 (where x2 is relatively prime to Dy2) is a prime power or twice a prime power.
A positive integer n is idoneal if and only if it cannot be written as ab + bc + ac for distinct positive integers a, b, and c with 0 < a < b < c.
There are only 65 known iodoneal numbers and is likely that no others exist. If there are others, it has been proven that there are at most, two more, and that no others exist below 1,000,000.
- Task
- Find and display at least the first 50 idoneal numbers (between 1 and 255).
- Stretch
- Find and display all 65 known idoneal numbers.
- See also
11l
F is_idoneal(num)
‘ Return true if num is an idoneal number ’
L(a) 1 .< num
L(b) a + 1 .< num
I a * b + a + b > num
L.break
L(c) b + 1 .< num
V sum3 = a * b + b * c + a * c
I sum3 == num
R 0B
I sum3 > num
L.break
R 1B
V row = 0
L(n) 1..1999
I is_idoneal(n)
row++
print(f:‘{n:5}’, end' I row % 13 == 0 {"\n"} E ‘’)- Output:
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
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 /- Output:
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
Action!
;;; find idoneal numbers - numbers that cannot be written as ab + bc + ac
;;; where 0 < a < b < c
;;; there are 65 known idoneal numbers
PROC Main()
CARD count, maxCount, n, a, b, c, ab, sum
BYTE idoneal
count = 0 maxCount = 65
n = 0
WHILE count < maxCount DO
n ==+ 1
idoneal = 1
a = 1
WHILE ( a + 2 ) < n AND idoneal = 1 DO
b = a + 1
DO
ab = a * b
sum = 0
IF ab < n THEN
c = ( n - ab ) / ( a + b )
sum = ab + ( c * ( b + a ) )
IF c > b AND sum = n THEN idoneal = 0 FI
b ==+ 1
FI
UNTIL sum > n OR idoneal = 0 OR ab >= n
OD
a ==+ 1
OD
IF idoneal THEN
Put(' )
IF n < 10 THEN Put(' ) FI
IF n < 100 THEN Put(' ) FI
IF n < 1000 THEN Put(' ) FI
PrintC( n )
count ==+ 1
IF count MOD 13 = 0 THEN PutE() FI
FI
OD
RETURN- Output:
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
ALGOL 68
Note, AND does not shortcut in Algol 68.
BEGIN # find idoneal numbers - numbers that cannot be written as ab + bc + ac #
# where 0 < a < b < c #
# there are 65 known idoneal numbers #
INT count := 0;
INT max count = 65;
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;
INT c = ( n - ab ) OVER ( a + b );
INT sum = ab + ( c * ( b + a ) );
sum <= n
AND b < c
AND ( idoneal := c <= b OR sum /= n )
DO SKIP OD
OD;
IF idoneal THEN
print( ( " ", whole( n, -4 ) ) );
IF ( count +:= 1 ) MOD 13 = 0 THEN print( ( newline ) ) FI
FI
OD
END- Output:
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
ALGOL W
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.- Output:
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
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
- Output:
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
BASIC
BASIC256
r = 0
print "The 65 known Idoneal numbers:"
for n = 1 to 1850
if isIdoneal(n) then
print rjust(string(n),5);
r += 1
if r mod 13 = 0 then print
end if
next n
end
function isIdoneal(n)
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- Output:
Same as the original entry FreeBASIC.
FreeBASIC
- original version
- version with minimized multiplications
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- Output:
'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
Liberty BASIC
' 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- Output:
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
Yabasic
// Rosetta Code problem: http://rosettacode.org/wiki/Idoneal_numbers
// by Jjuanhdez, 09/2022
r = 0
print "The 65 known Idoneal numbers:"
for n = 1 to 1850
if isIdoneal(n) then
print n using "#####";
r = r + 1
if mod(r,13) = 0 print
end if
next n
end
sub isIdoneal(n)
local a, b, c, sum
for a = 1 to n
for b = a+1 to n
if (a*b + a + b > n) break
for c = b+1 to n
sum = a*b + b*c + a*c
if sum = n return false
if sum > n break
next c
next b
next a
return true
end sub- Output:
Same as the original entry FreeBASIC.
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;
}
- Output:
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
C#
using System;
class Program {
static void Main(string[] args) {
var sw = System.Diagnostics.Stopwatch.StartNew();
int a, b, c, i, n, s3, ab; var res = new int[65];
for (n = 1, i = 0; n < 1850; n++) {
bool found = true;
for (a = 1; a < n; a++)
for (b = a + 1, ab = a * b + a + b; b < n; b++, ab += a + 1) {
if (ab > n) break;
for (c = b + 1, s3 = ab + (b + a) * b; c < n; c++, s3 += b + a) {
if (s3 == n) found = false;
if (s3 >= n) break;
}
}
if (found) res[i++] = n;
}
sw.Stop();
Console.WriteLine("The 65 known Idoneal numbers:");
for (i = 0; i < res.Length; i++)
Console.Write("{0,5}{1}", res[i], i % 13 == 12 ? "\n" : "");
Console.Write("Calculations took {0} ms", sw.Elapsed.TotalMilliseconds);
}
}
- Output:
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
Calculations took 28.5862 ms
CLU
idoneal = proc (n: int) returns (bool)
for a: int in int$from_to(1, n) do
for b: int in int$from_to(a+1, n) do
if (a*b + a + b > n) then exit b_high end
for c: int in int$from_to(b+1,n) do
sum: int := a*b + b*c + a*c
if sum=n then return(false) end
if sum>n then exit c_high end
end
except when c_high: end
end
except when b_high: end
end
return(true)
end idoneal
idoneals = iter (amt: int) yields (int)
n: int := 0
while amt > 0 do
n := n + 1
if idoneal(n) then
yield(n)
amt := amt-1
end
end
end idoneals
start_up = proc ()
po: stream := stream$primary_input()
col: int := 0
for i: int in idoneals(65) do
stream$putright(po, int$unparse(i), 5)
col := col + 1
if col = 13 then
stream$putl(po, "")
col := 0
end
end
end start_up- Output:
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
EasyLang
maxCount = 65
while count < maxCount
n += 1
idoneal = 1
a = 1
while a + 2 < n and idoneal = 1
b = a + 1
repeat
ab = a * b
sum = 0
if ab < n
c = (n - ab) div (a + b)
sum = ab + c * (b + a)
if c > b and sum = n
idoneal = 0
.
b += 1
.
until sum > n or idoneal = 0 or ab >= n
.
a += 1
.
if idoneal = 1
count += 1
write " " & n
.
.
FutureBasic
local fn IsIdoneal( n as long ) as BOOL
long a, b, c, sum
BOOL result = NO
for a = 1 to n
for b = a + 1 to n
if ( a * b + a + b > n ) then break
for c = b + 1 to n
sum = a * b + b * c + a * c
if ( sum = n ) then result = NO : exit fn
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- Output:
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
Go
package main
import "rcu"
func isIdoneal(n int) bool {
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
}
func main() {
var idoneals []int
for n := 1; n <= 1850; n++ {
if isIdoneal(n) {
idoneals = append(idoneals, n)
}
}
rcu.PrintTable(idoneals, 13, 4, false)
}
- Output:
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
J
requre'stats'
_10]\(1+i.255)-.+/1*/\.|:1+3 comb 255
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
Here, comb gives us all combinations of 3 numbers in ascending order in the given range (originally in the range 0..254 here, adding 1 shifts them to 1..255). Then we multiply all pairs from these combinations, sum the resulting products and remove those products from a sequence 1..255. (And we form the result into rows of 10 numbers each, to avoid an excessively long row of numbers.)
jq
This entry uses jq's `break` because the equivalent program using `until` is much slower.
Using an NDEBUG version of the C implementation of jq, the program shown below takes about 2.5 seconds to produce the 65 idoneal numbers on a 3 GHz machine; gojq takes about 5 seconds. For gojq, the definition of the `_nwise` helper function must be uncommented.
# For gojq:
# def _nwise($n):
# def n: if length <= $n then . else .[0:$n] , (.[$n:] | n) end;
# n;
def lpad($len): tostring | ($len - length) as $l | (" " * $l)[:$l] + .;
def isIdoneal:
first(
label $out
| . as $n
| range(1; $n) as $a
| label $startB
| range($a+1; $n) as $b
| ($a+$b) as $sum
| ($a*$b) as $prod
| if $prod + $sum > $n then break $startB
else label $startC
| range($b+1; $n) as $c
| ($prod + $sum*$c) as $x
| if $x == $n then 0, break $out
elif $x > $n then break $startC
else empty
end
end )
// true | if . == 0 then false else . end;
# Search blindly
def idoneals: range(1; infinite) | select(isIdoneal);
# The task:
[limit(65; idoneals)]
| _nwise(13) | map(lpad(5)) | join(" ")Invocation: jq -nr -f idoneal.jq
- Output:
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
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
- Output:
[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]
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
- Output:
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
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(", ")
- Output:
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
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.
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()
- Output:
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
PARI/GP
Adapted from the OEIS:A000926 page.
ok(n) = !#select(k -> k <> 2, quadclassunit(-n << 2).cyc) \\ Andrew Howroyd, Jun 08 2018
c = 0; for (n = 1, 1850, ok(n) & printf("%5d%s", n, if (c++ % 13 == 0, "\n", "")))- Output:
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
Pascal
Free Pascal
copy of Raku/Python etc only reducing multiplies in sum.
version with minimized multiplications.
program idoneals;
{$IFDEF FPC}
{$MODE DELPHI}
{$OPTIMIZATION ON,ALL}
{$CODEALIGN loop=1}
{$ENDIF}
{$IFDEF WINDOWS}
{$APPTYPE CONSOLE}
{$ENDIF}
uses
sysutils;
const
runs = 1000;
type
Check_isIdoneal = function(n: Uint32): boolean;
var
idoneals : array of Uint32;
function isIdonealOrg(n: Uint32):Boolean;
var
a,b,c,sum : NativeUint;
begin
For a := 1 to n do
For b := a+1 to n do
Begin
if (a*b + a + b > n) then
BREAK;
For c := b+1 to n do
begin
sum := a * b + b * c + a * c;
if (sum = n) then
EXIT(false);
if (sum > n) then
BREAK;
end;
end;
exit(true);
end;
function isIdoneal(n: Uint32):Boolean;
var
a,b,c,axb,ab,sum : Uint32;
begin
For a := 1 to n do
Begin
ab := a+a;
axb := a*a;
For b := a+1 to n do
Begin
axb += a;
ab +=1;
sum := axb + b*ab;
if (sum > n) then
BREAK;
For c := b+1 to n do
begin
sum += ab;
if (sum = n) then
EXIT(false);
if (sum > n) then
BREAK;
end;
end;
end;
EXIT(true);
end;
function Check(f:Check_isIdoneal):Uint32;
var
n : Uint32;
begin
result := 0;
For n := 1 to 1848 do
if f(n) then
Begin
inc(result);
setlength(idoneals,result); idoneals[result-1] := n;
end;
end;
procedure OneRun(f:Check_isIdoneal);
var
T0 : Int64;
i,l : Uint32;
begin
T0 := GetTickCount64;
For i := runs-1 downto 0 do
l:= check(f);
T0 := GetTickCount64-T0;
dec(l);
For i := 0 to l do
begin
write(idoneals[i]:5);
if (i+1) mod 13 = 0 then
writeln;
end;
Writeln(T0/runs:7:3,' ms per run');
end;
BEGIN
OneRun(@isIdonealOrg);
OneRun(@isIdoneal);
END.
- @TIO.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
6.018 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
2.036 ms per run
Perl
use v5.36;
use enum qw(False True);
sub table ($c, @V) { my $t = $c * (my $w = 5); ( sprintf( ('%'.$w.'d')x@V, @V) ) =~ s/.{1,$t}\K/\n/gr }
sub is_idoneal ($n) {
LOOP:
for my $a (1 .. $n) {
for my $b ($a+1 .. $n) {
last if $a*$b + $a + $b > $n;
for my $c ($b+1 .. $n) {
return False if $n == (my $sum = $a*$b + $b*$c + $c*$a);
last if $sum > $n;
}
}
}
True
}
say table 10, grep { is_idoneal $_ } 1..1850;
- Output:
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
Phix
with javascript_semantics sequence res = {} for n=1 to 1850 do bool found = true; for a=1 to n do for b=a+1 to n do if not found or a*b+a+b>n then exit end if integer ab = (2*a + b)*b for c=b+1 to n do ab += a+b if ab == n then found = false end if if ab >= n then exit end if end for end for end for if found then res &= n end if end for printf(1,"The %d known Idoneal numbers:\n%s\n", {length(res),join_by(res,1,13," ",fmt:="%4d")})
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
PL/0
PL/0 goes for minimalism and so doesn't have a boolean type or "and", "or" and "not" operators.
const maxcount = 65;
var count, n, idoneal, a, b, c, ab, aplusb, nminusa, sum, bagain;
begin
count := 0;
n := 0;
while count < maxcount do begin
n := n + 1;
idoneal := 1;
a := 0;
while a < n * idoneal do begin
a := a + 1;
nminusa := n - a;
b := a;
if b <= nminusa then begin
bagain := idoneal;
while bagain = 1 do begin
b := b + 1;
ab := a * b;
aplusb := a + b;
c := ( n - ab ) / aplusb;
sum := ab + ( c * aplusb );
idoneal := 0;
if c <= b then idoneal := 1;
if sum <> n then idoneal := 1;
bagain := 0;
if b <= nminusa then if sum <= n then bagain := idoneal
end
end;
end;
if idoneal = 1 then begin
! n;
count := count + 1
end
end
end.
- Output:
1
2
3
4
5
6
7
8
9
10
12
...
760
840
1320
1365
1848
PL/M
... under CP/M (or an emulator)
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- Output:
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
Python
''' Rosetta code task: rosettacode.org/wiki/Idoneal_numbers '''
def is_idoneal(num):
''' Return true if num is an idoneal number '''
for a in range(1, num):
for b in range(a + 1, num):
if a * b + a + b > num:
break
for c in range(b + 1, num):
sum3 = a * b + b * c + a * c
if sum3 == num:
return False
if sum3 > num:
break
return True
row = 0
for n in range(1, 2000):
if is_idoneal(n):
row += 1
print(f'{n:5}', end='\n' if row % 13 == 0 else '')
- Output:
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
Raku
First 60 in less than 1/2 second. The remaining 5 take another ~5 seconds.
sub is-idoneal ($n) {
my $idoneal = True;
I: for 1 .. $n -> $a {
for $a ^.. $n -> $b {
last if $a × $b + $a + $b > $n; # short circuit
for $b ^.. $n -> $c {
$idoneal = False and last I if (my $sum = $a × $b + $b × $c + $c × $a) == $n;
last if $sum > $n; # short circuit
}
}
}
$idoneal
}
$_».fmt("%4d").put for (1..1850).hyper(:32batch).grep( &is-idoneal ).batch(10)
- Output:
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
RPL
| RPL code | Comment |
|---|---|
≪ → num
≪ 1 SF
1 num FOR a
a 1 + num FOR b
IF a b DUP2 * + + num > THEN
num 'b' STO
ELSE b 1 + num FOR c
a b * b c * + a c * +
IF DUP num == THEN
DROP 1 CF num DUP DUP 'a' STO 'b' STO 'c' STO
ELSE IF num > THEN
num 'c' STO END
END
NEXT END
NEXT NEXT
1 FS?
≫ ≫ ‘IDNL?’ STO
|
IDNL? ( n -- boolean )
Return value will be given by flag #1
for a in range(1, num):
for b in range(a + 1, num):
if a * b + a + b > num:
break
for c in range(b + 1, num):
sum3 = a * b + b * c + a * c
if sum3 == num:
return False
if sum3 > num:
break
.
.
.
Return boolean value
.
|
- Input:
≪ {} 1 255 FOR n IF n IDNL? THEN n + END NEXT ≫ EVAL
≪ {} 256 2000 FOR n IF n IDNL? THEN n + END NEXT ≫ EVAL
- Output:
2: { 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 }
1: { 273 280 312 330 345 357 385 408 462 520 760 840 1320 1365 1848 }
Swift
import Foundation
func isIdoneal(_ n: Int) -> Bool {
for a in 1..<n {
for b in a + 1..<n {
if a * b + a + b > n {
break
}
for c in b + 1..<n {
let sum = a * b + b * c + a * c
if sum == n {
return false
}
if sum > n {
break
}
}
}
}
return true
}
var count = 0
for n in 1..<1850 {
if isIdoneal(n) {
count += 1
print(String(format: "%4d", n), terminator: count % 13 == 0 ? "\n" : " ")
}
}
- Output:
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
Wren
import "./fmt" for Fmt
var isIdoneal = Fn.new { |n|
for (a in 1...n) {
for (b in a+1...n) {
if (a*b + a + b > n) break
for (c in b+1...n) {
var sum = a*b + b*c + a*c
if (sum == n) return false
if (sum > n) break
}
}
}
return true
}
var idoneals = []
for (n in 1..1850) if (isIdoneal.call(n)) idoneals.add(n)
Fmt.tprint("$4d", idoneals, 13)
- Output:
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
XPL0
Some optimizations borrowed from others. Times on Pi4: real 170ms, user 34ms, sys 24ms
func IsIdoneal(N); \Return 'true' if N is an Idoneal number
int N, A, B, C, AB, S, T;
[for A:= 1 to N do
for B:= A+1 to N do
[AB:= A*B;
S:= A+B;
if AB+S > N then B:= N
else for C:= B+1 to N do
[T:= AB + C*S;
if T = N then return false;
if T > N then C:= N;
];
];
return true;
];
int N, C;
[N:= 1; C:= 0;
Format(5, 0);
loop [if IsIdoneal(N) then
[RlOut(0, float(N));
C:= C+1;
if rem(C/13) = 0 then CrLf(0);
if C >= 65 then quit;
];
N:= N+1;
];
]- Output:
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
Mathematica / Wolfram Language
SetOfNonIdonealNumbers = Flatten@Table[If[0 < a && a < b && b < c, a*b + b*c + a*c, ## &[]], {a, 1, 300}, {b, 1, 300}, {c, 1, 300}];
DeleteCases[Range[120000], Alternatives @@ SetOfNonIdonealNumbers] (*a,b,c up to 300 can't completely cover numbers above 126 581*)
- Output:
{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}