How to resolve the algorithm Idoneal numbers step by step in the Pascal programming language

Published on 12 May 2024 09:40 PM
#Pascal

How to resolve the algorithm Idoneal numbers step by step in the Pascal programming language

Table of Contents

Problem Statement

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.

Let's start with the solution:

Step by Step solution about How to resolve the algorithm Idoneal numbers step by step in the Pascal programming language

Source code in the pascal programming language

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.

You may also check:How to resolve the algorithm Greatest common divisor step by step in the dt programming language
You may also check:How to resolve the algorithm Ray-casting algorithm step by step in the Liberty BASIC programming language
You may also check:How to resolve the algorithm Dynamic variable names step by step in the Groovy programming language
You may also check:How to resolve the algorithm Hello world/Graphical step by step in the Applesoft BASIC programming language
You may also check:How to resolve the algorithm Weird numbers step by step in the ALGOL 68 programming language