my $target = 24;
my @nums = ( 1, 3, 4, 6);
for ( solve( $target, @nums) ) {
    my $val = eval;
    print "$_ = $val\n";
}

sub solve {
    my ( $target, @nums) = @_;
    my @sols;
    for my $i ( 0 .. $#nums ) {
        my @rem = @nums;
        my $first = splice @rem, $i, 1;
        if ( @rem ) {
            for ( complements( $target, $first) ) {
                my ( $op, $try) = @$_;
                push @sols, map "$first $op $_",
                    map m{[-+*/]} ? "($_)" : $_,
                    solve( $try, @rem);
            }
        } else {
            push @sols, $first if $first eq $target; # sic!
        }
    }
    return @sols;
}

sub complements {
    my ( $t, $x) = @_;
    (
        [ '+', $t - $x],
        [ '-', $x - $t],
        $x ? [ '*', $t/$x] : (),
        $t ? [ '/', $x/$t] : (),
    );
}
[download]

6 / (1 - (3 / 4)) = 24
[download]

That is freakin' genius! I love it!

Why, thanks. Quite the blast from the past after almost two years :)

Your praise is unjustified, however, because my solution is wrong. It doesn't find some valid results like (1 + 3)*(4 + 6) = 40 and others that can't be written without an initial parenthesis.

The correct solution (as I believe) I came up with this time around is comparatively boring. Essentially it builds all arithmetic expressions that can be built from the original numbers, eval's them and sees if they match the target.

In case anyone has picked up this ancient thread I'm appending it anyway.

Anno

sub solve {
    my ($target, @nums) = @_;
    return unless @nums;
    if ( @nums == 1 ) {
        return unless eval($nums[0]) eq $target; # eq for epsilon fuzz
        return @nums;
    } else {
        my @sol;
        for my $i ( 0 .. $#nums - 1 ) {
            for my $k ( $i + 1 .. $#nums ) {
                my @rem = @nums;
                my $nk = splice @rem, $k, 1;
                my $ni = splice @rem, $i, 1;
                for ( combine($ni, $nk) ) {
                    unshift @rem, $_;
                    push @sol, solve($target, @rem);
                    shift @rem;
                }
            }
        }
        return @sol;
    }
}

sub combine {
    my ($x, $y) = @_;
    my ($vx, $vy) = map eval, $x, $y;
    my @combi = map operate($x, $y, $_), qw(+ *);
    push @combi, operate($x, $y, '-');
    push @combi, operate($y, $x, '-') if $vx ne $vy;
    push @combi, operate($x, $y, '/') if $vy;
    push @combi, operate($y, $x, '/') if $vx and $vx ne $vy;
    @combi;
}

sub operate {
    my ($x, $y, $op) = @_;
    precedes($op, $_) and $_ = "($_)" for $x, $y;
    $op = " $op " if precedence($op) >= 3;
    "$x$op$y"
}

sub precedes {
    my ($op, $expr) = @_;
    precedence($op) < precedence($expr);
}

sub precedence {
    for ( shift ) {
        /\-/ and return 4;
        /\+/ and return 3;
        /\// and return 2;
        /\*/ and return 1;
        return 0;
    }
}

__END__
[download]

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

Shouldn't that '3' be a '2'?

For the numbers 1, 2, 4 and 6, my brain tells me that (46/2)+1 would do the trick.

No, I don't know how I did that. ;)

Making 1 change to the perl code, gives me 3 lines of output:

24 = (3 * (5 - 6))
24 = (6 / (1 - (3 / 4)))
24 = ((5 - 6) * 3)
[download]

sub {
    my($v3, $s3) = @_;
    &$f($v3, $s3);
}
[download]

Does that help in any way?

Of course, I have to admit, I do not understand the algorithm (at the moment; but still trying to figure that part out), nor do I know ruby and can comment on your transforming the iterators ("yield") to perl closures :-/

Hoping to learn more, when you resolve the case...

Thanks. Making that change and another trivial one appears to fix the code. I still don't know what problem your change fixes, but I'll try to find it out (it might be something related to aliasing.

The trivial change is that the second addittion operator in line 28 has to be replaced by a concatenation operator:

                &$f($v1 + 10 * $v2, $s1 . $s2);
[download]

Here's the fixed code for convenience:

Read more... (2 kB)

With one more change, the code works fine:


27,28c27,28
<       $s1 =~ /^\d+$/ and $s2 =~ /^\d$/ and
<               &$f(10*$v1 + $v2, $s1 . $s2);
---
>       $s1 =~ /^\d+$/ && $s2 =~ /^\d$/ and
>               &$f($v1 + 10 * $v2, $s1 . $s2);
[download]

and the output I see is


24 = (3 * (14 - 6))
24 = (6 / (1 - (3 / 4)))
24 = ((14 - 6) * 3)
[download]

which seems quite OK.

Now I haven't looked yet if that's an oneliner in some Perl Golf competition, but I'd bet there is something :)

Would be nice to let us now if in the end you had some personal conclusions about your attempted Ruby/Perl comparison.

Thanks,
Krambambuli

It turns out that there were three bugs in the code. Two are simple: a plus sign instead of a dot, as mentioned in Re^2: Number from given digits puzzle, and swapping two variables in the same line, as in Re^3: Number from given digits puzzle. The third problem however seems to be a bug in the perl interpreter about handling closures. They say that the bug is fixed from perl 5.9.0.

Just mentioning a variable at the right point like this makes the problem disappear:

            poss(mask($v, $m), mask($s, $m), sub {
                my $unused = $f; # <------
                my($v1, $s1) = @_;
                for my $k (0 .. @vv2 - 1) {
                    poss2($v1, $vv2[$k], $s1, $ss2[$k], sub {
                        my($v3, $s3) = @_;
                        &$f($v3, $s3);
                    });
                }
            });
[download]