12
$\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$
  • 1
    $\begingroup$ Heads are expressions. There's nothing distinguished about a "function" head. $\endgroup$ – John Doty Mar 6 at 13:49
  • 1
    $\begingroup$ Related: (11045) $\endgroup$ – Mr.Wizard Mar 7 at 6:11
  • $\begingroup$ What prevents you of using f[1][_][_,_,_] instead of f1[_][_,_,_], etc. ? $\endgroup$ – yarchik Mar 9 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 at 11:37
20
$\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).

| improve this answer | |
$\endgroup$
  • $\begingroup$ Wonderful, I was unaware of FixedPointList function. $\endgroup$ – Lelouch Mar 7 at 2:18
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}

| improve this answer | |
$\endgroup$
11
$\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.

| improve this answer | |
$\endgroup$
  • $\begingroup$ For me (version 11) this generates error ReplaceRepeated::argr: ReplaceRepeated called with 1 argument; 2 arguments are expected. $\endgroup$ – მამუკა ჯიბლაძე Mar 7 at 9:17
  • 2
    $\begingroup$ @მ As mentioned in the document, ReplaceRepeated is updated in v11.3. $\endgroup$ – xzczd Mar 7 at 9:54
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} *)
| improve this answer | |
$\endgroup$
  • 6
    $\begingroup$ consider also head[h_[___]] := head[h] $\endgroup$ – Mr.Wizard Mar 7 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
| improve this answer | |
$\endgroup$
  • 2
    $\begingroup$ You've got a lingering semicolon at the end of code line 2. Great answer! $\endgroup$ – Roman Mar 8 at 8:13
  • $\begingroup$ @Roman Corrected / Thanks $\endgroup$ – Mr.Wizard Mar 8 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}  *)
| improve this answer | |
$\endgroup$
  • $\begingroup$ It's worth considering what happens with 1[x, y] but +1 nevertheless. $\endgroup$ – Mr.Wizard Mar 8 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 at 16:28
  • 1
    $\begingroup$ I suppose you could use x_?AtomQ instead? $\endgroup$ – Mr.Wizard Mar 8 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 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 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}

| improve this answer | |
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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