Как ускорить поиск целых чисел?

Question

Играя с целыми числами, я искал способ найти, скажем, $4$-цифровые положительные целые числа такие, что $a,b,a+b$ были такие же цифры, как $$1089 + 8019 = 9108$$ Я новичок и пользовался этой функцией

sd[a_, b_] := 
 If[Mod[a, 9] != 0 || Mod[b, 9] != 0 , False, 
  Sort[IntegerDigits[a + b]] == Sort[IntegerDigits[a]] && 
   Sort[IntegerDigits[a]] == Sort[IntegerDigits[b]]]

Затем я использовал функцию таким образом

Select[Flatten[
  Table[{h, k, sd[h, k]}, {h, 1000, 10000}, {k, h, 10000}], 1], #[[3]] &]

Но потребовались годы, чтобы получить результат.

Есть ли способ ускорить эту процедуру?

заранее спасибо

Answer 1

ClearAll[pairS]

pairS[n_] := SortBy[First] @
  Apply[Join] @
   KeyValueMap[Function[{k, v},
      Select[k == Sort@IntegerDigits@Total@# &]@Subsets[v, {2}]]] @
    GroupBy[Sort@*IntegerDigits] @
     (999 + 9 Range[10^(n - 1)])

Примеры:

 pairS[4] // AbsoluteTiming // First

0.0445052

pairS[5] // AbsoluteTiming // First

1.19877

Multicolumn[pairS[4], 5]

Length @ pairS[5] 

673

pairS[5] // Short[#, 7] &

В сторону: более медленный метод на основе графа: получить список ребер графа, в котором числа$a$ а также $b$ связаны, если $a$, $b$ а также $a+b$ имеют одинаковые целые цифры.

relation = Sort[IntegerDigits @ #] == Sort[IntegerDigits @ #2] == 
    Sort[IntegerDigits[# + #2]] &;

relationgraph = RelationGraph[relation, 999 + 9 Range[10^(4 - 1)]];

edges = EdgeList @ relationgraph;
 
List @@@ edges == pairS[4]

True

Subgraph[relationgraph, VertexList[edges], 
 GraphLayout -> "MultipartiteEmbedding", 
 GraphStyle -> "VintageDiagram", ImageSize -> Large]

Answer 2

Подход 1, более краткий

Clear[search];
search[n_] := 
   Join @@ Table[With[{s = Subsets[a, {2}]}, 
     Pick[s, Boole@MemberQ[a, Total@#] & /@ s, 1]], 
      {a, GatherBy[Select[Range[10^(n - 1), 10^n - 1], Divisible[#, 9] &], 
        Sort@*IntegerDigits]}];

search[4] // Length // AbsoluteTiming
search[5] // Length // AbsoluteTiming
search[6] // Length // AbsoluteTiming

{0,0210189, 25}
{0,212638, 648}
{9.23615, 17338}

Подход 2, более эффективный

Clear[cf]
cf = Compile[{{n, _Integer}, {A, _Integer, 2}},
   Module[{nums, ni, nj, B = Internal`Bag[Most@{0}]},
    Do[
     nums = Permutations[a]. 10^Range[n - 1, 0, -1];
     Do[
      ni = nums[[i]];
      nj = nums[[j]];
      If[ni + nj > 10^n || ni < 10^(n - 1), Break[]];
      Do[If[ni + nj == k, Internal`StuffBag[B, {ni, nj, k}, 1]; Break[]]
       , {k, nums}]
      , {i, Length@nums}, {j, i + 1, Length@nums}]
     , {a, A}];
    Internal`BagPart[B, All]
    ], CompilationTarget -> "C", RuntimeOptions -> "Speed"
   ];

n = 4;
AbsoluteTiming[
 digits = Select[# - Range[n] & /@ Subsets[Range[9 + n], {n}], Divisible[Total@#, 9] &];
 Length[ans = Partition[cf[n, digits], 3]]
 ]

Для n=4

{0,0014472, 25}

Для n=5,

{0,0094707, 648}

Для n=6,

{0.802517, 17338}

Сравните с ответом kglr

ClearAll[pairS]
pairS[n_] := 
  Apply[Join]@ KeyValueMap[Function[{k, v}, 
   Select[k == Sort@IntegerDigits@Total@# &]@Subsets[v, {2}]]]@
    GroupBy[Sort@*IntegerDigits]@(10^(n - 1) - 1 + 9 Range[10^(n - 1)])

pairS[4] // Length // AbsoluteTiming
pairS[5] // Length // AbsoluteTiming
pairS[6] // Length // AbsoluteTiming

{0.0362128, 25}
{0.945485, 648}
{40.879, 17338}

Answer 3

Но потребовались годы, чтобы получить результат.

На моем компьютере это заняло ~ 170 секунд; с ParallelTableэтим заняло ~ 97 секунд.

Я полагаю, что двукратного ускорения недостаточно, но получить его было очень легко.

Answer 4

Может, вне склона ...

Так как этот ассортимент вроде огромен. Так что лучше использовать Python Api?

ExternalEvaluate["Python", "[(i, j, i+j)for i in range(1000, 9999) for j in range(i, 9999-i)
 if sorted(str(i)) == sorted(str(j)) == sorted(str(i+j))]"] // AbsoluteTiming

{27.2873, {{1089, 8019, 9108}, {1089, 8091, 9180}, {1269, 1692, 
            2961}, {1467, 6147, 7614}, {1467, 6174, 7641}, {1476, 4671, 
            6147}, {1503, 3510, 5013}, {1530, 3501, 5031}, {1746, 4671, 
            6417}, {2385, 2853, 5238}, {2439, 2493, 4932}, {2502, 2520, 
            5022}, {2538, 3285, 5823}, {2691, 6921, 9612}, {2853, 5382, 
            8235}, {3285, 5238, 8523}, {4095, 4950, 9045}, {4095, 5409, 
            9504}, {4392, 4932, 9324}, {4590, 4950, 9540}, {4599, 4995, 
            9594}, {4698, 4986, 9684}, {4797, 4977, 9774}, {4896, 4968, 
            9864}, {4959, 4995, 9954}}}

стоит 27 шиллингов

В отличие от исходного кода, который на моем ПК занимает 233,128 секунды.

Answer 5

Разделите числа от 1000 до 9999 на несколько сотен наборов целых чисел с одинаковыми цифрами, например [1234, 1243, 1324, 1342, 1423, 1432 ...]. Тогда a и b должны быть в одном наборе, и a + b также должны быть в этом наборе. Таким образом, вы перебираете около 400 наборов S целых чисел, затем перебираете все элементы a <5000 набора S, перебираете b по всем элементам набора S с a ≤ b ≤ 9999-a, а затем проверяете, есть ли a + b также является элементом S. Должны занять миллисекунды.