# Parallelization in While[] loop when testing if a condition is met

Well, I am trying to run the following code:

Clear["Global*"];
k = 47;
x = ToString[Sum[1*10^n, {n, 0, k - 1}]];
n = FromDigits[x, 2];
a = IntegerDigits[n, 2];
Monitor[Parallelize[
While[True,
If[GCD[FromDigits[a], FromDigits[Reverse[a]]] == k &&
Total[a] == k, Break[]]; n++]; n], n]


Which runs in a While[] loop and tests whenever GCD[FromDigits[a], FromDigits[Reverse[a]]] == k and Total[a] == k rerturn True.

Is there a way to speed up this calculation using parallelization?

• re: visually see the value of n: the simplest way is just to add a Dynamic[n] and watch the number. Commented Dec 19, 2021 at 14:39
• @CarlLange Found it and edited my question accordingly. Commented Dec 19, 2021 at 14:48
• Ah, indeed, Monitor is a simpler way! Commented Dec 19, 2021 at 14:55
• @CarlLange Yes, but this does not help me speeding up the calculation. Commented Dec 19, 2021 at 14:57
• As written, looks like you're using n before defining it: you define "a" as a function of "n" but you don't define what "n" is until further in the code sequence.
– josh
Commented Dec 19, 2021 at 15:44

Base on what I understand, you're looking for numbers whose number of 1 bit in its binary format is 47 and GCD of the FromDigits of the binary, and its reversed should be 47

Populate the possible answers by creating a list by repeating 1, 47 times and then add 0 to different parts of it. (sum will remain 47 but GCD should be checked)

Define a test function:

ClearAll[test];
test[l_] := GCD[FromDigits[l], FromDigits[Reverse[l]]] === 47


I used Permutations to find all the cases 0 could be inserted in the list and went as far as inserting 4 zero (you could go further but computation gets heavier).

Select[Join[
Permutations[Join[ConstantArray[1, 47], {0}]],
Permutations[Join[ConstantArray[1, 47], {0, 0}]],
Permutations[Join[ConstantArray[1, 47], {0, 0, 0}]],
Permutations[Join[ConstantArray[1, 47], {0, 0, 0, 0}]]
], test]

(* Out: {{1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1},

{1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1},

... } *)


90 different combinations will be returned in less than 2 seconds.

Also, you could use a refined version of the code:

Select[Catenate@
Table[Permutations[
Join[ConstantArray[1, 47], ConstantArray[0, i]]], {i, 1, 4}], test]
`