Question

To solve my problem it is natural to use base 3 numbers. I have several tables indexed by base 3 numbers, and at some point I need to go through all the indexes that differ in k digits from a given N-digit number.

For example, given 120 as a 3-digit base 3 number, the numbers differing in 1 digit would be:
020
220
100
110
121
122

I have some ugly code that does this the obvious way, but it is slow and hard to parallelize. Any idea how to do this efficiently?

(preferred language: c++)

Answer 1

Here is code in Mathematica. Documentation about the individual commands can be found in the Mathematica documentation center.

digitReplacements[num3_, n_, k_] :=
 Module[{len, num, num3T},
  len = Max[{n, IntegerLength[num3]}];
  num = List /@ IntegerDigits[num3, 3, len];
  Flatten[
   ParallelTable[
    num3T = num;
    num3T[[ss]] = num3T[[ss]] /. {{0} -> {1, 2}, {1} -> {0, 2}, {2} -> {0, 1}}; 
    IntegerString[FromDigits[#], 10, len] & /@ Tuples[num3T],
    {ss, Subsets[Range[len], {k}]}
    ], 1
   ]
  ]

A dissection of this code:

  len = Max[{n, IntegerLength[num3]}];
  num = List /@ IntegerDigits[num3, 3, len];

Assuming you want to include numbers with leading zeros the function gets the number of digits (n) as an argument. If you don’t do this the splitting of the number in its individual digits won’t generate n digits if it has leading zero’s. The second line converts a number like 2110 to a list {{2},{1},{1},{0}}. IntegerDigits does the splitting and List /@ maps List over the resulting digits, placing the extra curly brackets that we will need later.

    num3T = num;
    num3T[[ss]] = num3T[[ss]] /. {{0} -> {1, 2}, {1} -> {0, 2}, {2} -> {0, 1}}; 

Some of these sublists will be replaced (/. is the replacement operator, which replacements take part is determined by the list of positions in ss) by the set of complementary base 3 digits so that the command Tuples can make all possibles sets from them. For example Tuples[{{1,2},{3},{4,5}}]-==> {{1, 3, 4}, {1, 3, 5}, {2, 3, 4}, {2, 3, 5}}

    IntegerString[FromDigits[#], 10, len] & /@ Tuples[num3T],

The Tuples is at the end of the line. The first part is a pure function that acts on the result of the Tuplesfunction to turn it in a number again with FromDigits and to take care of leading zeros using IntegerString (the result is a string therefore, to allow for leading zeros).

The heart is the generation of the table of these tuples based on finding all possible replacement positions. This is done with the line Subsets[Range[len], {k}] which generates all subsets of a list {1,2,…,n} made by picking k numbers. The ParallelTable cycles over this list using the generated positions to replace all applicable digits at these positions to lists of possible counterparts. Generating this list of digit-change position seems a natural approach to parallelize the problem as you can dedicate pieces of the list to various cores. ParallelTable is a parallel computing variant of Mathematica’s standard Table function which takes care of this parallelization automatically.

Since every set of positions that ss takes generates a list of resulting numbers the end result is a list of lists. Flatten flattens this out to one list of numbers.

digitReplacements[120, 3, 1]

==> {"010", "210", "100", "120", "111", "112"}

digitReplacements[2012, 5, 2]

==>{"10112", "11112", "20112", "21112", "12012", "12212", \
    "22012", "22212", "12102", "12122", "22102", "22122", "12110", \
    "12111", "22110", "22111", "00012", "00212", "01012", "01212", \
    "00102", "00122", "01102", "01122", "00110", "00111", "01110", \
    "01111", "02002", "02022", "02202", "02222", "02010", "02011", \
    "02210", "02211", "02100", "02101", "02120", "02121"}

digitReplacements[1220101012201010, 16, 6] // Length // Timing

==> {0.671, 512512}

So, we find half a million sets in 0.671 seconds. If I change ParallelTablein Table it takes 3.463 seconds which is about 5 times slower. A bit surprising as I only have 4 cores, and usually parallel overhead eats up a considerable portion of potential speed gains.