0
$\begingroup$

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?

Thanks in advance.

$\endgroup$
7
  • $\begingroup$ re: visually see the value of n: the simplest way is just to add a Dynamic[n] and watch the number. $\endgroup$
    – Carl Lange
    Commented Dec 19, 2021 at 14:39
  • $\begingroup$ @CarlLange Found it and edited my question accordingly. $\endgroup$ Commented Dec 19, 2021 at 14:48
  • $\begingroup$ Ah, indeed, Monitor is a simpler way! $\endgroup$
    – Carl Lange
    Commented Dec 19, 2021 at 14:55
  • $\begingroup$ @CarlLange Yes, but this does not help me speeding up the calculation. $\endgroup$ Commented Dec 19, 2021 at 14:57
  • $\begingroup$ 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. $\endgroup$
    – josh
    Commented Dec 19, 2021 at 15:44

1 Answer 1

3
$\begingroup$

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]
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.