unit U_TShirt2_XXL;
{Copyright 2001, 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
 }

{Back of shirt:
   "The smallest 3 digit number that equals to the sum
   of the cubes of its digits."
 Front of shirt:  ?????

 This program searches out n digit numbers that are equal to the sum
 of the nth powers of its digits.   Brute force works up to about 8 or 9.
 After that run times become excessive and we'll have to find a smarter way.

   A good source for advanced studies, also lists the 88 base 10 Armstrong numbers
        http://www.deimel.org/rec_math/rec_math.htm

    This XXL version aqdds a multisets processing button and a search that
   uses the BigInts unit to do a multiset search for values longer than 19 digits.
 }


interface

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

type
TByteArray=array of byte;
  TForm1 = class(TForm)
    Memo1: TMemo;
    UpDown1: TUpDown;
    Label1: TLabel;
    Edit1: TEdit;
    Memo2: TMemo;
    Brute1Btn: TButton;
    Brute2btn: TButton;
    StopBtn: TButton;
    MultiSetsBtn: TButton;
    Countlbl: TLabel;
    BigIntsBtn: TButton;
    SearchAllBtn: TButton;
procedure Brute1BtnClick(Sender: TObject);
procedure Brute2btnClick(Sender: TObject);
procedure StopBtnClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure MultiSetsBtnClick(Sender: TObject);
procedure BigIntsBtnClick(Sender: TObject);
procedure SearchAllBtnClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
public
loopcount:int64;
      foundcount:integer;
      startTime: TDateTime;
procedure initsearch(typestr:string);
procedure updatestats;
procedure makecaption(leftSide, Rightside:string);
end;

var
Form1: TForm1;

implementation
{$R *.DFM}

{********************* Brute1BtnClick ***************}
procedure TForm1.Brute1BtnClick(Sender: TObject);
{Brute Force method - just try all n digit numbers and show those that
 meet condition }
var
j:integer;
  m,mm,p,x:int64;
  tot:int64;
  done:boolean;
  start:int64;
begin
if updown1.position>19 then
begin
showmessage('Maximum of 19 digits for this type of search, try "Big Numbers Search"');
    exit;
end;
  screen.cursor:=crhourglass; {busy cursor}
start:=1;
  p:=updown1.position-1;  {n-1, just for convenience}
initsearch('Brute Force');
for j:= 1 to p do start:=start*10; {compute "start", smallest n digit number}
loopcount:=start;
  done:=false;
  starttime:=now;
{loop from start to 10*start-1, all n digit numbers}
while (tag=0) and (loopcount<start*10) and (not done) do
begin
m:=loopcount;
    tot:=0;
while m>0 do {the heart of the matter}
begin
mm:=m mod 10; {get units digit}
x:=mm;
for j:=1 to p do x:=x*mm; {raise it to nth power}
tot:=tot+x; {add it to total}
if tot>loopcount then break;  {might as well stop checking if total gets too big}
m:=m div 10; {divide by 10 to get next prior digit}
end;
if (m=0) and (tot=loopcount) then
begin
memo2.lines.add(inttostr(loopcount)+ format('  %6.1f seconds',[(now-starttime)*secsperday]));
      inc(loopcount);
      inc(foundcount);
end
else inc(loopcount);
if (loopcount mod 4096)=0 then
begin
countlbl.caption:= format('%6d tested in %6.1f seconds',
                    [loopcount,(now-starttime)*secsperday]);
     application.processmessages;
end;
end;
  updatestats;
  screen.cursor:=crdefault; {normal cursor}
end;

{********************** Brute2BtnClick ***************}
procedure TForm1.Brute2btnClick(Sender: TObject);
{We really only use 10 values of the digits 0-9 the the nth power for
 the summing part. What if we just precalculate the 10 values and put them
 in a table and use them for summing?}
var
j,k,p:integer;
    m,mm:int64;
    tot:int64;
    done:boolean;
    start:int64;
    pwrs:array[0..9] of int64;
    starttime:TDateTime;
begin
if updown1.position>19 then
begin
showmessage('Maximum of 19 digits for this type of search, try "Big Numbers Search"');
    exit;
end;
  screen.cursor:=crHourglass; {busy cursor}
