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…).

=================

=================

4 Answers
4

=================

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]