13
$\begingroup$

I have a dynamic list of function names, like {f1, f2, f3, ...}, and they will enter in computation in various forms f1[_][_,_,_], f2[_,_], ..., etc.

I am hoping for a function to automatically extract their root function names f1, f2, ...; so far I am brute-force checking if Head[exp] or Nest[Head, exp, 2], ... but clearly it's ugly.

$\endgroup$
4
  • 1
    $\begingroup$ Heads are expressions. There's nothing distinguished about a "function" head. $\endgroup$
    – John Doty
    Mar 6, 2020 at 13:49
  • 1
    $\begingroup$ Related: (11045) $\endgroup$
    – Mr.Wizard
    Mar 7, 2020 at 6:11
  • $\begingroup$ What prevents you of using f[1][_][_,_,_] instead of f1[_][_,_,_], etc. ? $\endgroup$
    – yarchik
    Mar 9, 2020 at 9:11
  • $\begingroup$ @yarchik In the actual code stuffs are not named with f, but other random characters chosen by users. Here I simplify the problem with f#. $\endgroup$
    – Lelouch
    Mar 9, 2020 at 11:37

7 Answers 7

21
$\begingroup$

With a few functions to try, defined in differentfunctions, try this headF:

differentfunctions = {f1[a][x, y], f2[a, b, c], f3[a, 2][3]};
headF = FixedPointList[Head, #][[-3]] &;

headF /@ differentfunctions

(* Out: {f1, f2, f3} *)

It relies on the fact that, at some point, repeated application of Head will return Symbol, and head of Symbol is also Symbol, so repeated application gets to a fixed point. You then extract the last head before Symbol was returned, which is the third-from-last element returned by FixedPointList (the last two always being the same, and equal to the fixed point value).

$\endgroup$
1
  • $\begingroup$ Wonderful, I was unaware of FixedPointList function. $\endgroup$
    – Lelouch
    Mar 7, 2020 at 2:18
12
$\begingroup$

You may use ReplaceRepeated.

With

differentfunctions = {f1[a][x, y], f2[a, b, c], f3[a, 2][3]};

Then

ReplaceRepeated[h_[___] :> h] /@ differentfunctions
{f1, f2, f3}

Hope this helps.

$\endgroup$
2
  • $\begingroup$ For me (version 11) this generates error ReplaceRepeated::argr: ReplaceRepeated called with 1 argument; 2 arguments are expected. $\endgroup$ Mar 7, 2020 at 9:17
  • 2
    $\begingroup$ @მ As mentioned in the document, ReplaceRepeated is updated in v11.3. $\endgroup$
    – xzczd
    Mar 7, 2020 at 9:54
12
$\begingroup$

There is a built-in function BoxForm`UltimateHead that extracts the head wrapped with HoldComplete. So wrapping the output from this function with ReleaseHold gives the desired result:

topHead = ReleaseHold @* BoxForm`UltimateHead;

topHead /@ {f1[a][x, y], f2[a, b, c], f3[a, 2][x, y, g[z][1, 2, 3]]}

{f1, f2, f3}

$\endgroup$
9
$\begingroup$

Another solution:

head[e_Symbol] := e
head[e_] := head@Head@e

head /@ {f1[a][x, y], f2[a, b, c], f3[a, 2][3]}
(* {f1,f2,f3} *)
$\endgroup$
1
  • 6
    $\begingroup$ consider also head[h_[___]] := head[h] $\endgroup$
    – Mr.Wizard
    Mar 7, 2020 at 6:15
6
$\begingroup$

I think Level might be the purest way to handle this.

dh = Level[#, {-1}, # &, Heads -> True] &;

dh /@ {f1[a][x, y], f2[a, b, c], f3[a, 2][3]}
{f1, f2, f3}

Other perhaps useful or entertaining methods:

lst = {f1[a][x, y], f2[a, b, c], f3[a, 2][3]};

Scan[Return, #, {-1}, Heads -> True] & /@ lst

Do @ MapAll[Break, #, Heads -> True] & /@ lst

# ~Extract~ Position[#, _, {-1}, 1][[1]] & /@ lst

FirstCase[#, _, , {-1}, Heads -> True] & /@ lst

Catch @ Operate[Throw@*#0, #] & /@ lst
$\endgroup$
2
  • 2
    $\begingroup$ You've got a lingering semicolon at the end of code line 2. Great answer! $\endgroup$
    – Roman
    Mar 8, 2020 at 8:13
  • $\begingroup$ @Roman Corrected / Thanks $\endgroup$
    – Mr.Wizard
    Mar 8, 2020 at 8:46
3
$\begingroup$

Another approach (with Mr.Wizard's suggestion of x_?AtomQ instead of x_Symbol):

f[x][y][z] /. x_?AtomQ :> Return[x, ReplaceAll]
(*  f  *)

Function:

rootHead = # /. x_?AtomQ :> Return[x, ReplaceAll] &;

MarcoB's examples:

lst = {f1[a][x, y], f2[a, b, c], f3[a, 2][3]};

rootHead /@ lst
(*  {f1, f2, f3}  *)
$\endgroup$
5
  • $\begingroup$ It's worth considering what happens with 1[x, y] but +1 nevertheless. $\endgroup$
    – Mr.Wizard
    Mar 8, 2020 at 16:25
  • $\begingroup$ @Mr.Wizard Yeah, also SparseArray[{0}][x][y][z], which I just discovered. I guess it works only for nonatomic symbol heads. Thanks for the upvote. $\endgroup$
    – Michael E2
    Mar 8, 2020 at 16:28
  • 1
    $\begingroup$ I suppose you could use x_?AtomQ instead? $\endgroup$
    – Mr.Wizard
    Mar 8, 2020 at 16:38
  • $\begingroup$ @Mr.Wizard Thanks, that's better. It still gives 1 or the whole SparseArray[] instead of their heads. $\endgroup$
    – Michael E2
    Mar 8, 2020 at 16:41
  • $\begingroup$ In many cases I think returning the verbatim head rather than its type is more useful. Both Head and h_[___] etc. forms have been shared so there is choice, even though it hasn't been explicitly stated in this Q&A yet. $\endgroup$
    – Mr.Wizard
    Mar 8, 2020 at 16:49
1
$\begingroup$

NestWhile

rootHead = NestWhile[Head, #, # =!= Symbol &, 1, ∞, -1] &;

rootHead /@ {f1[a][x, y], f2[a, b, c], f3[a, 2][3]}

{f1, f2, f3}

$\endgroup$

Your Answer

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

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