#! /bin/perl -w
# path on prtr-13

# Self-Referential Number Search v2
# jeremy avnet .:. brainsik@prtr-13.ucsc.edu
# 30th January 1998

# In this revision, duplicate numbers are no
# longer Deduce()d. A duplicate number is a non-abelian
# number, e.g.: 024 = 042 = 204 = 402 = 420 = 240 are all
# the same number since the self-referential number
# algorithm initially calls for an ordering of digits from 
# highest -> lowest. (so, for any number above, 024, 042,
# etc., the digits would be ordered into 420).

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

#use strict;

main();

sub main
{
    my ($number, $digits);
    local $fname;
    local $suppress = 'n';

    print "\nSearch for the self-referential numbers! (v2)";
    
    while(1) {
	print "\n\nEnter in number or 0 to scan: ";
	($number, $digits) = GetNum();
	($number = 0 ) if (length($number) == 0);
	last if ($number == 0);
	GetFname();
	Deduce($number,$digits);
    }

    Fascan();
}

sub GetFname
{
    print "\nName of output file or blank: ";
    $fname = GetStr();
    return();
}

sub GetStr
{
    my $str = <STDIN>;
    chomp $str;
    return($str);
}

sub GetNum
{ 
    my $number = GetStr();
    my $digits = length $number;
    return($number,$digits);
}

# make modulus to check for homogenous values with
sub MakeMod
{
    my $digits = shift;

    my $mod = '1';
    for ($i = 1; $i < $digits; $i++) {
	$mod = $mod . '1';
    }
    return($mod);
}

sub Fascan
{
    my (@numray,$num,$digits,
	$d1,$d2,$d3,$d4,$d5,$d6,$d7,$d8,$d9,$d10,$d11,$d12,$d13,$d14);

# digits are ordered from right to left

    $digits = 0;
    while($digits < 2 || $digits > 14) {
	print "\n# of digits: ";
	$digits = GetStr();
    }
    GetFname();
    print "\nSuppress output? (y/n): ";
    $suppress = GetStr();
    my $mod = MakeMod($digits);

    for ($d14 = 0; $d14 < 9; $d14++) {
	@numray[0] = $d14;
	for ($d13 = $d14; $d13 < 10; $d13++) {
	    @numray[1] = $d13;
	    for ($d12 = $d13; $d12 < 10; $d12++) {
		@numray[2] = $d12;
		for ($d11 = $d12; $d11 < 10; $d11++) {
		    @numray[3] = $d11;
		    for ($d10 = $d11; $d10 < 10; $d10++) {
			@numray[4] = $d10;
			for ($d9 = $d10; $d9 < 10; $d9++) {
			    @numray[5] = $d9;
			    for ($d8 = $d9; $d8 < 10; $d8++) {
				@numray[6] = $d8;
				for ($d7 = $d8; $d7 < 10; $d7++) {
				    @numray[7] = $d7;
				    for ($d6 = $d7; $d6 < 10; $d6++) {
					@numray[8] = $d6;
					for ($d5 = $d6; $d5 < 10; $d5++) {
					    @numray[9] = $d5;
					    for ($d4 = $d5; $d4 < 10; $d4++) {
						@numray[10] = $d4;
						for ($d3 = $d4; $d3 < 10; $d3++) {
						    @numray[11] = $d3;
						    for ($d2 = $d3; $d2 < 10; $d2++) {
							@numray[12] = $d2;
							for ($d1 = $d2; $d1 < 10; $d1++) {
							    $numray[13] = $d1;
							    (print("\n"), exit(0)) if ($numray[13 - $digits] != 0);
							    $num = Ray2Num($digits, @numray);
							    if ($num % $mod == 0) {
								(print $d1) if ($suppress eq 'y');
								next;
							    }
							    Deduce($num, $digits);
							}
						    }
						}
					    }
					}
				    }
				}
			    }
			}
		    }
		}
	    }
	}
    }
}

sub Ray2Num
{
    my ($digits, @nm) = @_;
    my ($num, $i, $mult);

# print "\n-- OUT array = @nm --";

    $num = 0;
    $mult = 1;
    for ($i = 0; $i < $digits; $i++) {
	$num += (pop @nm) * $mult;
	$mult *= 10;
# print "\n\nnum = $num\nmult = $mult\n";
    }
    return($num);
}

sub Deduce
{
    my ($number, $digits) = @_;
    my ($i, $sorted, @buffer);

    while (1) {
	# Make sure $number is correct length
	while ( (length $number) < $digits ) {
	    $number = "0" . $number;
	}
	
	print("\n$number") unless ($suppress eq 'y');
	
	return if PatChk($number,@buffer);
	push @buffer, $number;
	
        $sorted = Jsort($number,$digits);
	$number = $sorted - (reverse $sorted);
	print(" | $sorted - " . (reverse $sorted)) unless ($suppress eq 'y');
    }
}

sub PatChk
{
    my $number = shift @_;
    my @buffered = @_;
    return(0) unless @buffered;

    my @buffer = @buffered;

    my $entry = (pop @buffer);
    while (@buffer && ($entry ne $number)) {
	$entry = (pop @buffer);
    }
    if ($entry eq $number) {   # Pattern match???
	my $srloop = "\n\n" . $buffered[0] . "\n--------------\n";
	my $i;
	my $count = scalar(@buffered) - (scalar(@buffered) - scalar(@buffer));
	for ( ; $count <  scalar(@buffered); $count++) {
	    $srloop = $srloop . $buffered[$count] . "\n";
	}
	WrtFile($srloop) if ($fname);
	return(1);
    }
    return(0);
}

# Write Data to a file
sub WrtFile
{
    my $line = shift;
    open (DBASE, ">>$fname");
    print DBASE $line;
    close DBASE;
}

# Sorts a string of numbers in descending order
sub Jsort
{
    my $num = shift;
    my $digits = shift;
    my @sorting = \0;
    my $sorted = "";
    my ($tmp,$i);

    for ($i = 0; $i < $digits; $i++) {
	$tmp = chop $num;
	@sorting[$i] = $tmp;
    }

    @sorting = sort @sorting;
    
    for ($i = 0; $i < $digits; $i++) {
	$sorted = $sorted . shift @sorting;
    }

    return(reverse $sorted);
}