You appear to be making some of the mistakes the author said you needed to avoid - namely, you aren't really cutting down your search space.

You're still performing all these checks on every single number; it would be better to only form the numbers that pass the checks mentioned in comments at the top, rather than to form all numbers and then reject those that fail. Not only that, but you're doing some stuff that doesn't make sense - you could replace your check code with this routine and it would still accept/reject the same numbers but would be tons faster:

sub passes {
    my $test_number = shift() || die "no test number";
    return 0 if ($test_number =~ /0/);        # no zero
    return 0 if ($test_number =~ /(.).*\1/);  # no dups
    for ( split(//,$test_number) ) {
        return 0 unless $test_number % $_ == 0 ;
    }
    return 1;
}
[download]

The check about 5 and even numbers is redundant by the point you do it, since if it has 5 and an even number then it either has a 0 or will be rejected by the divisibility test.

So what you need to do is cut down on the number of possibilities to begin with. Say, something like this:

use strict;

sub pass_divcheck { # dups and 0s are assumed already handled
  my ($test_number) = @_;
  for ( split(//,$test_number) ) {
    return 0 unless $test_number % $_ == 0 ;
  }
  return 1;
}

sub form_number {
  my ($num, @remaining_digits) = @_;
  print "$num\n" if pass_divcheck($num);

  # When dealing with the three low-order digits, we can eliminate som
+e
  # possibilities.  E.g. Any number divisible by 4 must end in a 2-dig
+it
  # number divisible by 4.
  my $ndig = length($num);
  if ($ndig == 1) {
    if ($num % 2 != 0) {
      @remaining_digits = grep($_ % 2, @remaining_digits);
    }
    # After we have one digit, either 5 is already used or we
    # can't use 5 later anyway
    @remaining_digits = grep($_ % 5, @remaining_digits);
  } elsif ($ndig == 2) {
    if ($num % 4 != 0) {
      @remaining_digits = grep($_ % 4, @remaining_digits);
      return if ($num =~ /[48]/);
    }
  } elsif ($ndig == 3) {
    if ($num % 8 != 0) {
      @remaining_digits = grep($_ % 8, @remaining_digits);
    }
  }
  my $maxp = $#remaining_digits;
  foreach my $p (0..$maxp) {
    form_number($remaining_digits[$p] . $num,
                @remaining_digits[0..$p-1], @remaining_digits[$p+1..$m
+axp]);
  }
}

form_number('', (1..9));
[download]

Note that this code won't print the answers out in numerical order. You'll have to sort them with something else.

Update: Got rid of some extraneous code that doesn't add much since the answers don't get generated in numerical order anyway.

@/=map{[/./g]}qw/.h_nJ Xapou cets krht ele_ r_ra/;
map{y/X_/\n /;print}map{pop@$_}@/for@/
[download]

I must say, I'm a bit surprised by the times other people are getting - as written above, my program takes about 1 second on my relatively underpowered laptop. (1.3 Ghz Pentium something, 512 MB ram)

Even if you simplify my program down by removing both "elsif" blocks you're only up to about 2.5 seconds. Removing the "if ($ndig == 1)" block does bring you up to 34 seconds.

--


@/=map{[/./g]}qw/.h_nJ Xapou cets krht ele_ r_ra/;
map{y/X_/\n /;print}map{pop@$_}@/for@/
[download]

As noted by others, if the answer includes a 5 it must end in 5, which would preclude all of 2, 4, 6 and 8.

However you may also spot that the digits 12346789 do not have a sum divisible by 3, so we must lose a 1, 4 or 7 to avoid losing all of 3, 6 and 9. Of those, only 4 leaves us a digit sum divisible by 9, so if a 7-digit solution is possible it must consist of 1236789.

The gcd of those digits is 7*8*9 = 504, so we can start at 504 * int(9876321/504), and work down in steps of 504 until we find a multiple that consists of the right set of digits; as it turns out, just 17 such steps take us to the answer, and we could reasonably do that much by hand (though I didn't :).

Hugo

This was my take too. Since we start with an even number, and subtract an even number, we don't have to worry about ending in an odd digit. Since we know that all allowed digits will divide any multiple of 504, we don't even test for that.

Here's the code I wrote (somewhat inspired by previous posts):

#!/your/perl/here

use strict;
use warnings;

use Benchmark::Timer;
my $t = Benchmark::Timer->new();
$t->start();

my $c = 7*8*9;
my $x = $c * int(9876321/$c);
my $steps = 0;

while ($x > 0)
{
    next if $x =~ /[05]/; # no 0 or 5
    next if $x =~ /([1-9]).*\1/; # no repeated digits
    last;
}
continue
{
    $x -= $c;
    $steps++;
}
$t->stop();
print "$x ($steps steps)\n";
print $t->report();

__OUTPUT__
9867312 (17 steps)
1 trial of _default (64us total)
[download]

-QM
--
Quantum Mechanics: The dreams stuff is made of

I'd be very surprised if that is the largest. I'm sure it is among the longest. But I'd bet money that the largest starts with a 9, and I'd bet a lot of money that it doesn't start with a 1. Update: I didn't notice it was only 7 digits until I wrote a short script that showed that there is no 9-digit answer, which surprised me -- but it's too early for clear thinking ATM :). I should have noted that I looked at the code and it doesn't appear to look for the largest answer, just the first answer that it finds (and it doesn't look at the possible answers from largest to smallest).

Update2: And here is the quick hack showing the first block that failed to find any 9-digit answer and then an added block to find the answer. Note that this code searches the potential solutions in order from largest to smallest so it can stop as soon as one answer is found. It isn't particularly fast to run (taking 14 seconds), but it was very fast to write. (:

use Algorithm::Loops qw( NextPermuteNum );

my @digs= (1..9);
my @map;
@map[1..9]= reverse 1..9;
do {
    my $num= join '', @map[ @digs ];
    for( 9, 8, 7, 5, 0 ) {
        die "$num\n"   if  ! $_;
        last   if  0 != $num % $_;
    }
} while( NextPermuteNum(@digs) );

my $prev= 0;
for my $len ( reverse 1..8 ) {
    do {
        my $num= substr( join( '', @map[ @digs ] ), 0, $len );
        if( $num != $prev ) {
            for( $num =~ /./g, 0 ) {
                die "$num\n"   if  ! $_;
                last   if  0 != $num % $_;
            }
        }
        $prev= $num;
    } while( NextPermuteNum(@digs) );
}
[download]

- tye        

tye,
I borrowed Algorithm::Loops for the following brute-force approach:

#!/usr/bin/perl
use strict;
use warnings;
use Algorithm::Loops qw/NestedLoops NextPermute/;

my $max = 1;
my $next = GenPowerSet(9);

while ( my @list = $next->() ) {
    PERMUTE:
    while ( NextPermute(@list) ) {
        my $num = join '', @list;
        next PERMUTE if $num < $max;
        for ( @list ) {
            next PERMUTE if $num % $_;
        }
        $max = $num if $num > $max;
    }
}
print $max;

sub GenPowerSet {
    my $end = shift;
    return NestedLoops(
        [
            [ 1..$end ],
            ( sub {
                [ $_+1 .. $end ]
            } ) x $end,
        ],
        { OnlyWhen => 1, },
    );
}
[download]

It came up with 9_867_312 in about 30 seconds.

Cheers - L~R

Note that you can cut the time in half or there abouts by adding just two simple checks; this version of your program runs in 6.1 seconds on my machine - the original without the initial 9-digit loop takes 13 seconds on my machine:

use Algorithm::Loops qw( NextPermuteNum );

my @digs= (1..9);
my @map;
@map[1..9]= reverse 1..9;

my $prev= 0;
for my $len ( reverse 1..8 ) {
    do {
        my $num= substr( join( '', @map[ @digs ] ), 0, $len );
        if( $num != $prev and $num !~ /[2468].*[13579]$/ and $num !~ /
+5./) {
            for( $num =~ /./g, 0 ) {
                die "$num\n"   if  ! $_;
                last   if  0 != $num % $_;
            }
        }
        $prev= $num;
    } while( NextPermuteNum(@digs) );
}
[download]

Note that all I've done is add two regex tests - that you don't have any even digits if the last digit is odd, and that you never have a 5 in any but the last position.

Reducing the search space is almost always a good idea.

--


@/=map{[/./g]}qw/.h_nJ Xapou cets krht ele_ r_ra/;
map{y/X_/\n /;print}map{pop@$_}@/for@/
[download]

If it's the longest it's also the largest given the fact that (leading) zeroes are not allowed.

OTOH: It's neither ;-)

---

s$$([},&%#}/&/]+}%&{})*;#$&&s&&$^X.($'^"%]=\&(|?*{%
+.+=%;.#_}\&"^"-+%*).}%:##%}={~=~:.")&e&&s""`$''`"e

Some minor changes to your code results in 9867312. Took my P4 3.2 w/4GB about 9.3 seconds to run it.

Read more... (873 Bytes)

Ahh! I see the error. If I had both 4 and 2, but not 8, I was requiring the divisor to be a multiple of 8. Good catch!

---

My criteria for good software:

1. Does it work?
2. Can someone else come in, make a change, and be reasonably certain no bugs were introduced?

No it's not. Try my program. (which spits out all the answers in under 1.5 seconds)

As proof that yours isn't the largest, consider 9231768 (also not the largest):

$ bc -l
bc 1.06
Copyright 1991-1994, 1997, 1998, 2000 Free Software Foundation, Inc.
This is free software with ABSOLUTELY NO WARRANTY.
For details type `warranty'.
9231768 / 8
1153971.00000000000000000000
9231768 / 9
1025752.00000000000000000000
9231768 / 7
1318824.00000000000000000000
[download]

(The other digits follow as a consequence, or you can check them yourself)

--


@/=map{[/./g]}qw/.h_nJ Xapou cets krht ele_ r_ra/;
map{y/X_/\n /;print}map{pop@$_}@/for@/
[download]

Clever simplification. If the number is divisible by 9,8,7, and 5, then it must also be divisible by 4,3,2, and 1. At first I thought you forgot about the divide by 5 test, but the I saw that your number doesn't contain 5. Clever!

I used Math::Combinatorics for both parts and a slight modification of the original test to get the answer (9867312) in less time than it takes to make a coffee...

use strict;
use warnings;

use Math::Combinatorics;
my @n = qw(1 2 3 4 6 7 8 9);

my $found;
foreach my $count (reverse (1..@n))
{
    my $combinat = Math::Combinatorics->new(count => $count, data => [
+@n],);
    my @comb;
    while (@comb = $combinat->next_combination())
    {
        my @permu;
        my $permute = Math::Combinatorics->new(data => [@comb]);
        while (@permu = $permute->next_permutation())
        {
            if (passes(@permu))
            {
                print "@permu\n";
                $found++;
            }
        }
    }
    
    exit if $found;
}

sub passes {
    my $test_number = join '', @_;
    for ( @_ ) {
        return 0 unless $test_number % $_ == 0 ;
    }
    return 1;
}
[download]

update I have modified my original code taking the 5 out of the possible numbers and paring down the test as much as possible. This now runs much faster.

Hmm, I'm impressed by the code, and will be poring over those cool modules you used to try to understand what you did, but I finally gave in and googled around, and the answer appears to be more along the lines of what tye said.

Now solve it again in hex instead of base 10...

use strict;
use Algorithm::Loops qw( NextPermute );

$|= 1;
my %map;
@map{1..9,'a'..'f'}= reverse 1..9,'a'..'f';
my @digs= reverse 1..9,'a'..'f';

sub Biggest {
    my( $len, @toks )= @_;
    do {
        my $hex= join '', @map{ @toks[0..$len-1] };
        my $num;
        if( $len <= 8 ) {
            $num= hex $hex;
        } else {
            $num= hex substr( $hex, 0, 7 );
            $num *= 16   for  9..$len;
            $num += hex substr( $hex, 8, -1 );
        }
        for( $hex =~ /./g, 0 ) {
            if(  ! $_  ) {
                print "$hex\n";
                return;
            }
            last   if  0 != $num % hex($_);
        }
        @toks[ $len .. $#toks ]= reverse @toks[ $len .. $#toks ]
            if  $len < $#toks;
    } while( NextPermute(@toks) );
    @toks= @map{ @toks };
    print "No solution for $len of hexits: @toks\n";
}

for my $len ( 1..@digs ) {
    Biggest( $len, @map{ @digs } );
}
[download]

Update2: And, in CODE tags inside of HTML comments is the output. The prior silly code that didn't realize that 5*2 isn't "10" in hex can also be grabbed via "select code-to-download".

Threads don't magically enhance the power of a processor. If you only have one processor, and it's not sleeping while some device is slow to respond, then it can't suddenly get any more effective by spinning off multiple threads.

Threads are useful for performance only when various parts of the process must sleep to await further data, but other parts of the process can continue to produce those data.

Threads are useful for design because they let you segment out the problem into loosely-coupled components, and you don't have to design a time-slicing pump to accomplish it.

#!/usr/bin/perl
use strict;
use warnings;

my @digits= qw(9 8 7 6 5 4 3 2 1);
my $max= 0;

permut('', @digits);
print "Solution: $max\n";

sub permut {
    my ($s, @digits)= @_;
    my $i= scalar @digits;
    DIV: {
        { no warnings;
            last DIV if $s<$max;
        }
        foreach my $i (split //m,$s) {
            last DIV if $s % $i;
        }
        print "$s\n";
        $max=$s;
    }
    if ($i) {
        while ($i--) {
            my $f= shift @digits;
            permut($s.$f, @digits);
            push(@digits, $f);
        }
    }
}
[download]

My solution and the time needed on a 900MHz Power PC G3 with 640MB and lot's of Java running in the background ;-) is:

9867312
real 2m14.144s
user 0m32.100s
sys 0m0.730s

sub perms {
    return () unless @_;
    my ($car, @cdr) = @_;
    # All permutations that do not include car
    my @cdr_perm = perms(@cdr);
    # All permutations that include car
    my @car_perm = map {
      my $this_perm = $_;
      map {
        substr($this_perm, 0, $_) . $car . substr($this_perm, $_)
      } 0..length($this_perm)
    } (@cdr_perm);
    (@car_perm, @cdr_perm, $car);
}

my $max = 0;
OUTER:
for my $num (perms(reverse(1..4,6..9)), perms(9,7,5,3,1)) {
    next unless $num > $max;
    my @digits = split //, $num;
    $num % $_ > 0 and next OUTER for @digits;
    print "$num is divisible by all of @digits\n";
    $max = $num;
}

print "Biggest found is $max\n";
[download]

Trying 9867312...Success!!
9867312 / 9 = 1096368
9867312 / 8 = 1233414
9867312 / 6 = 1644552
9867312 / 7 = 1409616
9867312 / 3 = 3289104
9867312 / 1 = 9867312
9867312 / 2 = 4933656

real    384m53.120s
user    382m59.960s
sys     0m14.600s
[download]

Arggh, I went to fix a bug and accidentally deleted the whole post.

No need for modules

use strict;
use warnings;

my $limit = 987654321;
my $magic_num = 9 * 8 * 7;
my $max = int ($limit / $magic_num);
my $start = $max * $magic_num;

for (0..$max - 1){
    my $num = $start - $magic_num * $_;
    next if $num =~ /[05]/;
    next if $num =~ /(.).*\1/;
    die "$num\n"
}
[download]

#!/usr/bin/perl -w
#
# See http://perlmonks.org/?node_id=503317, Oct 27 2005
# Jim Mahoney (mahoney@marlboro.edu)
#
use strict;
use warnings;
use Algorithm::FastPermute qw(permute);
use Math::Combinatorics qw();

my $debug = 0;
my $largest = 0;
my @solutions;
my $start_time = time();

print "
 What is the largest integer whose digits are all different 
 (and do not include 0) that is divisible by each of its individual di
+gits?
 Working...
";

for my $n (reverse 1..9){
  my $c = Math::Combinatorics->new( count=>$n, data=>[1..9] );
  while (my @array = $c->next_combination){
    permute { remember(@array) if is_solution(@array) } @array;
  }
}
@solutions = sort @solutions;

print "
 Done in " . (time()-$start_time) . " seconds.
 Total number of solutions found is " . scalar(@solutions) . ".
 Largest is " . $solutions[-1] . ".
";

sub remember {
  my @digits = @_;
  push @solutions, join('',@digits);
}

sub is_solution {
  my @digits = @_;
  my $number = 0+join('',@digits);
  for my $digit (@digits){
    return 0 if $number % $digit != 0;
  }
  return 1;
}

__END__


$ ./n_digits_divide.pl 

 What is the largest integer whose digits are all different 
 (and do not include 0) that is divisible by each of its individual di
+gits?
 Working...

 Done in 6 seconds.
 Total number of solutions found = 548.
 Largest found was 9867312.
[download]

Mine is very slow, but short. I wrote it before reading the rest of the thread. I figured that we knew the answer had at most 8 characters, as it couldn't have both 2 and 5, so I counted down from the largest 8-different-digit number, guessing the answer would be closer to the top than the bottom. I realized that checking both 9, 8, 6 and their divisors was a waste, but guessed that the logic to exclude those would outweigh the extra modulos.

LOOP: for (my $i = 98765432; $i > 0; $i--) {
  next if $i =~ /0/ or $i =~ /(\d)\d*\1/;
  $i % $_ and next LOOP for split '', $i;
  print "$i\n";
  exit;
}
[download]

Updated: Re-worded the last sentence to correct a word-processing-o.

This is based on what you did, except it prints out a status bar for "time remaining." Well, actually not a status bar. Just something along the lines of

On 22000000. Minutes required: 0.718182
On 21000000. Minutes required: 0.683761
On 20000000. Minutes required: 0.645359
On 19000000. Minutes required: 0.611250
........
[download]

I think I liked yours the best because it was the closest in spirit to my, even slower, initial attempt. Cheers :)

use strict;
use warnings;

my $start = 98765432;

my $start_time = time;
my $div = 1000000;
my $max_tries = ( ( $start - ( $start % $div) ) / $div ); 
my $tries;

LOOP: for (my $i = $start; $i > 0; $i--) {
  if ( $i % $div == 0 ) {
        $tries++;
        my $tries_remaining = $max_tries - $tries;    #print "tries re
+maining: $tries_remaining\n";
        my $seconds_per_tries = ( time() - $start_time ) / $tries;
        my $estimated_minutes_to_completion = $seconds_per_tries * $tr
+ies_remaining / 60;
        
        $estimated_minutes_to_completion = sprintf ( "%2f", $estimated
+_minutes_to_completion );
        
        print "On $i. Minutes required: $estimated_minutes_to_completi
+on\n"; 
  }
  next if $i =~ /0/ or $i =~ /(\d)\d*\1/;
  $i % $_ and next LOOP for split '', $i;
  print "$i\n";
  exit;
}
[download]