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";
    }
  }
}
[download]

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 ($digits-1))+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
+;
}
[download]

---

Caution: Contents may have been coded under pressure.

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";
  }
}
[download]

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.

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 ($digits-1));

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";
            }
        }
    }
}
[download]

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 ten-digit 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 3-bit digit bins, there may be some false positives -- they should be screened out with another script. I found none when I tried this.

Read more... (2 kB)

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
[download]

$z=$ARGV[0]/2;
for$a(1..10**$z-1){
    for($a..10**$z-1){
        print$a*$_." $a $_\n"if((join('',sort split'',$a*$_) eq join('
+',sort split'',"$a$_"))&&(length($a*$_)==$z*2)&&($a%10!=0||$_%10!=0))
+;
    }
}
[download]

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}
[download]

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}
[download]

Update 2: I did a meaningless code rearrangement to make the longest line shorter.

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