从给定的数字和操作集创建表达式树,并在Mathematica 8或更高版本中查找评估为目标数的表达式树

Question

给定一组数字和一组二元运算,创建随机表达式树的最快方法是什么,或者在Mathematica中详尽检查每个可能的组合？

我想解决的是:

numbers={25,50,75,100,3,6}              (* each can ONLY be used ONCE  *)
operators={Plus,Subtract,Times,Divide}  (* each can be used repeatedly *)
target=99

找到要评估为目标的表达式树.

我有两个解决方案,我给出了表达式树包含4个数字和3个运算符的情况:

1. 随机抽样和选择:约25K树/秒
2. 彻底扫描:在~2.15秒内有806400棵树

(定时在笔记本电脑上使用:Intel(R)Core(TM)2 Duo CPU T9300 @ 2.50GHz,3GB内存,尚未使用并行化,但在答案中非常受欢迎)

我的笔记本目前有点乱.因此,当我清理代码进行共享时,我首先想提出问题并希望获得原创想法和答案.

最大可能的情况是每个表达式树使用所有(6)数字和'Length [数字] -1'(5)运算符.

最大案例中方法的表现是:

1. 随机抽样和选择:~21K树/秒
2. 穷举扫描:在约100秒内完成23224320棵树

我也在使用Mathematica 8.0.1,所以如果有任何方法可以在OpenCL中使用或使用编译函数与CompilationTarget - >"C"等,我不仅仅是所有的耳朵.

Answer 1

这是一个有趣的问题.这是我的完整解决方案:

ExprEval[nums_, ops_] := Fold[
  #2[[1]][#1, #2[[2]]] &,
  First@nums,
  Transpose[{ops, Rest@nums}]]

SymbolicEval[nums_, ops_] := ExprEval[nums, ToString /@ ops]

