unit U_PanDigitals;
{Copyright 2002, Gary Darby, Intellitech Systems Inc., www.DelphiForFun.org

 This program may be used or modified for any non-commercial purpose
 so long as this original notice remains in place.
 All other rights are reserved
 }

 {
  Pandigital numbers contain all of the digits 0 through 9 exactly once.
  "Almost pandigital" numbers contain the digits 1 through 9 exactly once.

  As an  introduction to pandigital numbers,  here's a program that finds

  1. The smallest pandigtal number that is a perfect square.
  2. A number and it's square which together are almost pandigital.
  }

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Problem1Btn: TButton;
    Problem2Btn: TButton;
    Memo2: TMemo;
    StatusBar1: TStatusBar;
    LeadZeroBox: TCheckBox;
    procedure Problem1BtnClick(Sender: TObject);
    procedure Problem2BtnClick(Sender: TObject);
  public
    nums:array [0..9] of integer; {the digits of the next pandigital}
    function GetNextPandigital(size:integer; var digits:array of integer) : Boolean;
  end;

var   Form1: TForm1;

implementation
{$R *.DFM}

uses math;

  {************** GetNext pandigital}
 function TForm1.GetNextPandigital(size:integer; var digits:array of integer):Boolean;
  {Generates 9 or 10 digit permutations of digits in increasing sequence,
   Input parameter "size" is the number of digits to generate (9 or 10).
   Output placed in open array "digits",  so index value of k refers
   to (k+1)th entry.
   Result is true until all values have been returned.
   Initialize "digits" array with 0,1,2,3,4,5,6,7,8,9 (10 digit pandigitals) or
   1,2,3,4,5,6,7,8,9 (9 digit "almost" pandigitals) before first call.
  }
       procedure swap(i:integer; j:integer);
        {swap digits[i] and digits[j]}
        var temp : integer;
        begin
          temp := digits[i];
          digits[i] := digits[j];
          digits[j] := temp;
        end;


  var k,j,r,s : integer;
  begin
    k := size-2; {start at next-to-last}
    {find the last increasing-order pair}
    while (k>=0) and (digits[k] > digits[k+1]) do dec(k);
    if k<0 then result:=false {if none in increasing order, we're done}
    else
    begin
      j := size-1; {find the rightmost digit less than digits[k]}
      while digits[k] > digits[j] do j:=j-1;
      swap(j,k); {and swap them}
      r:=size-1;
      s:=k+1;  {from there to the end, swap end digits toward the center}
      while r>s do
      begin
        swap(r,s);
        r:=r-1;
        s:=s+1;
      end;
      result:=true;  {magic!}
    end;
  end;


procedure TForm1.Problem1BtnClick(sender:TObject);
{Find smallest pandigital that is a perfect square}
var
  x:int64;
  n:int64;
  s,sx:string;
  found:boolean;
  i:integer;
begin
  for i:=0 to 9 do nums[i]:=i; {initialize digits with 0-9}

  {To disallow answers with leading zeros, start with 1023456789
   by swapping 1st two digits}
  If not leadzerobox.checked then
  begin
    nums[0]:=1;
    nums[1]:=0;
  end;

  found:=false;
  memo2.clear;
  repeat {loop on pandigitals in sequence looking for a perfect square}
    n:=0;
    for i:= 0 to 9 do n:=10*n + nums[i];
    x:=trunc(sqrt(n+0.0)); {+0.0 forces converion to extended}
    if x*x=n then
    begin
      found:=true;
      s:=inttostr(n);
      sx:=inttostr(trunc(sqrt(n+0.0)));
      if length(s)=9 then s:='0'+s;
      memo2.Lines.add('The smallest pandigital that is a perfect square '
                      +' is '+s
                      +'.  ('+sx+'X'+sx+'='+s+')');
    end;
  until (found) or (not getnextpandigital(10, nums));
  If not found then memo2.lines.add('No solution found');
end;

(*
{Not needed now, but we may someday, so we'll just save it here}
function TForm1.IsPanDigital(size:integer; n:int64):boolean;
var
  s:string;
  exists:array['0'..'9'] of boolean;
  ch:char;
begin
  s:=inttostr(n);
  result:=false;
  if (size=10) and (length(s)=9) then s:= '0'+s;
  if (length(s)=size) then
  begin
    if size=10 then ch:='0'
    else ch:='1';
    while ch<>'9' do
    begin
      exists[ch]:=false;
      ch:=succ(ch);
    end;
    if size=10 then  ch:='0'
    else ch:='1';
    while (ch<>'9') and (not exists[ch]) do
    begin
      exists[ch]:=true;
      ch:=succ(ch);
    end;
    if ch=succ('9') then result:=true;
  end;
end;
*)

procedure TForm1.Problem2BtnClick(Sender: TObject);
{Find 2 numbers, one the square of the other which together are 9 digits in
 length and contain all of the digits 1 through 9 exactly once}
var
  n1,n2:int64;
  s1,s2:string;
  found:boolean;
  i:integer;
begin
  for i:=0 to 8 do nums[i]:=i+1; {initialize output permutations}
  found:=false;
  memo2.clear;
  repeat {Loop on all "almost" panndigitals, splitting each into two parts] }
    n1:=0;
    n2:=0;
    {3 digit numbers squared will have 5 or 6 digits, we need a total of 9
     4 digit number will be too big, 2 digit numbers will be to small, so
     we must be looking for a three digit number squared}
    for i:= 0 to 2 do n1:=10*n1 + nums[i]; {get 1st 3 digts as a number}
    for i:=3 to 8 do n2:=10*n2+nums[i]; {get last 6 digits as a number}

    if n1*n1=n2 then {if one is the square of the other, we're done}
    begin
      found:=true;
      s1:=inttostr(n1);
      s2:=inttostr(n2);
      memo2.Lines.add('The number which with it''s square contains all of the '
                      + 'digits 1-9 exactly once is ' +s1
                      + '  ('+s1+'X'+s1+'='+s2+').');
    end;
  until (found) or (not getnextpandigital(9, nums)) ;
  If not found then memo2.lines.add('No solution found');
end;

end.