start:=1;
  initsearch('Smarter Brute Force');
  p:=updown1.position-1;  {p=n-1 for convenience}
{Calculate the values of 0 through 9 to the (P+1)th power}
for j:=0 to 9 do pwrs[j]:=j;
for j:= 1 to p do
begin
start:=start*10;
for k:=0 to 9 do pwrs[k]:=pwrs[k]*k;
end;
  loopcount:=start;
  done:=false;
  starttime:=now;
  tag:=0;
{same brute force code as above except sum pwrs[n] instead of recalculating}
while (tag=0) and (loopcount<start*10) and (not done) do
begin
m:=loopcount;
    tot:=0;
while m>0 do
begin
mm:=m mod 10;
      tot:=tot+pwrs[mm];
if tot>loopcount then break;
      m:=m div 10;
end;
if (m=0) and (tot=loopcount) then
begin
{done:=true;} {set done:=true to stop after 1st success}
memo2.lines.add(inttostr(loopcount)+ format('%6.1f seconds',[(now-starttime)*secsperday]));
       inc(loopcount);
       inc(foundcount);
end
else inc(loopcount);
if (loopcount mod 4096)=0 then
begin
countlbl.caption:= format('%6d tested in %6.1f seconds',[loopcount,(now-starttime)*secsperday]);
     application.processmessages;
end;
end;
  updatestats;
  screen.cursor:=crdefault; {normal cursor}
end;



{********************** MultisetsBtnClick ****************}
procedure TForm1.MultiSetsBtnClick(Sender: TObject);
{Here's the fastest search technique so far -
 it takes advantage of the fact that any permutation of N digits will have
 the same sum of Nth powers.  So there's really no need to check all of the
 permutations.  If we can generate the unique subsets that represent posible
 N digit numbers (called multisets), we can calculate the sums of powers and
 see if the digits in the sum exactly match the digits summed.
 If so, it's a solution!  (But it only works for values that fit in Int64, less
 than 20 digits long.)
 }
var
pwrs:array[0..9] of int64;
  i,j,k,p,m:integer;
  tot,val, minval:int64;
  found:boolean;
  n, copyn:array of integer;

