无法从 {2,3,4,5,6,7,8} 获得的最小整数(Mathematica) [英] smallest integer not obtainable from {2,3,4,5,6,7,8} (Mathematica)

问题描述

我正在尝试使用 Mathematica 解决以下问题:

I'm trying to solve the following problem using Mathematica:

不能从集合{2,3,4,5,6,7,8}中通过算术运算得到的最小正整数是多少{+,-,*,/}、求幂和括号.集合中的每个数字必须恰好使用一次.不允许一元运算(例如，1 不能在不使用 0 的情况下转换为 -1).

What is the smallest positive integer not obtainable from the set {2,3,4,5,6,7,8} via arithmetic operations {+,-,*,/}, exponentiation, and parentheses. Each number in the set must be used exactly once. Unary operations are NOT allowed (1 cannot be converted to -1 with without using a 0, for example).

例如，数字 1073741824000000000000000 可通过 (((3+2)*(5+4))/6)^(8+7) 获得.

For example, the number 1073741824000000000000000 is obtainable via (((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 秒)

I am a beginner with Mathematica. I have written code that I believe solves the problems for the set {2,3,4,5,6,7} (I obtained 2249 as my answer), but my code is not efficient enough to work with the set {2,3,4,5,6,7,8}. (My code already takes 71 seconds to run on the set {2,3,4,5,6,7})

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

I would very much appreciate any tips or solutions to solving this harder problem with Mathematica, or general insights as to how I could speed my existing code.

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

My existing code uses a brute force, recursive approach:

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

(* this defines combinations for a set of 1 number as the set of that 1 number *)

combinations[list_ /; Length[list] == 1] := list

(* 这测试是否可以对两个数字取幂，包括(有点)任意限制以防止溢出 *)

(* this tests whether it's ok to exponentiate two numbers including (somewhat) arbitrary restrictions to prevent overflow *)

oktoexponent[number1_, number2_] :=

 If[number1 == 0, number2 >= 0,
  If[number1 < 0,
   (-number1)^number2 < 10000 \[And] IntegerQ[number2],
   number1^number2 < 10000 \[And] IntegerQ[number2]]]

(* 这需要一个列表并删除分母大于 100000 的分数 *)

(* this takes a list and removes fractions with denominators greater than 100000 *)

cleanup[list_] := Select[list, Denominator[#] < 100000 &]

(* 这定义了一组 2 个数字的组合 - 并返回通过应用 + - * 获得的所有可能数字的集合/通过 oktoexponent 和清理规则过滤 *)

(* this defines combinations for a set of 2 numbers - and returns a set of all possible numbers obtained via applications of + - * / filtered by oktoexponent and cleanup rules *)

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

(* 这扩展了组合以使用集合 *)

(* this extends combinations to work with sets of sets *)

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 将所有分区的集合返回为两个非空子集 *)

(* for a given set, partition returns the set of all partitions into two non-empty subsets *)

partition[list_] := Module[{subsets},
  subsets = Select[Subsets[list], # != {} && # != list &]; 
  DeleteDuplicates@
   Table[Sort@{subsets[[i]], Complement[list, subsets[[i]]]}, {i, 
     Length[subsets]}]]

(* 这最终扩展了组合以适用于任何大小的集合 *)

(* this finally extends combinations to work with sets of any size *)

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}

推荐答案

我认为您的问题的答案在于命令 分组.这允许您创建列表的二叉树.二叉树非常有用，因为您允许 Plus、Subtract、Times、Divide、Power 的每个操作都带有两个参数.例如.

I think the answer to your question lays in the command Groupings. This allows you to create a binary tree of a list. The binary tree is very usefull as each of the operations you allow Plus, Subtract, Times, Divide, Power take two arguments. Eg.

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

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

Thus all we need to do is replace List with any combination of the allowed operations.

然而，Groupings 似乎是万能的，因为它有一个选项可以做到这一点.假设您有两个函数 foo 和 bar 并且都接受 2 参数，那么您可以将所有组合设为:

However, Groupings seems to be almighty as it has an option to do this. Imagine you have two functions foo and bar and both take 2 arguments, then you can make all combinations as :

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

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

Now it is possible to count the amount of combinations we have :

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 个独特的组合.

This means that for 5 distinct numbers, we have 219352 unique combinations.

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

Sadly, many of these combinations cannot be evaluated due to overflow, division by zero or underflow. However, it is not evident which ones to remove. The value a^(b^(c^(d^e))) could be humongous, or just small. Fractional powers could result in perfect roots and divisions by large numbers can become perfect.

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}

这篇关于无法从 {2,3,4,5,6,7,8} 获得的最小整数(Mathematica)的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！