#!/usr/bin/perl use Math::BigRat; my $negative_allowed = 1; my $fraction_allowed = 1; my ($TARGET, @pool) = @ARGV; my $ops = [ [ '+' => sub { $_[0] + $_[1] } ], [ '-' => sub { $_[0] - $_[1] } ], [ '-' => sub { $_[1] - $_[0] }, 'r'], [ '*' => sub { $_[0] * $_[1] } ], [ '/' => sub { return $_[1] == 0 ? () : $_[0] / $_[1] } ], [ '/' => sub { return $_[0] == 0 ? () : $_[1] / $_[0] }, 'r' ], ]; sub reversed { $_[0][2] =~ /r/ } my @queue = node(map base_expr($_), @pool); # a node has a list of unused expressions sub node { bless [ @_ ] => "Node" } sub exprs { my ($node) = @_; return @$node } sub expr_count { scalar @{$_[0]} } # an expression has: the stringization and its value sub base_expr { my ($con) = @_; return [ $con, Math::BigRat->new($con) ]; } sub expr { my ($string, $val) = @_; [ $string, $val ]; } sub expr_value { $_[0][1] } sub expr_str { $_[0][0] } while (@queue) { my ($node) = shift @queue; # warn sprintf "examining node %d\n", $COUNT if ++$COUNT % 1000 == 0; if (expr_count($node) == 1) { my $expr = $node->[0]; if (expr_value($expr) == $TARGET) { my $str = expr_str($expr); print " $str\n" unless $SEEN{$str}++; } } my @exprs = exprs($node); for my $i (0 .. $#exprs) { my $expr_1 = $exprs[$i]; for my $j ($i+1 .. $#exprs) { # next if $i == $j; my $expr_2 = $exprs[$j]; for my $op (@$ops) { if (defined (my $new_expr = combine($op, $expr_1, $expr_2))) { my @new_pool = exprs($node); splice @new_pool, $_, 1 for sort { $b <=> $a } $i, $j; push @queue, node(@new_pool, $new_expr); } } } } } sub combine { my ($op, $e1, $e2) = @_; my ($op_name, $calc) = @$op; my $val = $calc->(expr_value($e1), expr_value($e2)); return unless defined $val; return if ! $negative_allowed && $val < 0; return if ! $fraction_allowed && ! $val->is_int; ($e1, $e2) = ($e2, $e1) if reversed($op); my $new_expr = "(" . expr_str($e1) . " $op_name " . expr_str($e2) . ")"; return expr($new_expr, $val); }