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]