Best way to count nest depth in e.g. f[f[f[...[f[x]]...]?

Question

What is the best way to count nesting depth in e.g. f[f[f[...[f[x]]...]? In other words, what function func is good for giving you something more or less like the following:

func[Nest[f, h[x], n], f] == n

To be clear, the goal is to specifically count the nesting depth of only one function head (here, f), so f[f[h[f[x]]]] should return 3.

Answer 1

tl;dr: You can get a very fast, and very general (avoiding $RecursionLimit) function by looking for the first position (of the right kind) at which the nesting stops, instead of directly counting how many nestings have occurred.

EDIT: However, inspired by MichaelE2's ArrayDepth answer,

hdepth[expr_, f_] :=
 Replace[
  Dimensions[expr, AllowedHeads -> f],
  {x : Longest[1 ...], ___} :> Length[{x}]]

seems to be even faster, just as robust, and a lot more readable. But if you'd like to see how looking for an exception to the nesting chain works, read on...

---

While both nice, there are two potential problems with the existing answers: @mikado's nice and clean functional solution will potentially hit $RecursionLimit on very deeply nested f-expressions, e.g. Nest[f, x, 2000], and (as of the time of writing) @kglr's clever identification of Position as a useful tool here only coincides with the "nest depth" in special cases. In general, it gets the depth of the deepest occurrence of f anywhere in the expression; consider f[h[f[x]]].

One option to circumvent the recursion limit is to use ReplaceRepeated (//.) instead of function definitions. There are several ways to make this work, but I tested with

t = Nest[f, x, 50000];

which quickly led to 30-second computation times. I moved Position, but only managed to cut the time in half.

So, here's the trick, using Position, that works quickly:

• Check that the expression is of the form f[_]

• If so, look for the positions of f[patt] where patt matches any sequence of arguments that isn't of the form f[_]

• Take only the positions "on the main branch", i.e. of the form {1, 1, 1, ...}; get their length, and add 1.

For patt, we need to account for the fact that Except can't handle variable-length patterns. So I took patt to be Except[f[_]] | Repeated[_, {0}] | Repeated[_, {2, Infinity}], as I found it to be the fastest among the ones I tried.

hdepth[f_][expr : f_[_]] := 
 1 + Min[
  Cases[
   Position[expr, 
    f[Except[f[_]] | Repeated[_, {0}] | Repeated[_, {2, Infinity}]]],
     x : {1 ...} :> Length[x]]]

hdepth[f_][Except[f_[_]]] := 0

I use two definitions to check that the expression matches f[_], but you could bundle this in a single definition if you want to.

This cuts a 30-second evaluation time down to 0.01 seconds.

hdepth[f][t] // RepeatedTiming

(* {0.01049995313, 50000} *)

Hope this helps; let me know if it misjudges the depth in any case! :)

---

Here are some tests and pathological cases I could think of; note that since Nest does not have SequenceHold, and thus splices Sequence[...] arguments into its argument sequence, we don't consider f[x,y] or f[] to be a once-nested instance of f.

hdepth[f][x]           (* 0 *)

hdepth[f][f[x]]        (* 1 *)

hdepth[f][f[h[f[x]]]]  (* 1 *)

hdepth[f][f[x][x]]     (* 0 *)

hdepth[f][f[x, y]]     (* 0 *)

hdepth[f][f[]]         (* 0 *)

Note that, admittedly, 50000 is about the most I could Nest f on my computer before crashing the kernel—but I chose this arbitrarily, so I didn't realize until after :)

---

For fun, here are two that worked, but weren't so fast (despite being the fastest I could find of their "class").

(* Get all "main branch" positions of f[_], then see how many 
   appear consecutively: *)

hdepth2[expr_, f_] := Catch[Fold[If[#1 === #2, #1 + 1, Throw[#1]] &, 0, 
  Sort[Cases[Position[expr, f[_]], x : {1 ...} :> Length[x]]]]]

(* Use a module wrapper to prevent accidental matches with //., 
   since //. acts on all parts of the expression *)

hdepth3[expr_, f_] := 
 Module[{w}, (w[expr,0] //. w[f[x_], n_] :> w[x, n + 1]) // Last]

Answer 2

You can define a simple function to do this:

fdepth[f[u_]] := 1 + fdepth[u]
fdepth[_] = 0;

For example

NestList[f, h[g[x]], 5]
(* {h[g[x]], f[h[g[x]]], f[f[h[g[x]]]], f[f[f[h[g[x]]]]], 
 f[f[f[f[h[g[x]]]]]], f[f[f[f[f[h[g[x]]]]]]]} *)

fdepth /@ %
(* {0, 1, 2, 3, 4, 5} *)

Answer 3

You can use Position:

ClearAll[nestDepth]
nestDepth[func_] := Max @* Map[Length] @* Position[func] 

nestDepth[f] @ Nest[f, w @ g @ h @ x, 8]

8

nestDepth[f] /@ NestList[f, w @ g @ h @ x, 5]

{-∞, 1, 2, 3, 4, 5}

You can also use Count as follows:

ClearAll[nestDepth2]
nestDepth2[func_] := Count[#, Blank @ func, All] &

nestDepth2[f] @ Nest[f, w @ g @ h @ x, 8]

8

nestDepth2[f] /@ NestList[f, w @ g @ h @ x, 5]

{0, 1, 2, 3, 4, 5}

Answer 4

Perhaps ArrayDepth?

ArrayDepth[f[f[f[h[x]]]]]
(*  3  *)

ArrayDepth@Nest[f, x, 7]
(*  7  *)

ArrayDepth has an AllowedHeads option, which is not needed on the OP's example.

Answer 5

Interesting answers, I kind of figured there'd be a simpler built-in method for this.

Here's another workable low-tech approach:

fDepth[expr_, f_] := StringCount[ToString@expr, ToString@f <> "["]

This seems to take about 3x the time of thorimur's answer, but it is drop-dead simple.

Note that without some safeguards, this approach would fail in any context where you have the function f alongside other functions ending with f.