function isSelected(var n:array of integer; m:integer):boolean;
{is m in n?, if so erase it from n so we don't match it next time}
var
i:integer;
begin
result:=false;
for i:= 0 to high(n) do
if n[i]=m then
begin
result:=true;
      n[i]:=-1 ;
      break;
end;
end;


function getnextmultiset(var n:array of integer):boolean;
{Generate the next multiset from array N.  Size of multiset
   is determined by the size of dynamic array N.  The total
   set size to select from is assumed to be 10 (0-9)}
var
i,j,lim:integer;
    done:boolean;
begin
j:=high(n);
    done:=false;
repeat
if j>0 then lim:=n[j-1] else lim:=9;
if n[j]< lim then
begin
inc(n[j]);
for i:=j+1 to high(n) do n[i]:=0;
        done:=true;
end
else
begin
dec(j);
if j<0 then done:=true;
end;
until done;
    result:=j>=0;
end;

begin
if updown1.position>19 then
begin
showmessage('Maximum of 19 digits for this type of search, try "Big Numbers Search"');
    exit;
end;
  screen.cursor:=crHourglass; {busy cursor}
p:=updown1.position;
  initsearch('Multisets');

  setlength(n,p);
  setlength(copyn,p);
for j:=0 to 9 do pwrs[j]:=j;
  minval:=1;
for j:= 1 to p-1 do
begin
minval:=minval*10;
for k:=0 to 9 do pwrs[k]:=pwrs[k]*k; {do this p-1 times to get Pth powers}
n[j]:=9;
end;
  n[0]:=0;
while (tag=0) and getnextmultiset(n) do
begin
for i:=0 to high(n) do copyn[i]:=n[i];
    tot:=0;   {get the sums of powers of the digits}
for j:=0 to high(n) do
tot:=tot+ pwrs[n[j]];
if tot>=minval then {check it if it's an n digit number (no leading 0)}
begin
{see if all of the numbers in this power sum match the numbers in the mult-set}
val:=tot;
      found:=true;
for i:=1 to p do
begin
m:=val mod 10;
if not isselected(copyn, m) then
begin
found:=false;
          break;
end;
        val:=val div 10;
end;
if found then
begin
memo2.lines.add(inttostr(tot)+ format('  %6.1f seconds',[(now-starttime)*secsperday]));
        inc(foundcount);
end;
end;
    inc(loopcount);
if (loopcount mod 4096)=0 then
begin
countlbl.caption:= format('%6d tested in %6.1f seconds',[loopcount,(now-starttime)*secsperday]);
     application.processmessages;
end;
end;
  updatestats;
  screen.cursor:=crDefault; {back to standard cursor}
end;



{************************ BigIntsBtnClick *****************}
procedure TForm1.BigIntsBtnClick(Sender: TObject);
{Here's where we try BigInt processing with multiset approach. Could let us get to
 that 39 digit number. Too bad it's sooooo sloooow, 20 times slower than using
 Int64}
var
pwrs:array[0..9] of array [1..40] of TInteger;
  i,j,k,p:integer;
  tot:TInteger;
  found, done:boolean;
  starttime:TDateTime;
  maxreps:array [0..9] of integer;  {maximum occurences of a digit (0-9) before
                                     sum of powers gets too big}
work:TInteger;
{cn is an array of counts of occurrences of digits in the multiset.
      We don't really need the multisets, just counts of how many times
      each digit occurs.  Getnext generates counts in reverse order,
      i.e. cn[0] is the number of 9's in the set, cn[1] then number of 8's, etc.

   copycn is a reversed copy of cn used when checking if digits in sum match
      digits in the multiset.
  }
cn,copycn:array[0..9] of integer;
  start:integer;

function getnext(var d:array of integer; var start:integer):boolean;
var
xfr:integer;
begin
result:=true;
if d[start]>0 then
begin
dec(d[start]);
    inc(start);
If start<=high(d) then
begin
inc(d[start]);
      exit;
end
else
begin
dec(start);
      xfr:=1+d[start];
      d[start]:=0;
      dec(start);
while (start>=0) and (d[start]=0) do dec(start);
if start>=0 then
begin
if start<high(d) then
begin
dec(d[start]);
          inc(start);
          inc(d[start],xfr+1);
          exit;
end
else result:=false;
end
else result:=false;
end;
end
else result:=false;
end;

begin
screen.cursor:=crHourglass; {set busy cursor}
{initialization stuff}
initsearch('Big Integer');
  p:=updown1.position; {p=nbr of digits in nbrs}
for j:=0 to 9 do
begin
for k:=1 to 40 do pwrs[j,k]:=TInteger.create;
    pwrs[j,1].assign(j);
end;
{get the smallest possible sum of powers that contains p digits}
{compute the pth power of digits 0-9}
for k:=0 to 9 do for j:=1 to p-1 do pwrs[k,1].mult(k);
for j:= 1 to p do
begin
for k:=0 to 9 do
begin
pwrs[k,j].Assign(pwrs[k,1]);
      pwrs[k,j].mult(j);
end;
end;
  work:=tinteger.create;

{compute max repetitions for this power, before sum gets longers than original
   number}
for i:= 1 to 9 do
begin
j:=0;
    work.assign(0);
while (j<=p) and (length(work.digits)<=p) do
begin
work.add(pwrs[i,1]);
      inc(j);
end;
    maxreps[i]:=j-1;
end;
  maxreps[0]:=100; {no limit on max nbr of zeros in the number}
work.free;
  starttime:=now;
  tot:=TInteger.create;
  cn[0]:=p;
for i:=1 to 9 do cn[i]:=0;
  start:=0;

{Start main testing loop - finally}
while (tag=0) and getnext(cn,start) do
begin
done:=false;
for j:=low(cn) to high(cn) do
begin
if (cn[j]>maxreps[9-j]) then
begin
done:=true;
        break;
end;
end;
if not done then
begin
tot.assign(0);   {accumulate the sum of powers of the digits}
for j:=0 to 9 do
begin
if cn[j]>0 then tot.add(pwrs[9-j,cn[j]]);
if length(tot.digits)>p then
begin
done:=true;
          break;
end;
end;
end;
if not done then
begin
{If sum was too small (<p digits), all the rest will be even smaller, so stop}
if length(tot.digits)<p then tag:=1;

{see if all of the numbers in this power sum match the numbers in the mult-set}
found:=true;
{we need cn to generate next counts, so copy it over, reversed so 9's
        count is in the 9th position, etc. }
for i:=0 to 9 do copycn[9-i]:=cn[i];
for i:=0 to p-1 do
begin
if copycn[tot.digits[i]]= 0 then {oh-oh, no match for this digit}
begin  found:=false; break; end  {so stop checking}
else dec(copycn[tot.digits[i]]); {reduce count for matched digit}
end;
{done checking!  Did we find one?}
if found  then
begin
memo2.lines.add(tot.convertToDecimalString(true)
                   + format('%6.1f seconds',[(now-starttime)*secsperday]));
        inc(foundcount);
end;
end;
    inc(loopcount);
if (loopcount mod 4096)=0 then
begin
countlbl.caption:= format('%6d tested in %6.1f seconds',[loopcount,(now-starttime)*secsperday]);
     application.processmessages;
end;
end; {end main loop}
updatestats;
  screen.cursor:=crDefault; {back to standard cursor}
for j:=0 to 9 do  for k:=1 to 40 do pwrs[j,k].free;
  tot.free;
end;

{***************** SearchAllBtnClick *************}
procedure TForm1.SearchAllBtnClick(Sender: TObject);
var i:integer;
    starttime:TTime;
    cumcount:integer;
begin
tag:=0;
  starttime:=now;
  cumcount:=0;
for i:= 1 to 39 do
begin
if tag<>0 then break;
    updown1.position:=i;
if i<=19 then multisetsbtnclick(sender)
else bigIntsBtnClick(Sender);
    cumcount:=cumcount+foundcount;
    memo2.lines.add('Time so far (hh:mm:s) '+ formatdatetime('hh:nn:ss', now-startTime)
                   + ', Total # found so far: '+ inttostr(cumcount));
end;

end;

{******************** StopBtnClick *************}
procedure TForm1.StopBtnClick(Sender: TObject);
begin
tag:=1;{program loops will check for this value to abort processing}
end;

{*************** FormCloseQuery ****************}
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
tag:=1; {stop any running calculations if users wants to close}
canclose:=true;
end;

{*********************** InitSearch ****************}
procedure TForm1.initsearch(typestr:string);
{Common search initialzation stuff}
begin
starttime:=now;
  loopcount:=0;
  foundcount:=0;
  tag:=0;
  memo2.lines.add('');
  memo2.lines.add(typestr+ ' search for numbers of size '+inttostr(updown1.position));
end;

{****************** UpdateStats *************}
procedure TForm1.updatestats;
var  r:real;
{Display statistics at end of a search}
begin
r:=(now-starttime)*secsperday;
if r>0 then
countlbl.caption:=format('%3d found, %6d tested in %6.1f seconds, Rate: %8.1f',
                      [foundcount, loopcount,r, loopcount/r])
else countlbl.caption:=format('%3d found, %6d tested in %6.1f seconds',
               [foundcount, loopcount,r]);
  memo2.lines.add(countlbl.caption);
end;

{************************** MakeCaption ******************}
procedure TForm1.makecaption(leftSide, Rightside:string);
var
Metrics:NonClientMetrics;
  captionarea,spacewidth,nbrspaces:integer;
  b:TBitmap;
begin
b:=TBitmap.create;  {to get a canvas}
metrics.cbsize:=sizeof(Metrics);
if SystemParametersInfo(SPI_GetNonCLientMetrics, sizeof(Metrics),@metrics,0)
then  with metrics   do
begin
b.canvas.font.name:=Pchar(@metrics.LFCaptionFont.LfFaceName);
with metrics.LFCaptionFont, b.canvas.font do
begin
height:=LFHeight;
if lfweight=700 then style:=[fsbold];
if lfitalic<>0 then style:=style+[fsitalic];
end;
{subtract 3 buttons + Icon + some border space}
captionarea:=clientwidth-4*iCaptionwidth-4*iBorderWidth;;
{n = # of spaces to insert}
spacewidth:=b.canvas.textwidth(' ');
    nbrspaces:=(captionarea-b.canvas.textwidth(Leftside + Rightside)) div spacewidth;
if nbrspaces>3 then caption:=LeftSide+stringofchar(' ',nbrspaces)+RightSide
else caption:=LeftSide+' '+RightSide;
end;
  b.free;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
makecaption('T-Shirt #2 (XXL Version)', #169+' 2001, G. Darby, www.delphiforfun.org');
end;

end.