Idoneal numbers

From Rosetta Code
Task
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

Translation of: Python
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

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 - 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 ( 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

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

Translation of: FreeBASIC
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

Translation of: Wren
- original version
Translation of: Pascal
- 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

Translation of: XPL0
Works with: Just 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

Translation of: FreeBASIC
// 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

Translation of: Raku
#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#

Translation of: Python
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

Translation of: Lua
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

Translation of: Wren
Library: Go-rcu
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

Translation of: Action!
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

Translation of: Action!
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

Python

Translation of: Raku
''' 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

Translation of: Python
Works with: Halcyon Calc version 4.2.7
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

Translation of: Raku
Library: Wren-fmt
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}