File Coverage

blib/lib/Games/Puzzles/SendMoreMoney.pm

Criterion	Covered	Total	%
statement	61	72	84.7
branch	11	24	45.8
condition	1	3	33.3
subroutine	11	11	100.0
pod	0	6	0.0
total	84	116	72.4

###########################################
# Games::Puzzles::SendMoreMoney
# 2005, Mike Schilli
###########################################

###########################################
package Games::Puzzles::SendMoreMoney;
###########################################

use strict;
use warnings;
use Algorithm::FastPermute;
use Log::Log4perl qw(:easy);

our $VERSION     = "0.03";
our $STOP_SOLVER = 0;

###########################################
sub new {
###########################################
    my($class, %options) = @_;

    my $self = {
        puzzle       => undef,
        permutator   => undef,
        search_space => undef,
        validator    => undef,
        reporter     => undef,
        values       => undef,
        %options,
    };

    LOGDIE "Mandatory parameter puzzle missing"
        unless defined $self->{puzzle};

    ($self->{left}, $self->{right}) = split /\s*=\s*/, $self->{puzzle};

    LOGDIE "Puzzle not an equation: '$self->{puzzle}'"
        unless defined $self->{right};

    bless $self, $class;

    $self->{chars} = [$self->chars_extract($self->{puzzle})];

    return $self;
}

###########################################
sub tryout {
###########################################
    my($self, $try) = @_;

    unless($self->{seen}->{join "", values %$try}++) {
        if($self->is_valid($try)) {
            if($self->evaluate($try)) {
                $self->{reporter}->($try) if defined $self->{reporter};
                push @{$self->{results}}, $try;
                return 1;
            }
        }
    }

    return 0;
}

###########################################
sub solve {
###########################################
    my($self) = @_;

    my %try;
    $self->{results} = ();

    $self->{seen}    = {};
    $self->{results} = [];

    if($self->{permutator}) {
        while(my $perm = $self->{permutator}->next()) {
            DEBUG "Permutation: @$perm";
            @try{@{$self->{chars}}} = @$perm;
            $self->tryout(\%try);
            last if $STOP_SOLVER;
        }
    } else {
        my @array = @{$self->{values}};
        eval {
            permute {
                DEBUG "Permutation: @array";
                @try{@{$self->{chars}}} = @array;
                $self->tryout(\%try);
                die "STOP_SOLVER_SET" if $STOP_SOLVER;
            } @array;
        };
        if($@ and $@ !~ /STOP_SOLVER_SET/) {
            die "Error is '$@'";
        }
    }

    return $self->{results};
}

###########################################
sub is_valid {
###########################################
    my($self, $try) = @_;

    if(defined $self->{validator}) {
        return $self->{validator}->($try);
    }

    return 1;
}

###########################################
sub evaluate {
###########################################
    my($self, $try) = @_;

    (my $left_tmp  = $self->{left})  =~ s/([a-zA-Z])/$try->{$1}/g;
    (my $right_tmp = $self->{right}) =~ s/([a-zA-Z])/$try->{$1}/g;

        # Remove pseudo-octal values
    $left_tmp  =~ s/\b0+([1-9])/$1/g;
    $right_tmp =~ s/\b0+([1-9])/$1/g;

    if(eval $left_tmp == eval $right_tmp) {
        INFO "$left_tmp == $right_tmp";
        return 1;
    }

    DEBUG "$left_tmp != $right_tmp";
    return 0;
}

###########################################
sub chars_extract {
###########################################
    my($self, $string) = @_;

    my %chars = ();

    while($string =~ /([a-zA-Z])/g) {
        $chars{$1}++;
    }

    return keys %chars;
}

1;

__END__