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.
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 ];
}
}
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 vampir ish 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.
Can you do better?
Update: Small copy/paste correction
Re: Vampire Numbers Revisited by inman (Curate) on Mar 23, 2005 at 22:04 UTC 
On a related theme, the latest issue of Computer Weekly (a UK publication) includes a puzzle along similar lines.
Take a number such as 2025. Break it in half to give 20 and 25. Add the numbers together and find that the result is the square root of the original number. The challenge is to find the six digit number that fits the criteria. Note that 998001 is considered 'cheating' because of the leading zeroes on 001
My solution as follows:
#! /usr/bin/perl w
use strict;
use warnings;
foreach my $first (100..999)
{
foreach my $second (100..999)
{
if (($first + $second)**2 == $first . $second)
{
print "$first + $second = ", $first + $second, " (", $first . $
+second, ")\n";
}
}
}
 [reply] [d/l] 

I went from the other direction: Look at only the squares in the range:
use strict;
use warnings;
use POSIX 'ceil';
my $digits = 6;
my $fd = $digits/2;
my ($lo, $hi) = ((9 x ($digits1))+1, 9 x $digits);
for my $sqrt (ceil(sqrt $lo) .. int(sqrt $hi)) {
my $prod = $sqrt * $sqrt;
next if substr($prod, $fd, 1) eq '0';
my ($f1, $f2) = (substr($prod, 0, $fd), substr($prod, $fd));
print "$f1 + $f2 = $sqrt, the root of $prod\n" if $f1 + $f2 == $sqrt
+;
}
Caution: Contents may have been coded under pressure.
 [reply] [d/l] 

Here is a far faster solution:
#! /usr/bin/perl w
use strict;
my $length = shift  6;
unless ($length =~ /^\d*[02468]\z/) {
die "Length must be an even number";
}
$length /= 2;
my $low = join '', 1, map 0, 2..$length;
my $high = join '', map 9, 1..$length;
for my $first ($low..$high) {
my $last = int(sqrt($first.$low))  $first;
$last = $low if $last < $low;
my $square = ($last + $first)*($last + $first);
while ($square < $first . $last and $last <= $high) {
$last++;
$square = ($last + $first)*($last + $first);
}
if ($last <= $high and $square == $first . $last) {
print "$first$last\n";
}
}
On my system the main execution time seems to be the time to load Perl. It can find both answers of length 10 in under a second.  [reply] [d/l] 
Re: Vampire Numbers Revisited by sh1tn (Priest) on Mar 23, 2005 at 22:55 UTC 
I am not quite sure which are Vampire Numbers ... :
for ( 1 .. 700000 ){
is_vamp( $_ ) and print $_,$/
}
sub is_vamp {
$_ = shift;
my$l = (length( $_ ))/2;
/(\d{$l})(\d{$l})/ or return;
((reverse$1)*$2 == $_) ? 1 : 0
}
__END__
1260
1435
1530
6880
102510
104260
105210
108135
152608
156240
182650
629680
 [reply] [d/l] 
Re: Vampire Numbers Revisited by Roy Johnson (Monsignor) on Mar 23, 2005 at 23:06 UTC 
Using a trick from the web site you linked to, this runs very quickly to get the 7 4digit vampire numbers. $digits is the length of the factors; set it to 3 and it got the 6digit numbers in a reasonable time, too (939658 = 986 * 953, for the largest example).
my $digits = 2;
my @mods;
for ([0,0],[2,2],[3,6],[5,8],[6,3],[8,5]) {
$mods[$_>[0]] = $_>[1];
}
my $min_factor = 1 . (0 x ($digits1));
for my $a ($min_factor .. (9 x $digits)) {
if (defined $mods[$a % 9]) {
for (my $b = $min_factor  1 + ($mods[$a % 9]9); $b <= $a; $
+b += 9) {
my $prod = $a * $b;
my $fdigits = join '', sort map {split //} $a, $b;
my $pdigits = join '', sort split //, $prod;
if ($pdigits eq $fdigits) {
print "$a * $b = $prod\n";
}
}
}
}
Update: better way of excluding short factors.
Caution: Contents may have been coded under pressure.
 [reply] [d/l] 

I made an optimized version based on some of the suggestions on the web site, such as storing the digit counts in bit fields, unrolling the inner loop, and making use of caching.
It can find the 112,025 tendigit vampire numbers (duplicated values included) in about an hour and a half on my machine. Since the problem takes about 100 times longer with each digit, going any higher would probably take recoding the inner loops in C.
Note: because of the possibility of overflow in the 3bit digit bins, there may be some false positives  they should be screened out with another script. I found none when I tried this.
 [reply] [d/l] 
Re: Vampire Numbers Revisited by blazar (Canon) on Mar 24, 2005 at 07:49 UTC 
<OT WRT="Perl">
Personally I'm not particularly keen on problems of this kind having to do with the decimal expansion of numbers. Whatever, if you find any interesting sequence you may consider submitting to the OEIS; of course after verifying it's not already there. Searching for "vampire" already returns quite a lot of hits.
<\OT>  [reply] 
Re: Vampire Numbers Revisited by Anonymous Monk on Mar 24, 2005 at 09:23 UTC 
 [reply] 
Re: Vampire Numbers Revisited by jbware (Chaplain) on Mar 24, 2005 at 18:59 UTC 
Inspired by the short work week (for me at least), I decided to golf a solution. This is a combined inspiration from Limbic~Region's, inman's, and Roy Johnson's solutions, as well as some of my own trickery. It takes a parameter (length of vampire #). Ex: 4 would find all the 4 digit vampire numbers (and display their related factors). Excluding leading line spaces and endlines I got it down to 185 chars. Enjoy.
$z=$ARGV[0]/2;
for$a(1..10**$z1){
for($a..10**$z1){
print$a*$_." $a $_\n"if((join('',sort split'',$a*$_) eq join('
+',sort split'',"$a$_"))&&(length($a*$_)==$z*2)&&($a%10!=0$_%10!=0))
+;
}
}
 [reply] [d/l] 

First of all you have a bug, you're excluding the possibility that the two factors both end in 0 for no apparent reason. If I elminate that and use standard golfing techniques (plus the mathematical fact that if $a or $_ is 10**$z then you can't possibly satisfy the fang condition) I get down to 126 by usual golf counting rules (less by yours, but the returns all matter!):
$z=pop()/2;for$a(1..10**$z){sub a{join"",sort
pop=~/./g}$,=$a*$_,a($a.$_)!=a$,or$z*2>length$,or
print"$, $a $_
"for$a..10**$z}
Note that $, is used rather than a more normal variable name because it lets me remove one space.
I'll give better than even odds that someone else can cut out another character still. (Assuming that the right someone else tries...)
Update: I realize now that you're looking for true vampire numbers and not vampire numbers. Golfing that I get 140 characters with:
$z=pop()/2;for$a(1..10**$z){sub a{join"",sort
pop=~/./g}$,=$a*$_,a($a.$_)!=a$,or$z*2>length$,or($a%10+$_%10)&&print"
+$, $a $_
"for$a..10**$z}
Update 2: I did a meaningless code rearrangement to make the longest line shorter.  [reply] [d/l] [select] 

Nice++ In retrospect I should've mentioned the goal of true vampire numbers. I thought I was being thorough regarding the definition, but not mentioning that part of the spec was my bad.
jbWare
 [reply] 

