How to speed up integers finding function?

Question

Playing with integers I looked for a way of finding, let's say, $4$-digits positive integers such that $a,b,a+b$ had the same digits, like $$1089 + 8019 = 9108$$
I am a newbie and I used this function
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]]]

Then I used the function in this way
Select[Flatten[
  Table[{h, k, sd[h, k]}, {h, 1000, 10000}, {k, h, 10000}], 1], #[[3]] &]

But it took ages to give the output.
Is there a way to speed up this procedure?
Thanks in advance

kglr · Accepted Answer

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

Examples:
 pairS[4] // AbsoluteTiming // First

0.0445052

pairS[5] // AbsoluteTiming // First

1.19877

Multicolumn[pairS[4], 5]

Length @ pairS[5]

673

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

An aside: A slower graph-based method: get the edge list of a graph where the numbers $a$ and $b$ are connected if $a$, $b$ and $a+b$ have the same integer digits.
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]

chyanog · Answer

Approach 1, more concise
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}

Approach 2, more efficient
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]]
 ]

For n=4

{0.0014472, 25}

For n=5,

{0.0094707, 648}

For n=6,

{0.802517, 17338}

Compare with kglr's answer
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}

gnasher729 · Answer

Divide the numbers from 1000 to 9999 into a few hundred sets of integers that have the same digits, for example [1234, 1243, 1324, 1342, 1423, 1432 ... ]. Then a and b must be in the same set, and a+b must be in that set as well. So you loop over the 400 or so sets S of integers, then iterate over all elements a < 5000 of the set S, iterate b over all elements of the set S with a ≤ b ≤ 9999-a, and then check if a+b is an element of S as well. Should take milliseconds.

Answered by gnasher729 on February 13, 2021

wuyudi · Answer

Maybe out of slope...
Since this range is kind of huge. So use Python's Api maybe a better choice?
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}}}

costs 27s

Contrast to origin code which takes 233.128s on my PC.

Anton Antonov · Answer

But it took ages to give the output.

It took ~170 seconds on my computer; with ParallelTable it took ~97 seconds.
I assume two-times speed-up is not good enough, but it was very easy to get it.

How to speed up integers finding function?

5 Answers

Add your own answers!

Ask a Question