从给定的数字和运算集创建表达式树，并在 Mathematica 8 或更高版本中查找计算结果为目标数字的表达式树

发布于 2024-12-12 12:23:49 字数 844 浏览 3 评论 0原文

给定一组数字和一组二元运算，在 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 个运算符的情况给出其性能：

随机样本和随机样本。选择：约 25K 棵树/第二次
彻底扫描：约 2.15 秒内 806400 棵树

（在笔记本电脑上计时：Intel(R) Core(TM)2 Duo CPU T9300 @ 2.50GHz，3GB 内存，尚未使用并行化，但将是最多的欢迎回答）

我的笔记本现在有点乱。因此，我首先很乐意提出问题，并希望在清理代码以供共享时得到原创的想法和答案。

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

方法在最大情况下的性能是：

随机样本&选择：~21K 树/第二次
彻底扫描：~100 秒内 23224320 棵树

另外，我正在使用 Mathematica 8.0.1，所以如果有任何方法可以在 OpenCL 中做到这一点，或者使用 CompilationTarget-> 的编译函数，我会全力以赴。 “C”等

原文

Given a set of numbers and a set of binary operations,
what is the fastest way to create random expression trees or exhaustively check every possible combination in Mathematica?

What I am trying to solve is given:

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

find expression trees that would evaluate to target.

I have two solutions whose performances I give for the case where expression trees contain exactly 4 of the numbers and 3 operators:

random sample & choice: ~25K trees / second
exhaustive scan: 806400 trees in ~2.15 seconds

(timed on a laptop with: Intel(R) Core(TM)2 Duo CPU T9300 @ 2.50GHz, 3GB ram, no parallelization used yet but would be most welcome in answers)

My notebooks are a bit messy at the moment. So I would first love to pose the question and hope for original ideas and answers while I clean up my code for sharing.

Largest possible case is where every expression tree uses up all the (6) numbers and 'Length[numbers]-1' (5) operators.

Performance of methods in the largest case is:

random sample & choice: ~21K trees / second
exhaustive scan: 23224320 trees in ~100 seconds

Also I am using Mathematica 8.0.1 so I am more than all ears if there are any ways to do it in OpenCL or using compiled functions wiht CompilationTarget->"C", etc.

分享到QQ

分享到微博

如果你对这篇内容有疑问，欢迎到本站社区发帖提问参与讨论，获取更多帮助，或者扫码二维码加入 Web 技术交流群。

发布评论

需要登录才能够评论，你可以免费注册一个本站的账号。

风吹短裙飘 2024-12-19 12:23:49

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

执行此操作（当您将其粘贴到笔记本中时，它看起来更合理）：

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 次尝试，它获得了正确的运算符和数字顺序。

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

OK, this is not elegant or fast, and it's buggy, but it works (sometimes). It uses a monte carlo method, implementing the metropolis algorithm for a weight function that I (arbitrarily) selected just to see if this would work. This was some time ago for a similar problem; I suppose my mathematica skills have improved as it looks ugly now, but I have no time to fix it at the moment.

Execute this (it looks more reasonable when you paste it into a notebook):

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}])]]

then to solve your actual problem, do

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]

and then to see that it worked,

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

giving

enter image description here

thus, it obtained the correct order of operators and numbers after around 2000 tries.

As I said, it's ugly, inefficient, and badly programmed as it was a quick-and-dirty adaptation of a quick-and-dirty hack. If you're interested I can clean up and explain the code.

回复收藏 0 原文

熊抱啵儿 2024-12-19 12:23:49

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

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

它这样做通过使用适当的操作不断折叠数字对。

现在我有了评估表达式树的方法，我只需要生成它们。使用元组，我能够生成散布在数字之间的所有不同运算符。

获得所有可能的操作后，我使用 Select 挑选出计算结果为目标数字的操作。

缺点

上面的解决方案确实很慢。生成所有可能的元组的时间是指数级的。如果有 k 次操作和 n 个数字，则其数量级为 O(k^n)。

对于 n = 10，在 Win 7 x64、Core i7 860、12 GB RAM 上完成需要 6 秒。运行时间与理论时间复杂度几乎完全一致：

Timings

红线是理论值，蓝色是实验值。 x 轴是 nums 输入的大小，y 轴是枚举所有解决方案的时间（以秒为单位）。

上述解决方案也使用函数式编程风格解决了该问题。它看起来很漂亮，但它也会占用大量内存，因为它几乎每一步都存储完整的结果。

它甚至没有利用并行化，而且我不完全确定您将如何并行化我生成的解决方案。

一些限制

向导先生提醒我注意，此代码仅解决特定的一组解决方案。给定一些输入，例如 {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]]

This was a fun question. Here's my full solution:

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, #]) &]

Usage example:

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

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

Outputs:

{{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]}

How it works

The ExprEval function takes in the numbers and operations, and applies them using (I think) RPN:

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

It does this by continually folding pairs of numbers using the appropriate operation.

Now that I have a way to evaluate an expression tree, I just needed to generate them. Using Tuples, I'm able to generate all the different operators that I would intersperse between the numbers.

Once you get all possible operations, I used Select to pick out the the ones that evaluate to the target number.

Drawbacks

The solution above is really slow. Generating all the possible tuples is exponential in time. If there are k operations and n numbers, it's on the order of O(k^n).

For n = 10, it took 6 seconds to complete on Win 7 x64, Core i7 860, 12 GB RAM. The timings of the runs match the theoretical time complexity almost exactly:

Timings

Red line is the theoretical, blue is experimental. The x-axis is size of the nums input and the y-axis is the time in seconds to enumerate all solutions.

The above solution also solves the problem using a functional programming style. It looks pretty, but the thing also sucks up a butt ton of memory since it's storing the full results at nearly every step.

It doesn't even make use of parallelization, and I'm not entirely certain how you would even parallelize the solution I produced.

Some limitations

Mr. Wizard brought to my attention that this code only solves for only particular set of solutions. Given some input such as {a, b, c, d, e, ... } it only permutes the operators in between the numbers. It doesn't permute the ordering of the numbers. If it were to permute the numbers as well, the time complexity would rise up to O(k^n * n!) where k is the number of operators and n is the length of the input number array.

The following will produce the set of solutions for any permutation of the input numbers and operators:

(* 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]]

回复收藏 0 原文

~没有更多了~