Limbic~Region has asked for the wisdom of the Perl Monks concerning the following question:
All,
YuckFoo stated in Vampire Numbers that A Vampire Number is equal to a product of it's digits like 1435 = 41 * 35 and later on mused that ...it would be interesting to look for products of more than two factors.
It would be easy to remove the length() requirement and change out the combo() sub to iterate over the powerset using this code to find vampirish numbers with more than 2 fangs (or odd shaped fangs). It also appears that there are mathematical properties that would lead to shortcuts, but decided to leave that as an exercise for the reader.
YuckFoo stated in Vampire Numbers that A Vampire Number is equal to a product of it's digits like 1435 = 41 * 35 and later on mused that ...it would be interesting to look for products of more than two factors.
Wanting to confirm my solution was producing accurate results before posting, I hunted for a list of vampire numbers on the web and soon discovered that this definition was wrong. According to this, a more accurate definition would be:
A number N where 2 factors of N of equal length whose combined digits comprise all the digits of N whose product equals N.
Apparently, the name comes from the two fangs and not book. With the following code, I was able to find all 4 digit vampire numbers in 4 seconds.
#!/usr/bin/perl use strict; use warnings; use Math::Pari qw/:int factorint divisors/; for ( 1 .. 7000 ) { print "$_\n" if is_vamp( $_ ); } sub is_vamp { my $num = shift; my @factors = grep {$_ !~ /[^$num]/} divisors(factorint($num)) =~ +/(?<=\d)\D+(\d+)(?=\D+\d+)/g; return 0 if @factors < 2; my $srt = join '', sort split //, $num; my $iter = combo( 2, @factors ); while ( my ($x, $y) = $iter->() ) { next if length $x != length $y || (join '', sort split //, $x +. $y) ne $srt; return 1 if $x * $y == $num; } return 0; } sub combo { my $by = shift; return sub { () } if ! $by || $by =~ /\D/ || @_ < $by; my @list = @_; my @position = (0 .. $by - 2, $by - 2); my @stop = @list - $by .. $#list; my $end_pos = $#position; my $done = undef; return sub { return () if $done; my $cur = $end_pos; { if ( ++$position[ $cur ] > $stop[ $cur ] ) { $position[ --$cur ]++; redo if $position[ $cur ] > $stop[ $cur ]; my $new_pos = $position[ $cur ]; @position[ $cur .. $end_pos ] = $new_pos .. $new_pos + + $by; } } $done = 1 if $position[0] == $stop[0]; return @list[ @position ]; } }
Can you do better?
Cheers - L~R
Update: Small copy/paste correction
|
---|
Replies are listed 'Best First'. | |
---|---|
Re: Vampire Numbers Revisited
by inman (Curate) on Mar 23, 2005 at 22:04 UTC | |
by Roy Johnson (Monsignor) on Mar 23, 2005 at 23:55 UTC | |
by tilly (Archbishop) on Mar 25, 2005 at 02:38 UTC | |
Re: Vampire Numbers Revisited
by Roy Johnson (Monsignor) on Mar 23, 2005 at 23:06 UTC | |
by tall_man (Parson) on Mar 24, 2005 at 20:17 UTC | |
Re: Vampire Numbers Revisited
by sh1tn (Priest) on Mar 23, 2005 at 22:55 UTC | |
Re: Vampire Numbers Revisited
by Anonymous Monk on Mar 24, 2005 at 09:23 UTC | |
Re: Vampire Numbers Revisited
by blazar (Canon) on Mar 24, 2005 at 07:49 UTC | |
Re: Vampire Numbers Revisited
by jbware (Chaplain) on Mar 24, 2005 at 18:59 UTC | |
by tilly (Archbishop) on Mar 25, 2005 at 04:08 UTC | |
by jbware (Chaplain) on Mar 25, 2005 at 15:10 UTC |
Back to
Seekers of Perl Wisdom