# Computing only Prime Powers with NestList

Is there a simple way to compute only prime powers of a function f with NestList? That is, I want to compute:

{f[x_0], f^2[x_0]=f[f[x_0]], f^3[x_0], f^5[x_0]...}


up to some specified prime power. Thanks so much!

Lets say you have f(x) and you want results up to 10

n=10;
NestList[f,x,n][[#+1]]&/@Prime[Range@PrimePi@n]


{f[f[x]], f[f[f[x]]], f[f[f[f[f[x]]]]], f[f[f[f[f[f[f[x]]]]]]]}

Here's a way using Compose:

n = 10; ComposeList[ConstantArray[f, n], f[x]][[#]] & /@ Prime[Range@PrimePi@n]

{f[f[x]], f[f[f[x]]], f[f[f[f[f[x]]]]], f[f[f[f[f[f[f[x]]]]]]]}


Here's a way to accumulate the nestings, i.e. use the previous nesting as the starting point for the next one:

primeNest[f_, x_, n_] := FoldList[Nest[f, ##] &, f[f[x]], Differences[Prime[Range[n]]]]

primeNest[f, x, 5]

{f[f[x]], f[f[f[x]]], f[f[f[f[f[x]]]]],
f[f[f[f[f[f[f[x]]]]]]], f[f[f[f[f[f[f[f[f[f[f[x]]]]]]]]]]]}

(Depth /@ primeNest[f, x, 20]) - 1

{2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, 67, 71}


One can in fact use NestWhile[] along with NestList[], in the same spirit as this previous answer:

NestList[NestWhile[f, f[#], ! PrimeQ[Depth[#] - 1] &] &, x, 5]
{x, f[f[x]], f[f[f[x]]], f[f[f[f[f[x]]]]], f[f[f[f[f[f[f[x]]]]]]],
f[f[f[f[f[f[f[f[f[f[f[x]]]]]]]]]]]}


Here is another variation which yields the same result:

NestList[Nest[f, #, NextPrime[Depth[#] - 1] - Depth[#] + 1] &, x, 5]


The last few solutions have the flaw of relying on Depth[], which is not very useful if the function to be iterated is even moderately complicated. Nevertheless, these can be modified like so:

NestPrimeList[f_, x_, n_Integer?NonNegative] := Module[{p = 0, r = x, $$1}, Prepend[Reap[Do[Sow[r = Nest[f, r, -p + (p = NextPrime[p])],$$1], {n}], \$1][[2, 1]], x]]


Example:

Exponent[#, x] & /@ NestPrimeList[x # + 1 &, 1, 5]
{0, 2, 3, 5, 7, 11}


This may not be an elegant and smart way to do it but here is one way.

  exp = NestList[g, x, 12];
selector = PrimeQ[LeafCount /@ exp - 1];
Pick[exp, selector] /. {g -> f, x -> x0}


{f[f[x0]], f[f[f[x0]]], f[f[f[f[f[x0]]]]], f[f[f[f[f[f[f[x0]]]]]]], f[f[f[f[f[f[f[f[f[f[f[x0]]]]]]]]]]]}

ClearAll[primesNest0]
primesNest0[f_, x_, n_] := Nest[f, x, #] & /@ Prime[Range@PrimePi@n]
primesNest0[f, x, 10]


{f[f[x]], f[f[f[x]]], f[f[f[f[f[x]]]]], f[f[f[f[f[f[f[x]]]]]]]}

Also

ClearAll[primesNest1]
primesNest1[f_, x_, n_] := Fold[#2@# &, x, ConstantArray[f, #]] & /@ Prime[Range@PrimePi@n]

primesNest1[f, x, 10]


{f[f[x]], f[f[f[x]]], f[f[f[f[f[x]]]]], f[f[f[f[f[f[f[x]]]]]]]}

and

ClearAll[primesNest2]
primesNest2[f_, x_, n_] := Compose[##&@@ConstantArray[f, #], x] & /@ Prime[Range@PrimePi@n]
primesNest2[f, x, 10]


{f[f[x]], f[f[f[x]]], f[f[f[f[f[x]]]]], f[f[f[f[f[f[f[x]]]]]]]}

and

ClearAll[primesNest3]
primesNest3[f_, x_, n_] := Composition[## & @@ ConstantArray[f, #]][x] & /@
Prime[Range@PrimePi@n]
primesNest3[f, x, 10]


. {f[f[x]], f[f[f[x]]], f[f[f[f[f[x]]]]], f[f[f[f[f[f[f[x]]]]]]]}

After a For[] loop faux pas, and after receiving the splendid advice below came up with this ...

n = 5;
ls = {};
Table[(Q = f[x];
Do [Q = Map[f, Q], {j, Range[Prime[k] - 1]}];
ls = Join[ls, {Q}];), {k, Range[n]}];
Print[ls]


Here is the result:

{f[f[x]],f[f[f[x]]],f[f[f[f[f[x]]]]],f[f[f[f[f[f[f[x]]]]]]],f[f[f[f[f[f[f[f[f[f[f[x]]]]]]]]]]]}


Perhaps it is time to Table[] this discussion:

 n = 5;
ls = {};
Table[(Q = f[x];
Table[Q = Map[f, Q], {j, Range[Prime[k] - 1]}];
ls = Join[ls, {Q}]), {k, Range[n]}];
Print[ls];

• Why should I avoid the For loop in Mathematica? – corey979 Feb 17 '19 at 22:24
• Thank you for the tip, here it is with For[] replaced by Do[]: n = 5; ls = {}; Do [ ( Q = f[x]; Do [Q = Map[f, Q], {j, Range[Prime[k] - 1]}]; ls = Join[ls, {Q}] ), {k, Range[n]}] Print[ls] – mjw Feb 17 '19 at 23:26