1
$\begingroup$

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

$\endgroup$

4 Answers 4

2
$\begingroup$

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}
*)
$\endgroup$
2
$\begingroup$

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

enter image description here

$\endgroup$
1
$\begingroup$

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

$\endgroup$
1
$\begingroup$

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]

enter image description here

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

enter image description here

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

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.