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}}


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}}

-
Coluld you explain your problem in english, not in chinese ? – Artes Dec 17 '12 at 14:28
My English is bad, I am afraid that my expression is not clear. – chyaong Dec 17 '12 at 14:42
Can you explain your problem via mathematics? – image_doctor Dec 17 '12 at 14:54
Ok, Let me try. – chyaong Dec 17 '12 at 14:58
You can certainly increase the computation time by not actually calculating every step and instead using some clever algorithm. I made a graph of the transitions – ssch Dec 17 '12 at 15:39

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]]
];

-
DL posted a cycle detection algorithm here mathematica.stackexchange.com/a/2840/193. I think it's already implemented natively in V9 – Dr. belisarius Dec 17 '12 at 20:32
For the purpose of identifying the $n$th *digit* in these "Fibonacci strings"--rather than just the $n$th step of their generation--it would be more convenient to represent the cycles slightly differently; namely, as $(14,45,59,91)$ and $(11,12,23,35,58,81,13,34,47,71)$. – whuber Dec 17 '12 at 20:48

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.

-
The final expression needs some modifications to be correct: it must compute modulo $10$ (the length of the cycle) rather than modulo $9$ and it must offset the result by $1$, because MMA will complain when you try to index that list with a zero. – whuber Dec 17 '12 at 20:50
@whuber thanks - I wrote this after a long day and for some stupid reason added 1 instead of offsetting by 1. Amended the whole thing now. – gpap Dec 18 '12 at 11:04