Wolfram mathematica 无法从{2,3,4,5,6,7,8}中获得的最小整数（Mathematica）

我试图用Mathematica解决以下问题：

通过算术运算{code>{+，-，*，/}，指数运算和括号，无法从集合{code>{2,3,4,5,6,7,8}中获得的最小正整数是什么。集合中的每个数字必须精确使用一次。不允许进行一元操作（例如，使用0时无法将1转换为-1）

例如，数字

107374182400000000000

可通过

（（3+2）*（5+4））/6^（8+7）

获得

我是Mathematica的初学者。我已经编写了我认为可以解决集合

{2,3,4,5,6,7}

问题的代码（我的答案是2249），但是我的代码没有足够的效率来处理集合

{2,3,4,5,6,7,8}

。（我的代码在集合

{2,3,4,5,6,7}

上运行已经需要71秒）

我将非常感谢任何使用Mathematica解决这个更难的问题的提示或解决方案，或者关于如何加快现有代码速度的一般见解

我现有的代码使用了蛮力递归方法：

（*这将一组1个数字的组合定义为该1个数字的集合*）

（*测试两个数字是否可以求幂，包括（某种程度上）防止溢出的任意限制*）

（*这扩展了组合以使用集合集合*）

（*对于给定的集合，partition将所有分区的集合返回为两个非空子集*）

（*这最终扩展了组合以处理任意大小的集合*）

组合[list_/；长度[list]>2]：=
模块[{分区，k}，
分区=分区[列表]；
k=长度[分区]；
清理[分类]@
删除重复项@
展平@（组合/@
表[{组合[分区[[i]][[1]]]，
组合[partitions[[i]][[2]]}，{i，k}]]]
定时[desiredset=组合[{2,3,4,5,6,7}]；]
{71.5454，Null}
补足[
范围为[1，3000]，#]&@（Cases[#，x#u Integer/；x>0&&x这是没有帮助的，但我今天的胡言乱语量不足：

(* it turns out the symbolizing + * is not that useful after all *) 
f[x_,y_] = x+y 
fm[x_,y_] = x-y 
g[x_,y_] = x*y 
gd[x_,y_] = x/y 

(* power properties *) 
h[h[a_,b_],c_] = h[a,b*c] 
h[a_/b_,n_] = h[a,n]/h[b,n] 
h[1,n_] = 1 

(* expand simple powers only! *) 
(* does this make things worse? *) 
h[a_,2] = a*a 
h[a_,3] = a*a*a 

(* all symbols for two numbers *) 
allsyms[x_,y_] := allsyms[x,y] =  
 DeleteDuplicates[Flatten[{f[x,y], fm[x,y], fm[y,x],  
 g[x,y], gd[x,y], gd[y,x], h[x,y], h[y,x]}]] 

allsymops[s_,t_] := allsymops[s,t] =  
 DeleteDuplicates[Flatten[Outer[allsyms[#1,#2]&,s,t]]] 

Clear[reach]; 
reach[{}] = {} 
reach[{n_}] := reach[n] = {n} 
reach[s_] := reach[s] = DeleteDuplicates[Flatten[ 
 Table[allsymops[reach[i],reach[Complement[s,i]]],  
  {i,Complement[Subsets[s],{ {},s}]}]]] 

这里的总体思路是避免计算幂（即
昂贵且不可交换），同时使用
加法/乘法的交换性/结合性，以减少
到达基数[]

上述代码也可从以下网址获得：


还有千兆字节的其他无用代码、数据和幽默。
我认为你问题的答案在于命令。这允许你创建一个列表的二叉树。二叉树非常有用，因为你允许的每个操作都有两个参数。例如

In>  Groupings[3,2]
Out> {List[List[1,2],3],List[1,List[2,3]]}

因此，我们所需要做的就是用允许的操作的任意组合替换
List

然而，
Groupings
似乎是万能的，因为它有一个选项可以做到这一点。假设您有两个函数
foo
和
bar
，并且都使用
2
参数，那么您可以按照以下方式进行所有组合：

In>  Groupings[3,{foo->2,bar->2}]
Out> {foo[foo[1,2],3],foo[1,foo[2,3]],foo[bar[1,2],3],foo[1,bar[2,3]],
      bar[foo[1,2],3],bar[1,foo[2,3]],bar[bar[1,2],3],bar[1,bar[2,3]]}

现在可以计算我们拥有的组合数量：

In>  Groupings[Permutations[#],
               {Plus->2,Subtract->2,Times->2,Divide->2,Power->2}
              ] &@ {a,b,c,d,e};
In>  Length@%
In>  DeleteDuplicates@%%
In>  Length@%
Out> 1050000
Out>  219352

这意味着对于5个不同的数字，我们有219352个唯一的组合

遗憾的是，由于溢出、零除法或下溢，这些组合中的许多组合无法计算。但是，不清楚要删除哪些组合。值
a^（b^（c^（d^e））
可能很大，也可能很小。分数幂可能导致完美根，而大数除法可能会变得完美

In>  Groupings[Permutations[#],
               {Plus->2,Subtract->2,Times->2,Divide->2,Power->2}
              ] &@ {2, 3, 4};
In>  Union[Cases[%, _?(IntegerQ[#] && # >= 0 &)]];
In>  Split[%, #2 - #1 <= 1 &][[1]]
Out> {1, 2, 3, 4, 5, 6}

In>分组[排列[#]，
{加->2，减->2，倍->2，除->2，幂->2}
] &@ {2, 3, 4};
在>并集[Cases[%，x0]（IntegerQ[#]&&&&&&&&&>0&）]；
在>拆分[%，#2-#1{1,2,3,4,5,6}
好吧，如果你给我们看你的代码，而不是它的草图，我们中的一些人会剪切、粘贴和摆弄。不知何故，这听起来像是学校的作业……我现在就发布我的代码-最初没有发布，只是因为我知道我是一个初学者，并且预计最佳代码需要完全重写。Jari，不太知道是什么说——不是——我正在努力学习Mathematica，并且一直在学习欧拉项目的问题。这是我个人为自己设定的一个问题。我在这里@Royce回答了一个类似的问题，以确认这不是一个projecteuler.net问题，对吗？换句话说，你知道没有在线解决方案对于这个问题？我的想法是：我不认为你可以安全地扔掉大的中间结果（溢出），因为它们可能会再次变小。我建议使用一种符号方法（不一定使用Mathematica），简化每一轮的符号（即，“2*3”和“3*2”是相同的）。
partition[list_] := Module[{subsets},
  subsets = Select[Subsets[list], # != {} && # != list &]; 
  DeleteDuplicates@
   Table[Sort@{subsets[[i]], Complement[list, subsets[[i]]]}, {i, 
     Length[subsets]}]]

combinations[list_ /; Length[list] > 2] := 
 Module[{partitions, k},
  partitions = partition[list];
  k = Length[partitions]; 
  cleanup[Sort@
    DeleteDuplicates@
     Flatten@(combinations /@ 
        Table[{combinations[partitions[[i]][[1]]], 
          combinations[partitions[[i]][[2]]]}, {i, k}])]]

Timing[desiredset = combinations[{2, 3, 4, 5, 6, 7}];]

{71.5454, Null}

Complement[
   Range[1, 3000], #] &@(Cases[#, x_Integer /; x > 0 && x <= 3000] &@
   desiredset)

{2249, 2258, 2327, 2509, 2517, 2654, 2789, 2817, 2841, 2857, 2990, 2998}

(* it turns out the symbolizing + * is not that useful after all *) 
f[x_,y_] = x+y 
fm[x_,y_] = x-y 
g[x_,y_] = x*y 
gd[x_,y_] = x/y 

(* power properties *) 
h[h[a_,b_],c_] = h[a,b*c] 
h[a_/b_,n_] = h[a,n]/h[b,n] 
h[1,n_] = 1 

(* expand simple powers only! *) 
(* does this make things worse? *) 
h[a_,2] = a*a 
h[a_,3] = a*a*a 

(* all symbols for two numbers *) 
allsyms[x_,y_] := allsyms[x,y] =  
 DeleteDuplicates[Flatten[{f[x,y], fm[x,y], fm[y,x],  
 g[x,y], gd[x,y], gd[y,x], h[x,y], h[y,x]}]] 

allsymops[s_,t_] := allsymops[s,t] =  
 DeleteDuplicates[Flatten[Outer[allsyms[#1,#2]&,s,t]]] 

Clear[reach]; 
reach[{}] = {} 
reach[{n_}] := reach[n] = {n} 
reach[s_] := reach[s] = DeleteDuplicates[Flatten[ 
 Table[allsymops[reach[i],reach[Complement[s,i]]],  
  {i,Complement[Subsets[s],{ {},s}]}]]] 

In>  Groupings[3,2]
Out> {List[List[1,2],3],List[1,List[2,3]]}

In>  Groupings[3,{foo->2,bar->2}]
Out> {foo[foo[1,2],3],foo[1,foo[2,3]],foo[bar[1,2],3],foo[1,bar[2,3]],
      bar[foo[1,2],3],bar[1,foo[2,3]],bar[bar[1,2],3],bar[1,bar[2,3]]}

In>  Groupings[Permutations[#],
               {Plus->2,Subtract->2,Times->2,Divide->2,Power->2}
              ] &@ {a,b,c,d,e};
In>  Length@%
In>  DeleteDuplicates@%%
In>  Length@%
Out> 1050000
Out>  219352

In>  Groupings[Permutations[#],
               {Plus->2,Subtract->2,Times->2,Divide->2,Power->2}
              ] &@ {2, 3, 4};
In>  Union[Cases[%, _?(IntegerQ[#] && # >= 0 &)]];
In>  Split[%, #2 - #1 <= 1 &][[1]]
Out> {1, 2, 3, 4, 5, 6}