#! /usr/bin/perl

# number_puzzle_solver
#
# Given a target and a bunch of other numbers, find arithmetical expressions
# that use all the numbers to make the target.

use v5.14;
use warnings;

use Function::Parameters qw<:strict>;

use Algorithm::Combinatorics qw<permutations>;


my ($target, @num) = @ARGV;
$target //= 17;
@num = (6, 6, 5, 2) if !@num;

# For each permutation of @num, generate a list of all the ways parens can be
# used to order the way the numbers can be combined in an expression, using a
# constant with braces in place of an operator:
foreach (permutations \@num)
{
  foreach (op_order(@$_))
  {

    # Then use glob to expand each of those brace-constants, so a single
    # expression becomes a list, permutating through each operator in each
    # position:
    foreach (glob $_)
    {

      # Turn each arithmetical expression into a boolean check for equalling
      # the target; this also doubles up as the output if it does match:
      $_ .= " == $target";
      # XXX This probably should be an approximate test, to allow for
      # intermediate non-integer values that can't be expressed accurately. But
      # equality has worked for the cases I've tried so far; I'm holding off
      # trying to fix it until I have a test case I can use to check it.

      # Emit any matches, unless we've seen them before. If a number is
      # repeated in @num then permutations will return it both ways round and
      # we'll get a duplicate:
      state %seen;
      say if eval && !$seen{$_}++;
    }
  }
}


fun op_order($first, $second, @rest)
# returns a list of strings using parens in different ways to combine the
# provided arguments, in the order provided, into an expression; doesn't
# include expressions which will be covered by a different order arguments
{

  # Pairing the first two elements, or skip this ordering entirely if the pair
  # is already covered t'other way round:
  my $head_pair = pair_ops($first, $second) or return;

  # If these are only two elements then that pair is the only possible
  # ordering:
  return $head_pair if !@rest;

  # Otherwise recursively generate the lists where that pair is combined with
  # the rest of the elements, and the lists where all but the first element are
  # combined and then the first element is combined with them (both recursive
  # calls has one fewer argument than this one, and the above return will stop
  # recursing once we're down to two arguments):
  (op_order($head_pair, @rest),
     map { pair_ops($first, $_) } op_order($second, @rest));
}


fun pair_ops($x, $y)
# returns the specified operands paired in parens, with a glob operator
# placeholder for later expansion, or an empty list if we'll process these
# t'other way round
{

  # Skip over argument pairs that we'll encounter in the opposite order, to
  # avoid trivially similar answers such as "(3+4)" and "(4+3)". Pruning the
  # search space like this also makes the solver much faster. This doesn't just
  # skip numbers one way round but also expressions with pair strings (as
  # returned by this function), so string comparison has to be used; that
  # compares, say, 2 and 11 the ‘wrong’ way round, but that doesn't matter: the
  # point is simply to skip them in some order (similarly it doesn't matter how
  # pair strings compare with each other or numbers). This obviously does let
  # through exact duplicates like "(3+3)" and "(3+3)", where input numbers are
  # repeated; those are skipped in output, above:
  return if $x gt $y;

  # Combine the operands with a brace expression which glob will expand into
  # all the operators; because there are no spaces around it, each expansion
  # will also include $x and $y, giving a list of expressions:
  my $all_ops = "${x}{+,-,\\*,/}$y";

  # Since we've skipped processing the operands t'other way round, the
  # non-commutative operators also need including with the operands t'other way
  # round:
  my $reverse_ops = "${y}{-,/}$x";

  # Nest both of those in another brace expression, and surround the whole
  # thing with parens so that in each expansion we'll get a simple bracketed
  # expression which can be used as an operand in further expressions:
  "({$all_ops,$reverse_ops})";
}