Restrict kinds of heads when dealing with level concept

Question

In[1]  Map[(# + 7) &, {a, 3 b, {c, d}, e}, {2}]
Out[1]  {a, 10 (7 + b), {7 + c, 7 + d}, e}

But I want feature like ListMap :

In[2]  ListMap[(# + 7) &, {a, 3 b, {c, d}, e}, {2}]
Out[2]  {a, 3b, {7 + c, 7 + d}, e}

(* +7 to every level 2 object. But when determining level, ignore all head except List. *)

The concept of level is very closely related to 'Head', more precisely, 'all kinds of Heads'.
Can we restrict kinds of heads temporarily?

For example, can we do somethig like

'of all heads, only List is regarded as an effective head, when dealing with level concept, only for this time'.

There are many built-in symbols containing 'level' as their arguments. Map,Outer,Apply,...Ideally I hope there exist an original method which works for all such built-in symbols.

Answer 1

The general solution for using different heads and levels:

customMap[fn_, arr_, heads_List, level_] := 
 Replace[arr, Alternatives @@ (Pattern[x, Blank[#]] & /@ heads) -> fn[x], level]

customMap[(# + 3) &, {a, 3 b, {c, d}, e}, {List}, {1}]

(*Out: {a, 3 b, {3 + c, 3 + d}, e} *)

Solution 1

Using customMap:

ListMap[fn_, arr_, level_] := customMap[fn, arr, {List}, level]

ListMap[(# + 3) &, {a, 3 b, {c, d}, e}, {1}]

(*Out: {a, 3 b, {3 + c, 3 + d}, e} *)

Solution 2

Using Replace:

ListMap[fn_, arr_, level_] := Replace[arr, x_List -> fn[x], level]

ListMap[(# + 3) &, {a, 3 b, {c, d}, e}, {1}]

(*Out: {a, 3 b, {3 + c, 3 + d}, e} *)

---

If you want to apply to all elements of a list at a specific level:

ListMap[fn_, arr_, level_] := Replace[arr, x_List :> fn /@ x, level]


ListMap[{#, x} &, {a, b, c}, {0}]

(*Out: {{a, x}, {b, x}, {c, x}} *)


ListMap[(# + 7) &, {a, 3 b, {c, d}, e}, {1}]

(*Out: {a, 3 b, {7 + c, 7 + d}, e} *)

Also, levels start at 0, you can change the function definition but I think it's better to be consistent with other functions.

Answer 2

Here's a way of checking the heads "on the way down", and only mapping through expressions with head head; I tried to account for Mathematica's usual level specification, but didn't manage to account for negative level specification (which proceeds from the innermost level).

(* Exact levels {n}: *)

headMap[f_, expr_, head_, {0}] := f[expr]

headMap[f_, expr_, head_, {level_Integer}] := 
 Replace[expr, x_head :> Map[headMap[f, #, head, {level - 1}] &, x, {1}]] /; level > 0

(* Range of levels {n1, n2}: *)

headMap[f_, expr_, head_, {n1_Integer, n2 : (_Integer | Infinity)}] :=
 Which[
  n2 == 0, f[expr],
  n1 == 0, 
   Construct[f, Replace[expr, x_head :> Map[headMap[f, #, head, {0, n2 - 1}] &, x, {1}]]],
  True, Replace[expr, x_head :> Map[headMap[f, #, head, {n1, n2} - 1] &, x, {1}]]
 ] /; n2 >= n1 >= 0

(* Levels given by an integer n or Infinity, i.e. levels 1 through n *)

headMap[f_, expr_, head_, 0] := f[expr]

headMap[f_, expr_, head_, Infinity] := headMap[f, expr, head, {1, Infinity}]

headMap[f_, expr_, head_, level : _Integer] := headMap[f, expr, head, {1, level}] /; level > 0

Note: this could be generalized to accept patterns matching heads instead of explicit heads by using, say, x_ :> Map[...] /; MatchQ[Head[x], head] everywhere instead.

And then we can define

ListMap[f_, expr_, level_] := headMap[f, expr, List, level]

Examples:

ListMap[{#, x} &, {a, b, c}, {1}]

(* Output: {{a, x}, {b, x}, {c, x}} *)

ListMap[{#, x} &, {a, 3 b, c}, Infinity]

(* Output: {{a, x}, {3 b, x}, {c, x}} *)

ListMap[f, {e, d, {a, {b, x}, g[c, {d, h}]}}, {3}]

(* Output: {e, d, {a, {f[b], f[x]}, g[c, {d, h}]}} *)

ListMap[f, {e, d, {a, {b, x}, g[c, {d, h}]}}, Infinity]

(* Output: {f[e], f[d], f[{f[a], f[{f[b], f[x]}], f[g[c, {d, h}]]}]} *)

ListMap[f, {e, d, {a, {b, x}, g[c, {d, h}]}}, {2, 3}]

(* Output: {e, d, {f[a], f[{f[b], f[x]}], f[g[c, {d, h}]]}} *)

As you can check, these are the analogues of what Map does with the corresponding level specifications, but only ever "maps through" heads that are List!