GetExpression[nums_, ops_, target_] := Select[
  Tuples[ops, Length@nums - 1],
  (target == ExprEval[nums, #]) &]

用法示例:

nums = {-1, 1, 2, 3};
ops = {Plus, Subtract, Times, Divide};
solutions = GetExpression[nums, ops, 3]

ExprEval[nums, #] & /@ solutions
SymbolicEval[nums, #] & /@ solutions

输出:

{{Plus, Times, Plus}, {Plus, Divide, Plus}, {Subtract, Plus, 
  Plus}, {Times, Plus, Times}, {Divide, Plus, Times}}

{3, 3, 3, 3, 3}

{"Plus"["Times"["Plus"[-1, 1], 2], 3], 
 "Plus"["Divide"["Plus"[-1, 1], 2], 3], 
 "Plus"["Plus"["Subtract"[-1, 1], 2], 3], 
 "Times"["Plus"["Times"[-1, 1], 2], 3], 
 "Times"["Plus"["Divide"[-1, 1], 2], 3]}

这个怎么运作

该ExprEval函数接受数字和操作,并使用(我认为)RPN应用它们:

ExprEval[{1, 2, 3}, {Plus, Times}] == (1 + 2) * 3

它通过使用适当的操作连续折叠数字对来实现这一点.

既然我有办法评估表达式树,我只需要生成它们.使用Tuples,我能够生成所有不同的运算符,我会在数字之间穿插.

一旦你完成了所有可能的操作,我Select就会挑选出那些评估目标数量的操作.

缺点

上面的解决方案非常慢.生成所有可能的元组是指数的时间.如果有k个运算和n个数,则它的顺序为O(k ^ n).

因为n = 10,在Win 7 x64,Core i7 860,12 GB RAM上完成需要6秒钟.运行的时间几乎完全符合理论时间复杂度:

红线是理论上的,蓝色是实验性的.x轴是nums输入的大小,y轴是枚举所有解决方案的时间(秒).

上述解决方案还使用函数编程风格解决了该问题.它看起来很漂亮,但这个东西也吸收了大量的内存,因为它几乎每一步都存储了完整的结果.

它甚至没有使用并行化,我也不完全确定你如何并行化我生成的解决方案.

一些限制

Wizard先生提请我注意,此代码仅解决了特定的解决方案.给定一些输入,例如{a, b, c, d, e, ... }它只会在数字之间置换运算符.它不会排列数字的顺序.如果它是来排列的号码以及,时间复杂度将上升到O(k^n * n!)哪里k是运营商的数量和n为输入数值列的长度.

以下将为输入数字和运算符的任何排列产生一组解决方案:

(* generates a lists of the form 
{
 {number permutation, {{op order 1}, {op order 2}, ... }
 }, ...
}*)

GetAllExpressions[nums_, ops_, target_] :=
 ParallelMap[{#, GetExpression[#, ops, target]} &, 
  Tuples[nums, Length@nums]]

Answer 2

好吧，这并不优雅或快速，而且有缺陷，但它（有时）有效。它使用 蒙特卡罗方法，为我（任意）选择的权重函数实现都会算法，只是为了看看这是否可行。这是前一段时间遇到的类似问题；我想我的数学技能已经提高了，因为它现在看起来很丑，但我现在没有时间修复它。

执行这个（粘贴到笔记本中看起来更合理）：

ClearAll[swap];
swap[lst_, {p1_, p2_}] := 
 ReplacePart[
  lst, {p1 \[Rule] lst\[LeftDoubleBracket]p2\[RightDoubleBracket], 
   p2 \[Rule] lst\[LeftDoubleBracket]p1\[RightDoubleBracket]}]

ClearAll[evalops];
(*first element of opslst is Identity*)

evalops[opslst_, ord_, nums_] := 
 Module[{curval}, curval = First@nums;
  Do[curval = 
    opslst\[LeftDoubleBracket]p\[RightDoubleBracket][curval, 
     nums\[LeftDoubleBracket]ord\[LeftDoubleBracket]p\
\[RightDoubleBracket]\[RightDoubleBracket]], {p, 2, Length@nums}];
  curval]

ClearAll[randomizeOrder];
randomizeOrder[ordlst_] := 
 swap[ordlst, RandomInteger[{1, Length@ordlst}, 2]]

ClearAll[randomizeOps];
(*never touch the first element*)

randomizeOps[oplst_, allowedOps_] := 
 ReplacePart[
  oplst, {RandomInteger[{2, Length@oplst}] \[Rule] RandomChoice[ops]}]

ClearAll[takeMCstep];
takeMCstep[goal_, opslst_, ord_, nums_, allowedops_] := 
 Module[{curres, newres, newops, neword, p}, 
  curres = evalops[opslst, ord, nums];
  newops = randomizeOps[opslst, allowedops];
  neword = randomizeOrder[ord];
  newres = evalops[newops, neword, nums];
  Switch[Abs[newres - goal], 
   0, {newops, 
    neword}, _, (p = Abs[curres - goal]/Abs[newres - goal];
    If[RandomReal[] < p, {newops, neword}, {opslst, ord}])]]

然后为了解决你的实际问题，做

ops = {Times, Plus, Subtract, Divide}
nums = {25, 50, 75, 100, 3, 6}
ord = Range[Length@nums]
(*the first element is identity to simplify the logic later*)
oplist = {Identity}~Join~RandomChoice[ops, Length@nums - 1]
out = NestList[
  takeMCstep[
    99, #\[LeftDoubleBracket]1\[RightDoubleBracket], #\
\[LeftDoubleBracket]2\[RightDoubleBracket], nums, ops] &, {oplist, 
   ord}, 10000]

然后看看它是否有效，

ev = Map[evalops[#\[LeftDoubleBracket]1\[RightDoubleBracket], #\
\[LeftDoubleBracket]2\[RightDoubleBracket], nums] &, out];
ev // Last // N
ev // ListPlot[#, PlotMarkers \[Rule] None] &

给予

因此，它在大约 2000 次尝试后获得了正确的运算符和数字顺序。

正如我所说，它是丑陋的、低效的，而且编程很糟糕，因为它是对快速而肮脏的黑客的快速而肮脏的改编。如果您有兴趣，我可以清理并解释代码。