Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things

Vampire Numbers Revisited

by Limbic~Region (Chancellor)
on Mar 23, 2005 at 21:05 UTC ( #441887=perlquestion: print w/replies, xml ) Need Help??
Limbic~Region has asked for the wisdom of the Perl Monks concerning the following question:

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 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 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.

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
    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"; } } }
      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 +; }

      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"; } }
      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.
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 4-digit vampire numbers. $digits is the length of the factors; set it to 3 and it got the 6-digit 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 ($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"; } } } }
    Update: better way of excluding short factors.

    Caution: Contents may have been coded under pressure.
      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.

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

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
    <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.
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**$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)) +; } }
      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.
        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.


Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://441887]
Approved by Zaxo
Front-paged by perlfan
[talexb]: Hmm. Trying to figure out how to trigger the author tests. This talks about .author in ./inc, but that doesn't seem to do the trick.
LanX sigh ... pitty I'm not a girl ... missing out on so many things
LanX ... or is it "boying out" ?
[choroba]: RELEASE_TESTING=1 for Module::Starter based distributions
LanX ..."mistering out" ?
[talexb]: choroba AH! Thanks so much.

How do I use this? | Other CB clients
Other Users?
Others musing on the Monastery: (11)
As of 2017-10-23 14:21 GMT
Find Nodes?
    Voting Booth?
    My fridge is mostly full of:

    Results (279 votes). Check out past polls.