**Improved answer**

(Since the contents of the original answer is contained in what follows here, the original answer is deleted.)

I address the following problem: given a set of numbers and a target, obtain the target from the given numbers by using the arithmetic operators *, /, + ,- such that each number occurs only once.

In his question, Feyre requires the numbers to occur at most once. That problem can be solved in the same way as this one by adding his function `first`

to the arithmetic operators, or probably simpler by running my function `alldifferentsolutions`

on all subsets of the given numbers.

For the numbers (2,3,5,12) and the target 25, a solution is 12+(2*5+3)=25. That solution can be rewritten as 3+12+2*5=25, which is another solution. However, these two solutions have to be considered as the same. In the final result we want all solutions to be different.

Roughly speaking, we proceed as follows.

First we construct all possible schemes (patterns) for the lefthand side of the solutions. E.g. the lefthand side of the solution 12+(2*5+3)=25 has the scheme `plus[_, plus[times[_,_], _]`

.

Each scheme is transformed into a test function. E.g. for the above scheme, the test function is `HoldForm[Plus[#1, Plus[Times[#2, #3],#4]==25&`

.
Each test function will be used on every permutation of the given numbers. When releasing the function value gives `True`

, we have found a solution of the problem.

In the final result, we still have to skip duplicate solutions.

The schemes for a problem with *n* numbers will be collected in the list `schemes[n]`

. Therefore, `schemes[1]={_}`

. (For technical reasons, in the implementation we will use the name `var`

instead of the underscore.)

Every scheme for a problem with *n* numbers has a head `plus`

, `times`

, `subtract`

or `divide`

, and two arguments, each being a scheme of a lower index that add to *n*. For example, the scheme for 12+(2*5+3)=25 mentioned above is in `schemes[4]`

. It has head `plus`

, the first argument is in `schemes[1]`

and the second argument in `schemes[3]`

.

This allows us to define the schemes recursively. Of course we will use memoization to speed up the computation.

The recursive construction gives us all possible schemes, so also schemes for solutions that have to be considered as duplicates. We want to delete these superfluous schemes.

Consider the simple rewriting *a+(b-c) = (a+b)-c*. That means that every solution from the scheme `plus[_, subtract[_,_]]`

also turns up in an equivalent form as a solution from the scheme `subtract[plus[_,_],_]`

. Therefore, the scheme `plus[_, subtract[_,_]]`

can be deleted from `schemes[3]`

. Similar rewritings give other schemes that can be deleted.

The deletable schemes are indicated in the list duplicates:

```
duplicates={
plus[___, _subtract,___],
times[___, _divide,___],
subtract[___, _subtract,___],
divide[___, _divide,___],
subtract[ _, (times|divide)[___,_subtract, ___]],
subtract[_, plus[___, times[___,_subtract, ___],___]],
divide[subtract[times[___,_subtract, ___],_], _subtract]
};
```

This list does not contain the schemes that can be deleted, but the *Mathematica* patterns for those schemes. The third element for example covers both *a-(b-c)=(a+b)-c* and *(a-b)-c=a-(b+c)*.

When we have deleted the superflous schemes from the schemes list and have constructed the solutions, nevertheless duplicates turn up. That is caused by the values that we used as arguments in the test function. For example, if the solution has a `divide`

subexpression which has the value 1 or -1, then the same solution turns up with the arguments reversed. Similarly, when a `subtract`

subexpression has the value 0, there is also a solution with reversed arguments. Another situation is when there is a subexpression of the form *(a-b)(c-d)*. Then there is another solution with the subexpression *(b-a)(d-c)*.

So for getting rid of the duplicates, we need a list of transformations based on the numerical values. For big problems, this list has to be longer, but for the size up to 6, the following list suffices:

