Re: make a 24(another practical problem)

[Greg Bacon]

Here's a program that uses good ol' brute force.  An obvious bottleneck
is the use of dc(1) to evaluate the RPN.

Enjoy,
Greg

#! /usr/local/bin/perl -w

use strict;

sub usage { "Usage: $0 target number_1 number_2 [ ... number_n ]\n" }

sub permute {
    my @items = @{ $_[0] };
    my @perms = @{ $_[1] || [] };

    unless (@items) {
        return [ @perms ];
    }
    else {
        my(@newitems,@newperms,$i);
        my @result;

        foreach $i (0 .. $#items) {
            @newitems = @items;
            @newperms = @perms;

            unshift @newperms, splice @newitems, $i, 1;
            push @result, permute([@newitems], [@newperms]);
        }

        @result;
    }
}

my %seen;
sub arrange {
    my $t = shift;
    my $n = shift;
    my $o = shift;
    my @f = @_;

    if (@$n == 0) {
        push @f, @$o;

#        print "[@f]\n";
        my $result = `echo '@f f' | dc 2>&1`;
        chomp $result;
        if ($result =~ /^\d+$/ && $result == $t) {
            print "@f = $result\n";
        }

        return;
    }

    if (@f == 0) {
        push @f, splice @$n, 0, 2;
        arrange($t, $n, $o, @f);
    }
    else {
        return unless @$o;

        my $num = shift @$n;
        arrange($t, $n, $o, @f, $num);
        unshift @$n, $num;

        if (@$o > @$n) {
            my $op = shift @$o;
            arrange($t, $n, $o, @f, $op);
            unshift @$o, $op;
        }
    }
}

sub find_formula {
    my $targ = shift;
    my $nums = shift;
    my @toke = @_;

    if (@toke < @$nums) {
        foreach my $perm (permute $nums) {
            find_formula($targ, $nums, @$perm);
        }
    }
    elsif (@toke < @$nums + @$nums - 1) {
        foreach my $op (qw[ + - * / ]) {
            find_formula($targ, $nums, @toke, $op);
        }
    }
    else {
        my @n = splice @toke, 0, @$nums;

        arrange $targ, \@n, \@toke;
    }
}

## main
if (@ARGV < 3) {
    die usage;
}

my $target = shift;
my $nums   = [ @ARGV ];

find_formula $target, $nums;