#!/usr/bin/perl
#
#  relatively non-optimal CPU time-waster that
#  will count all optimal packings for
#  a digit sequence that must contain each
#  of '00'..'99' at least once, assuming
#  that leading zeroes are not permitted
#
#  (theoretical lower limit on length =101)
#
#  accepts three optional args, in this order:
#
#    start value          -- defaults to '1'
#
#    initial count        -- defaults to 0
#
#    notification counter -- spit out a message on stderr every
#                            time the counter hits a multiple of this,
#                            along with the matching value, just
#                            to show we're still alive
#                            -- defaults to 1,000,000, which is
#                               probably way too low to avoid filling
#                               a disk up with output before the count is done
#				(although we might reach the end of the 
#				 universe before then anyway)
#
#   note that if you provide a complete solution as the restart value,
#   the program declares success and quits, so don't do that --
#   omit the last digit and it'll carry on  
#   -- it's not a bug, it's a way of saving you from yourself
#
#   note also that, if the total number of solutions exceeds
#   the precision storable in a perl number (and I think it will),
#   then this program will get the wrong answer anyway, because ++$count
#   will eventually fail 
#   -- it's not a bug, it's proof that you shouldn't have left this
#      program running in the first place
#
#
#  eked out one dozy morning by
#    Frank Wales (frank@limov.com)
#

      $start=$ARGV[0] || 1;
      $count=$ARGV[1] || 0;
$notifyevery=$ARGV[2] || 1000000;   # make this 1, and you'll get every number 

$current=''.$start;

foreach $i (0..99) {
    $maybe=sprintf('%02d',$i);
    $available{$maybe}=1 unless $current=~/$maybe/;
}

NEXTDIGIT:
while (scalar(keys %available)) {
    $lastdigit=substr($current,length($current)-1,1);

    foreach $try (0..9) {
	next unless $available{$lastdigit.$try};

	$current.=$try;

	delete($available{$lastdigit.$try});

	next NEXTDIGIT if (scalar(keys %available));

	++$count;

	print STDERR "$count: $current\n" unless $count % $notifyevery;

	last;
    }

    do {
	$currentlength=length($current);

	$lastpair=substr($current,$currentlength-2,2);
	$current =substr($current,0,$currentlength-1);

	$available{$lastpair}=1;

	$lastdigit  =substr($lastpair,0,1);

	foreach $try (substr($lastpair,1,1)+1..9) {
	    next unless $available{$lastdigit.$try};

	    $current.=$try;

	    delete($available{$lastdigit.$try});

	    next NEXTDIGIT;
	}

    } while (length($current)>1);

    if ($count) {
      print "Total optimal solutions: $count\n";
      exit(0);
    }
    else {
      print STDERR "No optimal solution for Start: $start\n";
      exit(1);
    }
}

print "Start value is already finished, nothing to search for.\n";
exit(0);
