#!perl
# alapm.pl -- megold egy számrejtvényt
# Rubyból fordítottam perlbe kábé szó szerint, tehát rosszabbnak kell 
# lennie, mintha eleve perlben írnám.  Látszik rajta, callbackeket 
# használok úgy, ahogy perl-ben nem tenném.
# Állítsuk elő a 24-et alapműveletekkel az 1, 3, 4, 6 számje
+gyek pontosan 
# egyszeri felhasználásával.  A sorrend tetsz.

use warnings;
use strict;
use Carp "cluck";


sub mask {
    my($s, $m) = @_;
    [map { $$s[$_] } grep { 0 != ($m & (1<<$_)) } 0 .. @$s - 1];
}


sub poss2 {
    my($v1, $v2, $s1, $s2, $f) = @_;
    &$f($v1 + $v2, "(" . $s1 . " + " . $s2 . ")");
    &$f($v1 - $v2, "(" . $s1 . " - " . $s2 . ")");
    &$f($v1 * $v2, "(" . $s1 . " * " . $s2 . ")");
    1e-8 < abs($v2) and
        &$f($v1 / $v2, "(" . $s1 . " / " . $s2 . ")");
    $s1 =~ /^\d+$/ && $s2 =~ /^\d$/ and
        &$f($v1 + 10 * $v2, $s1 . $s2);
}


sub poss {
    my($v, $s, $f) = @_;
    if (1 == @$v) {
        &$f($$v[0], $$s[0]);
    } else {
        for my $m (1 .. (1<<@$v) - 2) {
            my(@vv2, @ss2);
            poss(mask($v, ~$m), mask($s, ~$m), sub {
                my($v2, $s2) = @_;
                push @vv2, $v2;
                push @ss2, $s2;
            });
            poss(mask($v, $m), mask($s, $m), sub {
                my($v1, $s1) = @_;
                for my $k (0 .. @vv2 - 1) {
                    poss2($v1, $vv2[$k], $s1, $ss2[$k], $f
                        #
                        #
                    );
                }
            });
        }
    }
}


my(@NUMS, $TARGET);

sub main {
    poss([@NUMS], [@NUMS], sub {
        my($r, $s) = @_;
        abs($r - $TARGET) < 1e-6 and
            print $r, " = ", $s, "\n";
    });
}


@NUMS = (1, 3, 4, 6);
$TARGET = 24;
main();


__END__
[download]