About extension fibonacci

Question

I have been trying to solve this problem, it worked slow. I know there is a efficiently way. How do I get it?

The following is my code:

f[{a_, b_, nth_}] := Nest[#~Join~IntegerDigits@Tr[#[[-2 ;;]]] &, {a, b}, nth - 2][[nth]];

f /@ {{1, 1, 2}, {1, 1, 8}, {1, 4, 8}, {1, 5, 10^5 - 1}, {1, 7, 10^5}}

additional

1. Integer a,b in range 0 to 9,combine them to a string ab

2. Make the last and penultimate number plus then appendto ab

repeat 2.,the string can any infinitely expanding. Now we need know what is the nth number.

For example:

1,1 ==> 11235813471123...

1,2 ==> 12358134711235...

1,5 ==> 156112358134711...

f(1,1,2)=1

f(1,1,8)=3

f(1,4,8)=9

update

I have got a way, but I feel it's not neat.

f[{a_, b_, n_}] :=
  Module[{li, pos, left, repeat},
   li = NestWhile[#~Join~IntegerDigits@Tr[#[[-2 ;;]]] &, {a, b}, 
     FreeQ[Partition[#[[;; -2]], 2, 1], #[[-2 ;;]]] &];

   pos = Position[Partition[li, 2, 1], li[[-2 ;;]], 1, 1][[1, 1]];
   {left, repeat} = {#[[;; pos - 1]], #[[pos ;; -3]]} &@li;
   If[n <= Length[left], left[[n]], 
    repeat[[Mod[n - Length[left], Length[repeat], 1]]]]
   ];

f /@ {{1, 1, 2}, {1, 1, 8}, {1, 4, 8}, {1, 5, 10^8 - 1}, {1, 7, 10^8}}

Answer 1

Not full solution, just a non-bruteforce way to do it.

Noting that there are 3 distinct cycles you can end up in, namely:

cycles={
  {{0,0}},
  {{1,4},{4,5},{5,9}},
  {{1,1},{1,2},{2,3},{3,5},{5,8},{1,3},{3,4},{4,7}}
};
distance=Map[If[Total[#]>=10,2,1]&,cycles,{2}];
(* {{1},{1,1,2},{1,1,1,1,2,1,1,2}} *)

Say you arrive at: ...166713 Here your last two digits {1,3} are part of the third cycle, in which every tenth digit is the same, so the digit k-steps further in the sequence will be the same as 10*n + k further. So if you have k-steps remaining you only need to calculate the next Mod[k,10]

I discovered the cycles by looking at the graph of the transitions and used some inefficient code to extract the cycles

next[a_,b_]:=Module[{sum=a+b},
  If[sum >= 10,
    QuotientRemainder[sum,10],
    {b,sum}]
];
vertices=Tuples[Range[0,9],2]; (* all {i,j} for i,j between 0 and 9 *)

cycles = Module[{cycles = {}, n, s, cycle},
   Scan[(
      n = #;
      cycle = {n};
      n = next @@ n;

      (* Keep adding next {a,b} pair to the cycle until we have seen it before *)
      While[FreeQ[cycle, n],
       AppendTo[cycle, n];
       n = next @@ n
       ];
      (* Where was it first seen? *)    
      s = Position[cycle, n][[1, 1]];
      (* Add the detected cycle to our list of all cycles*)
      AppendTo[cycles, cycle[[s ;; -1]]]
      ) &
    , vertices];
   (* Remove duplicate cycles*)
   Union[Map[RotateLeft[#, First@Ordering[#] - 1] &, cycles]]
   ];

Answer 2

not so much an answer but an observation.

Your sequence always converges to either the pattern: $\dots, 1, 1, 2, 3, 5, 8, 1, 3, 4, 7, \dots$ or $\dots, 1,4,5,9, \dots $ and periodically repeats itself to infinity. You can test that if you evaluate:

g[i_, j_] := Block[{f, MyQuotRem},
             MyQuotRem[a_] := If[a < 10, {a}, a~QuotientRemainder~10];
             f[n_] := f[n] = f[n - 1]~Join~MyQuotRem[(Take[f[n - 1], -2] /. List -> Plus)];
             f[0] = {i, j};
             f[100]~MatchQ~{__, 1, 1, 2, 3, 5, 8, 1, 3, 4, 7, __}|| f[100]~MatchQ~{__, 1, 4, 5, 9, __}]

like so

Table[g[i,j], {i, 1, 9}, {j, 0, 9}]

(I used 100 iterations arbitrarily, the convergence happens much earlier). So you don't need to calculate future terms at all - you just need to use some sort of modular division to characterise the terms in your sequence.

-------EDIT-------

For example, you can modify the code to scan for the first instance of {__,4,7,__} and {__,5,9,__} (below, that's the While loop). After that, you generate a repeating sequence. I can't think of a nicer way than manually assigning this (having amended a mistake @whuber noticed):

Clear@g;

g[i_Integer, j_Integer, l_Integer] := Block[{f, MyQuotRem, conv1, conv2, p}, 
      MyQuotRem[a_] := If[a < 10, {a}, a~QuotientRemainder~10];
      f[n_] := f[n] = f[n - 1]~Join~MyQuotRem[(Take[f[n - 1], -2] /. List ->Plus)];
      f[0] = {i, j};
      conv1 = {1, 1, 2, 3, 5, 8, 1, 3, 4, 7};
      conv2 = {1, 4, 5, 9};
      k = 1; While[!((f[k]~MatchQ~{__, 4, 7, __}) || f[k]~MatchQ~{__, 5, 9, __}), p[i, j] = f[k]; k++];
      If[l <= Length@p[i, j], g[i, j, l] = p[i, j][[l]],
           If[Last@p[i, j] == 7,
           g[i, j, l] = conv1[[Mod[l - Length@p[i, j], Length@conv1, 1]]],
           g[i, j, l] = conv2[[Mod[l - Length@p[i, j], Length@conv2, 1]]]]]]

Now, say, g[1,7,234^567] calculates your $ 234^{567}$-th term starting from $ \{1, 7\}. $ (which is a 3)

given {1,2} as an initial condition, any nth term is given by

{1, 1, 2, 3, 5, 8, 1, 3, 4, 7}[[Mod[10 + n, 9]]]

so you need only worry about the first few terms until the convergence occurs. You can modify my code to scan for the first instance of {1,1} or {1,4} and calculate future terms accordingly.