[Richard Suchenwirth] 2012-11-01 - It has been a long time since my last fun project, but on the day after Halloween, which is a holiday in my part of the country, I finally did it again - some code to research vampire numbers.

"In mathematics, a vampire number (or true vampire number) is a composite natural number v, with an even number of digits n, that can be factored into two integers x and y each with n/2 digits and not both with trailing zeroes, where v contains precisely all the digits from x and from y, in any order, counting multiplicity. x and y are called the fangs.

For example: 1260 is a vampire number, with 21 and 60 as fangs, since 21 × 60 = 1260." Quote from [http://en.wikipedia.org/wiki/Vampire_number]

Here is what I coded:
 #!/usr/bin/env tclsh
 set usage {
    usage: vampire.tcl max ?p?
    list all true vampire numbers with factors < max to stdout.
    If second argument is "p", also list pseudovampire numbers.
 }
 proc main argv {
    set max [lindex $argv 0]
    set popt [string equal [lindex $argv 1] p]
    if {$max eq ""} {puts stderr $::usage; exit 1}
    for {set i 2} {$i < $max} {incr i} {
        for {set j $i} {$j < $max} {incr j} {
            if {[vampire $i $j $popt]} {
                set p [expr {$i * $j}]
                puts [format "%8d = %4d * %4d" $p $i $j]
            }
        }
    }
 }
 proc vampire {i j popt} {
    if {!$popt && [string length $i] != [string length $j]} {
        return 0
    }
    if {[string index $i end] eq "0" && [string index $j end] eq "0"} {
        return 0
    }
    set p [expr {$i * $j}]
    if {[lsort [split $p ""]] eq [lsort [split $i$j ""]]} {return 1}
    return 0
 }
 main $argv

Usage examples:
 ~ $ ./vampire.tcl 100
    1395 =   15 *   93
    1260 =   21 *   60
    1827 =   21 *   87
    2187 =   27 *   81
    1530 =   30 *   51
    1435 =   35 *   41
    6880 =   80 *   86
 ~ $ ./vampire.tcl 100 p # also show pseudo-vampire numbers, where factors are of unequal length
     153 =    3 *   51
     126 =    6 *   21
     688 =    8 *   86
    1395 =   15 *   93
    1260 =   21 *   60
    1827 =   21 *   87
    2187 =   27 *   81
    1530 =   30 *   51
    1435 =   35 *   41
    6880 =   80 *   86
 ~ $

<<categories>>Mathematics