How can I create an atomic head or treat some head as atomic during Map?

Question

For example,

Map[g, {0, {h[1, 2, 3]}}, {-1}]

gives

{g[0], {h[g[1], g[2], g[3]]}}

I want a atomicHead that can prevent deeper inspection of its sub parts, so that

Map[g, {0, {atomicHead[1, 2, 3]}}, {-1}]

gives

{g[0], {g[atomicHead[1, 2, 3]]}}

Is it possible to have such an atomicHead? Or even better, to make Head h seem atomic to Map function.

Answer 1

Following this tutorial,

tmp = atomicHead[1, 2, 3];
System`Private`SetNoEntry@tmp
Map[g, {0, {tmp}}, {-1}]

{g[0], {g[atomicHead[1, 2, 3]]}}

---

Update in response to comments

Alternatively, you can automatically make expressions atomic based on their Heads:

expr = {0, {atomicHead[1, 2, 3], {atomicHead[1, 2, 3, 4]}}};
Map[g, expr /. 
  atomicHead[args___] :> System`Private`ConstructNoEntry[atomicHead, args], {-1}]

{g[0], {g[atomicHead[1, 2, 3]], {g[atomicHead[1, 2, 3, 4]]}}}

---

Update 2

I just realized that I overlooked the simplest and most direct solution:

expr = {0, {atomicHead[1, 2, 3], {atomicHead[1, 2, 3, 4]}}};
Map[g, expr /. a_atomicHead :> System`Private`SetNoEntry[a], {-1}]

{g[0], {g[atomicHead[1, 2, 3]], {g[atomicHead[1, 2, 3, 4]]}}}

Answer 2

Update:

System`Private`ConstructNoEntry will enter recursion in some cases, See here. System`Private`SetNoEntry is more robust and simple.

Also Association is a special construct, normal replacement does not work for it. Alexey Popkov provides a perfect workaround in his comments. All credits to Alexey Popkov.

I just organize some examples for quick reference

Below is the final form of makeAtomic

makeAtomic[head_] := 
 a_head :> RuleCondition@System`Private`SetNoEntry[a]

Now, no matter List or Association expression both works

expr = {0, Quantity[1, "kg"]};
Map[g, expr /. makeAtomic[Quantity], {-1}]
Map[g, <|1 -> expr|> /. makeAtomic[Quantity], {-1}]

gives

{g[0], g[Quantity[1, "Kilograms"]]}
<|1 -> {g[0], g[Quantity[1, "Kilograms"]]}|>

---

Previous:

Completely inspired by Alexey Popkov. I just make a simpler interface.

We could define

makeAtomic[head_] := 
 HoldPattern[head[args___]] :> 
  System`Private`ConstructNoEntry[head, args]

Now define

expr = {0, Quantity[1, "kg"], BesselJ[3, x]};

then

Map[g, expr, {-1}]

gives

{g[0], Quantity[g[1], g["Kilograms"]], BesselJ[g[3], g[x]]}

and

Map[g, expr /. {makeAtomic[Quantity], makeAtomic[BesselJ]}, {-1}]

gives

{g[0], g[Quantity[1, "Kilograms"]], g[BesselJ[3, x]]}

---

What is more, we can really make an atomic Head like

atomicHead[x___] := System`Private`ConstructNoEntry[atomicHeadCore, x]

then

Map[g, {0, atomicHead[1, 2, 3]}, {-1}]

gives

{g[0], g[atomicHeadCore[1, 2, 3]]}

Note the Head is atomicHeadCore not atomicHead. If you want to change to some other Head, you can do

Map[g, {0, atomicHead[1, 2, 3]}, {-1}] /. 
 atomicHeadCore[x___] :> anyOtherHead[x]

which gives

{g[0], g[anyOtherHead[1, 2, 3]]}