# NestWhileList, control to show the second sequence

For example，each number will end up with 89 or 1, however , How can I generate a sequence with two sub sequence.

f[n_] := IntegerDigits[n]^2 // Total


One sub sequence:

NestWhileList[f, 20, FreeQ[{1, 89}, #] &]

(*
{20,4,16,37,58,89}
*)

NestList[f, 20, 13]

(*
{20,4,16,37,58,89,145,42,20,4,16,37,58,89}
*)


The result above, when set Value=13, we can see the second sub sequence is {145,42,20,4,16,37,58,89}

For different number, the Value is different in NestList.

My question is can this be controlled by NestWhileList or some similar (somthing...).

Question is a bit ambiguous, but I think you're after:

ff = Join @@
Most@FixedPointList[
NestWhileList[f, f[Last@#], FreeQ[{1, 89}, #] &] &,
NestWhileList[f, #, FreeQ[{1, 89}, #] &]] &;

ff[20]
ff[15]

(*
{20, 4, 16, 37, 58, 89, 145, 42, 20, 4, 16, 37, 58, 89}
{15, 26, 40, 16, 37, 58, 89, 145, 42, 20, 4, 16, 37, 58, 89}
*)


Just for fun:

f = Total[IntegerDigits[#]^2] &;
fun[n_] := NestWhileList[f, n, Unequal, All]
r = fun /@ Range[100];
gf[u_] := DirectedEdge @@@ Partition[u, 2, 1]
Graph[Union[Join @@ (gf /@ r)], VertexSize -> 0,
GraphLayout -> "SpringEmbedding",
VertexLabels -> Placed["Name", Center],
VertexLabelStyle -> Directive[Blue, 20, Background -> LightBlue],
EdgeStyle -> Directive[Red, Thick],
EdgeShapeFunction -> "FilledArrow"]


In general, you can use a count varable to control the nest to get no matter the second or the nth result, like this

In[35]:= count = 0;
NestWhileList[f, 20, (If[MemberQ[{1, 89}, #], count++]; count < 2) &]

Out[36]= {20, 4, 16, 37, 58, 89, 145, 42, 20, 4, 16, 37, 58, 89}


And in fact count is not necessary

In[45]:= Nest[
NestWhileList[f, f[#[[-1]]], FreeQ[{1, 89}, #] &] &, {20}, 2]

Out[45]= {145, 42, 20, 4, 16, 37, 58, 89}


Change 2 into n can get the nth sequence

Edit

By the way, in this question, the first sequence must end with 1 or 89, so the second sequence must be {1} or {145, 42, 20, 4, 16, 37, 58, 89}

In[49]:= secondSequence[n_] :=
If[NestWhile[f, n, FreeQ[{1, 89}, #] &] == 89, {145, 42, 20, 4, 16,
37, 58, 89}, {1}]
secondSequence[20]

Out[50]= {145, 42, 20, 4, 16, 37, 58, 89}


It will be much faster than before

You can (1) use the last two arguments of NestWhileList, and (2) change the test function to control the number of subsequences:

nwlF = With[{f = #, x = #2, max = #3, l = #4, c = #5 - 1},
NestWhileList[f, x, Count[{##}, Alternatives @@ l] <= c &, All, max]] &;


In words, apply f until the number of steps reaches max or the number of subsequences obtained reaches c whichever comes first.

Examples:

nwlF[f, 20, 13, {1, 89}, 1]
(* {20, 4, 16, 37, 58, 89} *)
nwlF[f, 20, 13, {1, 89}, 2]
(* {20, 4, 16, 37, 58, 89, 145, 42, 20, 4, 16, 37, 58, 89} *)
nwlF[f, 20, 15, {1, 89}, 3]
(* {20, 4, 16, 37, 58, 89, 145, 42, 20, 4, 16, 37, 58, 89, 145, 42} *)

results = {#, nwlF[f, 20, 100, {1, 89}, #]} & /@ Range[5];
Grid[{{"n", "result"}, ## & @@ results}, Dividers->All]


results2 = {#, nwlF[f, 20, 13, {1, 89}, #]} & /@ Range[5];
Grid[{{"n", "result"}, ## & @@ results2}, Dividers -> All]


results3 = {#, nwlF[f, 20, 15, {1, 89}, #]} & /@ Range[5];
Grid[{{"n", "result"}, ## & @@ results3}, Dividers -> All]