Using RPN (reverse Polish Notation)
For RPN intro see here.
The Problem size
We have to build a list of four numbers, which implies 3 operators.
Those numbers and operators will be pushed or executed against a stack.
Lets call the list of execution {a1 a2 a3 a4 a5 a6 a7}.
{a1 a2} should be numbers, as there are no unary operations on the stack.
{a7} should be an operator, to complete the operation.
For {a3, a4, a5, a6} we have several options, but always at least two numbers must be in the stack to be able to operate. So the possible combinations are: (N= number, O=Operator)
{N N O O}, {N O N O}, {O N O N}, {O N N O} and {N O O N}.
The combination {O O N N} is forbidden because the stack is empty for the second O.
So we have:
| {N N O O} |
| {N O N O} |
{N N} | {O N O N} | {O}
| {O N N O} |
| {N O O N} |
Now we will count the possible arrangements. Of course we are over counting because the commutative operator (Plus and Times) may cut the permutation tree in half, but the problem is small enough not to be bother by that. (We are also overcounting in those cases where the sequence is {O O}. but we simply go on ..)
We have to choose 2 numbers in four for the first segment, that's 12 possible arrangements.
For the middle segment, the two remaining numbers may only be permuted, that is a factor 2
But we have another factor 5 for counting the five alternatives for the middle segment.
For the three operators, as they may repeat we have a factor 4^3=64
So the size of the problem is the product of the numbers in bold:12 2 5 64 = 7680. No optimization is needed, we may go ahead by brute force.
The rest of the problem is to build the 7680 arrangements and the RPN evaluator. Both relatively easy tasks.
I'll post it ...it's still a draft but here is too late! Will follow tomorrow!
Edit: RPN Evaluator
Here is the code for the recursive RPN evaluator. I choose to do it in a functional language (Mathematica) to simplify the operator parsing
rpn[listipt_, stackipt_: {}] :=
Module[{list=listipt,stack=stackipt}, (*recursive rpn evaluator*)
If[list == {}, Return[stack[[1]]]]; (*end*)
If[NumberQ[list[[1]]], (*if numeric*)
Return@rpn[Rest[list], PrependTo[stack,list[[1]]]]; (*push nbr and recurse*)
,
(stack[[2]]=list[[1]][stack[[2]], stack[[1]]]; (*if not, operate*)
Return@rpn[Rest[list], Rest[stack]];); (*and recurse*)
];
];
Usage examples
rpn[{1, 1, 1, Plus, Plus}]
3
rpn[{2, 2, 2, Plus, Plus}]
6
rpn[{2, 3, 4, Plus, Times}] (* (4+3)*7 *)
14
rpn[{2, 3, 4, Plus, Divide}] (* (2+3)/4 *)
2/7
a bit later I'll post the tuples generator, show that they are 7680 and some funny results about the distribution of the possible results of the operations (in fact for the {1,2,3,4} set you can only get 230 different results!).
Edit : Tuples construction
First we explicitly construct the possibilities for the middle segment
t1 = {{n3, n4, o1, o2},
{n3, o1, n4, o2},
{o1, n3, o2, n4},
{o1, n3, n4, o2},
{n3, o1, o2, n4}};
Now we prepend the two variations for {n1,n2} and the last operator
t2 = Join[Map[Join[{n1, n2}, #, {o3}] &, t1],
Map[Join[{n2, n1}, #, {o3}] &, t1]] ( bahh ... don't mind the code*)
Resulting in our 10 different configurations
Now we have to populate all those configurations with all the possible permutations of the numbers and operators.
We first construct all number permutations as assignment rules for our tuples
repListNumbers = (*construct all number permutations*)
Table[{n1 -> #[[1]], n2 -> #[[2]], n3 -> #[[3]], n4 -> #[[4]]} &[i],
{i, Permutations[{1, 2, 3, 4}]}];
These little beast have the form
{n1 -> 1, n2 -> 2, n3 -> 3, n4 -> 4}
And we can use them to replace vallues in our tuples. For example:
{n1,n2,n3,o1,o2,n4,o3} /. {n1 -> 1, n2 -> 2, n3 -> 3, n4 -> 4}
Results in
{1,2,3,o1,o2,4,o3}
Of course we may have constructed the replacement rules as a function to be able to change the number set at will.
We do now something similar with the operators
repListOps = (*Construct all possible 3 element tuples*)
Table[{o1 -> #[[1]], o2 -> #[[2]], o3 -> #[[3]]} &[i],
{i, Tuples[{Plus, Times, Divide, Subtract}, 3]}];
So we get a collection of things like
{o1->Plus, o2->Plus, o3->Divide}
Now we combine our tuples and all our replacement rules in one big list:
t3 = Flatten[t2 /. repListNumbers /. repListOps, 2];
Which results in 15360 different calculations. But we know that there overcounted for a factor of two, so now we drop the repeated elements:
t3 =Union[t3]
And that give us our expected 7680 elements.
There are still some overcounting, because {2,3,Times} = {3,2,Times} = 6, but that is ok for our current purpouses.
Evaluating the results
Now we have our RPN evaluator and all those tuples, and we want to know if a certain final result is possible.
We simply have to ask if that number is contained in the set of results:
In[252]:= MemberQ[rpn /@ t3, 24]
Out[252]= True
In[253]:= MemberQ[rpn /@ t3, 38]
Out[253]= False
In fact the bounds for the result set are:
In[254]:= Max[rpn /@ t3]
Out[254]= Max[36, ComplexInfinity]
In[255]:= Min[rpn /@ t3]
Out[255]= Min[-23, ComplexInfinity]
The infinity results are due to the fact that I didn't care about divisions by zero, so they are there , just inside the set. The numeric interval is [-23,36].
If you want to know how many of the results are equal to 24, just count them
In[259]:= Length@Select[t3, rpn[#] == 24 &]
Out[259]= 484
Of course many of them are trivial permutations due to the commutative properties of "Plus" and "Times", but not all:
{1, 2, Plus, 3, Plus, 4, Times} -> ((1+2)+3)*4 = 24
{2, 1, 4, 3, Times, Divide, Divide} -> 2/(1/(4*3)) = 24
There are none sequence using "Subtract" that gives 24!
In[260]:= MemberQ[Flatten@Select[t3, rpn[#] == 24 &], Subtract]
Out[260]= False
Results Spectrum sample
