我正在尝试使用 Mathematica 解决以下问题:
从集合中无法获得的最小正整数是多少{2,3,4,5,6,7,8}
通过算术运算{+,-,*,/}
、求幂和括号。集合中的每个数字必须仅使用一次。不允许一元运算(例如,如果不使用 0,则 1 无法转换为 -1)。
例如,数字1073741824000000000000000
可以通过获得(((3+2)*(5+4))/6)^(8+7)
.
我是 Mathematica 的初学者。我编写了我相信可以解决该组问题的代码{2,3,4,5,6,7}
(我得到了 2249 作为我的答案),但是我的代码效率不够高,无法使用该集合{2,3,4,5,6,7,8}
。 (我的代码在设备上运行已经需要 71 秒{2,3,4,5,6,7}
)
我非常感谢任何使用 Mathematica 解决这个难题的技巧或解决方案,或者关于如何加速现有代码的一般见解。
我现有的代码使用强力递归方法:
(* 这将一组 1 个数字的组合定义为该 1 个数字的集合 *)
combinations[list_ /; Length[list] == 1] := list
(*这测试是否可以对两个数字求幂,包括(某种程度上)任意限制以防止溢出*)
oktoexponent[number1_, number2_] :=
If[number1 == 0, number2 >= 0,
If[number1 < 0,
(-number1)^number2 < 10000 \[And] IntegerQ[number2],
number1^number2 < 10000 \[And] IntegerQ[number2]]]
(* 这需要一个列表并删除分母大于 100000 的分数 *)
cleanup[list_] := Select[list, Denominator[#] < 100000 &]
(* 这定义了一组 2 个数字的组合 - 并返回通过应用 + - * / 通过 oktoexponent 和清理规则过滤获得的所有可能数字的集合 *)
combinations[list_ /; Length[list] == 2 && Depth[list] == 2] :=
cleanup[DeleteCases[#, Null] &@DeleteDuplicates@
{list[[1]] + list[[2]],
list[[1]] - list[[2]],
list[[2]] - list[[1]],
list[[1]]*list[[2]],
If[oktoexponent[list[[1]], list[[2]]], list[[1]]^list[[2]],],
If[oktoexponent[list[[2]], list[[1]]], list[[2]]^list[[1]],],
If[list[[2]] != 0, list[[1]]/list[[2]],],
If[list[[1]] != 0, list[[2]]/list[[1]],]}]
(* 这扩展了组合以处理集合的集合 *)
combinations[
list_ /; Length[list] == 2 && Depth[list] == 3] :=
Module[{m, n, list1, list2},
list1 = list[[1]];
list2 = list[[2]];
m = Length[list1]; n = Length[list2];
cleanup[
DeleteDuplicates@
Flatten@Table[
combinations[{list1[[i]], list2[[j]]}], {i, m}, {j, n}]]]
(*对于给定的集合,分区将所有分区的集合返回为两个非空子集*)
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}