4
$\begingroup$

According to The Pi-Search Page, in the first 100 million digits of $\pi$ the following numbers are self-locating: 1, 16470, 44899, 79873884.

The following inefficient code (which also does not handle the case of leading 0 digit) finds 16470 and 44899:

Module[{n, k = 5}, n = 10^k - 1; 
  Position[Apply[Equal, Transpose[{Range[n], FromDigits /@ 
    Partition[Rest@First@RealDigits[Pi, 10, n + k], k, 1]}], 1],True]]

What is an efficient way to find other "fixed points"—and is there an elegant way to use FixedPoint to find self-locating digit sequences?

$\endgroup$
  • 2
    $\begingroup$ Module[{n, m, k = 5}, n = 10^k - 1; m = 10^(k - 1); Pick[Range[m, n], Total /@ Unitize[ Subtract[ IntegerDigits /@ Range[m, n], (Partition[First@RealDigits[Pi - 3, 10, n + k - 1], k, 1])[[m ;; n]]]], 0]] is much faster. $\endgroup$ – kglr Aug 9 '18 at 7:32
4
$\begingroup$

This should be able to treat leading zeroes and is ten times faster:

A precompiled function:

cf = Compile[{{a, _Integer, 1}, {z, _Integer}},
   Block[{b, i, j},
    b = IntegerDigits[z, 10];
    i = z;
    While[Compile`GetElement[a, i] == 0, i++];
    j = 1;
    While[
     j < Length[b] && 
      Compile`GetElement[a, i] == Compile`GetElement[b, j],
     i++;
     j++;
     ];
    Boole[
     j == Length[b] && 
      Compile`GetElement[a, i] == Compile`GetElement[b, j]]
    ],
   CompilationTarget -> "C",
   RuntimeAttributes -> {Listable},
   Parallelization -> True
   ];

Running the program (with timing and result):

k = 5;
n = 10^k - 1;
a = RealDigits[Pi, 10, n + k - 1, -1][[1]];
pos = Flatten[Position[cf[a, Range[n]], 1]]; // AbsoluteTiming // First
pos

0.008294

{1, 16470, 43611, 44899}

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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