```
numericrules={
z:divide[a_,b_] :> divide[b,a] /; Abs[compute[z]]==1 && Min[Cases[b, _Integer, All]]<Min[Cases[a, _Integer, All]],
z:subtract[a_,b_] :> subtract[b,a] /; compute[z]== 0 && Min[Cases[b, _Integer, All]]<Min[Cases[a, _Integer, All]],
z:(times|divide)[___,num:subtract[a_, b_] | times[ ___, subtract[a_, b_], ___],
den:subtract[c_, d_] | times[ ___, subtract[c_, d_], ___],___]:> (z/. {a->b, b->a, c->d, d->c} )/; compute[num]<0
};
```

Here at last is the implementation of the function `alldifferentsolutions`

:

```
alldifferentsolutions[numbers_, target_] :=
Module[{plus, times, subtract, divide,compute, schemes, var, duplicates, numericrules, tests, result},
Attributes[plus]={Flat, Orderless};
Attributes[times]={Flat, Orderless};
compute[expr_] := expr /. {plus->Plus, times->Times, subtract->Subtract, divide->Divide};
schemes[1]={var};
schemes[n_] := schemes[n]=Module[{zzz},
zzz=Join[
Table[Outer[ff,schemes[i], schemes[n-i]], {ff, {plus,times}}, {i,1,n/2}],
Table[Outer[ff,schemes[i], schemes[n-i]], {ff, {subtract,divide}}, {i,1,n-1}]
]// Flatten // DeleteDuplicates;
DeleteCases[zzz,Alternatives @@ duplicates]];
duplicates={
plus[___, _subtract,___],
times[___, _divide,___],
subtract[___, _subtract,___],
divide[___, _divide,___],
subtract[ _, (times|divide)[___,_subtract, ___]],
subtract[_, plus[___,
times[___,_subtract, ___],___]],
divide[subtract[times[___,_subtract, ___],_], _subtract]
};
numericrules={
z:divide[a_,b_] :> divide[b,a] /; Abs[compute[z]]==1 && Min[Cases[b, _Integer, All]]<Min[Cases[a, _Integer, All]],
z:subtract[a_,b_] :> subtract[b,a] /; compute[z]== 0 && Min[Cases[b, _Integer, All]]<Min[Cases[a, _Integer, All]],
z:(times|divide)[___,num:subtract[a_, b_] | times[ ___, subtract[a_, b_], ___],
den:subtract[c_, d_] | times[ ___, subtract[c_, d_], ___],___]:> (z/. {a->b, b->a, c->d, d->c} )/; compute[num]<0
};
tests=compute[ Function /@ HoldForm /@ Table[i=0; ( ff/. var:>(i++; Slot[i]))==target, {ff, schemes[Length[numbers]]}]];
result=Reap[
Do[If[Quiet[ReleaseHold[test@@nn]],Sow[test@@nn]],{test,tests},{nn,Permutations[numbers]}]][[2]];
If[result!={}, result=result[[1]]];
result = ReleaseHold[result /.{Plus->plus, Times->times, Subtract->subtract, Divide->divide}];
result=DeleteDuplicates[result /. numericrules];
compute[HoldForm /@ result]
]
```

The function is relatively fast. The six number problem raised by Feyre now runs in about 8 seconds and returns 9 different solutions.

```
(sols=alldifferentsolutions[{2,3,7,8,50,75},902])//Length// Timing
Column[sols]
(* {7.96875, 9} *)
(*
7 50+8 (75-2 3)==902
2 (7 75-(50+3 8))==902
(8+7 (3+50+75))-2==902
(7 (75-3)+8 50)-2==902
7 (2+3+50+75)-8==902
7 (2 (75-3)-8)-50==902
(8+2 3) (75-7)-50==902
(8+75 (50-2))/(7-3)==902
((7+75) (8+50/2))/3==902
*)
```

Solving a seven number problem can be done in slightly over 6 minutes.

Related link: http://mathematica.stackexchange.com/questions/15021/insert-times-into-123456789-to-make-it-equal-to-1

– matrix89 – 2017-01-07T14:00:16.833@mathe Sure, though in a sense that is a subset of this question, since it has a rigid order). – Feyre – 2017-01-07T14:01:39.090