#! /usr/bin/perl
##
## This is one of a few scripts I created to explore the Kaprekar Routine. 
## Given a number of digits, it generates a .dot file which can be used by
## the graphviz family of graphing utilities to create a visual representation
## of the relationships between sets of digits over many iterations of the
## Kaprekar Routine.
## The program can perform this task in two ways: the first and default way is
## to treat "numbers" of the given number of digits as merely "constellations"
## or sets of digits. Because the very first step of the Routine re-orders the 
## digits anyway, the difference between e.g. 4335 and 4353 becomes irrelevant.
## Thus for the above, we only store the ordered value 5433, which makes our
## graphs lighter, and it makes more sense to treat the numbers as sets of
## digits as well.
## The second method is to create relationships for every number from 000.. to 
## 999..
##
## Usage: 
##           $> perl kaprekar_tree.pl [number_of_digits] > kaprekar.dot
##
## For generating a graph, try: 
##           $> twopi -T svg kaprekar.dot -o kaprekar.svg
##
use strict;
use warnings;
use subs qw(kRoutine gotoNext sortHiLow sortLowHi generateDotFile);

my $digits = $ARGV[0] || 4;
if ($digits > 6) {die "Right now this code stores everything in a hash, so ",
                      "I'm not sure if we can play with big numbers.";}

my $only_unique = 1;    # eliminate numbers that are just a reordering of digits

my ($lower,$upper) = ("0" x $digits,"9" x $digits);     # e.g. (0000,9999)

my @converged;          # numbers which others converge to, "attractors"
my %converged_dupes;    # for removing duplicates in our loop
my %number_pair;        # number -> next_number_in_sequence

for my $n ("$lower".."$upper"){
    my $nn = gotoNext($n);      

    ## we store only unique "constellations" of digits by sorting and using the
    ## hash to remove duplicates. we also must sort the value it points to.
    if ($only_unique) {$n = sortHiLow($n);
                       $nn = sortHiLow($nn);}    

    if ($n eq $nn) {$converged_dupes{$n}=() }  # this number is an "attractor" 
    $number_pair{$n} = "$nn";                   # store our graph relationships
} 

@converged = keys %converged_dupes;
generateDotFile();


    #-------------------------------------#


## orders a number's digits high -> low
sub sortHiLow {
    my $n = shift;
    my @sort_nums = sort {$b cmp $a} split (//,$n);
    return (join('',@sort_nums));
}

sub sortLowHi {
    my $n = shift;
    my @sort_nums = sort {$a cmp $b} split (//,$n);
    return (join('',@sort_nums));
}

## given a number, performs one iteration of the kaprekar routine and returns num
sub gotoNext {
    my $n = shift;
    my $new_num = sortHiLow($n) - sortLowHi($n); 
    while (length $new_num < $digits) 
        {$new_num = ("0" . "$new_num")}
        
    return $new_num;
}

## Print to screen the dot file, line by line. Experiment with the parameters:
sub generateDotFile {
    my $graph_name = "kaprekar_$digits";
    #---------------------------------------------\
    print "digraph $graph_name {\n";
    print       "\tnode [shape = doublecircle,fontcolor=red]; @converged;\n";
    print       "\tnode [shape = plaintext,height=0,width=0,fontsize=8,fontcolor=grey];\n";
    #print       "\tgraph [overlap=false,splines=true];\n";
    print       "\tranksep=3;\n";
    print       "\tratio=auto;\n";

  for my $n (keys %number_pair){
    print       "\t$n -> $number_pair{$n};\n";
  }
    print "}\n";
    #---------------------------------------------/
}

## runs kaprekar routine on a number until it either cycles or converges:
sub kRoutine {
    if (scalar @_ > 10) {return (-1) }     # result didn't converge, or cycled

    my $new_num = sortHiLow($_[-1]) - sortLowHi($_[-1]);
    while (length $new_num < $digits) 
        {$new_num = "0" . "$new_num"}
    
    if ($new_num == $_[-1]) {return (@_) }     #return whole list (for cycles)
        else {kRoutine (@_,"$new_num") }       #keep recursing
}