How to map a function to all sub-parts of an expression, except sub-parts passing some test

Question

I'm constructing a function mapAllExcept which is similar to MapAll:

• It maps a function f onto subparts of an expression
• It maps the function f to "deeper levels in a given sub-expression first"
• It plays nicely with expressions involving Hold attributes (this is the part I'm having trouble with)

The difference is that rather than mapping to all subparts, mapAllExcept will not apply to subparts of any sub-expression which passes a given testQ.

Example: Replace all instances of List with myList, unless a sub-expression already has head myList, in which case leave that sub-expression alone. So

mapAllExcept[ Replace[List[x___]:>myList[x] ], {{1,2}, myList@{3,4}}, MatchQ[_List] ]

(* myList[   myList[1,2], myList[{3,4}]   ] *)

Is there a simple or elegant way to do this?

---

My Attempt

My approach was to perform a recursive tree traversal, continuing unless the current sub-tree matches testQ. Since the function f needs map to deeper subparts first, the initial tree traversal instead maps a 'dummy function' fdummy, which has a downvalue fdummy[x : Except[_fdummy]] := f[x]. The recursive traversal is done with a helper function $mapAllExcept.

Here's my code:

ClearAll[mapAllExcept, $mapAllExcept]

SetAttributes[$mapAllExcept, HoldAll];

(* Map f to all specified parts of expr, except subparts of any part \
on which testQ is True *)
(* Evaluate sub-parts first, as in Map or MapAll *)

mapAllExcept[f_, expr_, testQ_] /; testQ[expr] := expr
mapAllExcept[f_, expr_, testQ_] :=
 Module[{fdummy = Unique@"f"},
  SetAttributes[fdummy, HoldAllComplete];
  fdummy[arg : Except[_fdummy]] := f[arg];
  $mapAllExcept[fdummy, expr, testQ]
 ]

$mapAllExcept[f_, expr_, testQ_] /; testQ[expr] := expr 
    (* I'm worried this will cause premature evaluation of expr, 
        but that's a higher order issue *)

$mapAllExcept[f_, expr_, testQ_] := 
  Replace[expr, x_ :> $mapAllExcept[f, x, testQ], {1}] // f

This code fails most of the tests below involving Hold attributes. I've tried some extensions, but they haven't fixed all my problems.

---

Tests

A correct implementation of mapAllExcept should satisfy some conditions:

A few simple cases

mapAllExcept[Replace[x_List :> myList @@ x], #, MatchQ[_myList]]& should generate the following transformations:

AssociationMap[
 mapAllExcept[Replace[x_List :> myList @@ x], #, MatchQ[_myList]] &,
 { myList@{3, 4}, {myList@{3, 4}}, {{1, 2}, myList@{3, 4}} } ] 

yields (correctly)

 <|myList[{3, 4}] -> myList[{3, 4}], 
  {myList[{3, 4}]} -> myList[myList[{3, 4}]], 
  {{1, 2}, myList[{3, 4}]} -> 
      myList[myList[1, 2], myList[{3, 4}]] |>

When testQ always fails

mapAllExcept[f, expr, False&] should give identical output to MapAll[f,expr] for any f and expr. In particular, this should hold for expr such as Hold[1+1,2+2]. The above implementation fails:

Hold[1 + 1, 2 + 2]
mapAllExcept[ff, %, False &]
(* ff[Hold[$mapAllExcept[fdummy$11580, 1 + 1, False &], $mapAllExcept[
     fdummy$11580, 2 + 2, False &]]] *)
MapAll[ff, %%]
(* ff[Hold[ff[ff[1] + ff[1]], ff[ff[2] + ff[2]]]] *)

Again, the above outputs would be identical for a correct implementation.

Answer 1

As an alternative to manually traversing the expression consider working with lists of positions.

positionExcept[expr_, test_, param___] :=
  With[{p = Position[expr, _?test, param]},
    If[p === {{}}, {},
      Position[expr, _, param] //
        DeleteCases[Alternatives @@ ({#, ___} & @@@ p)]
    ]
  ]

Options[mapAllExcept] = {Heads -> False};    

mapAllExcept[f_, expr_, test_, OptionsPattern[]] :=
  MapAt[f, expr, positionExcept[expr, test, Heads -> OptionValue[Heads]]]

Test:

mapAllExcept[
  Replace[List[x___] :> myList[x]],
  {{1, 2}, myList@{3, 4}},
  MatchQ[_myList]
]

myList[myList[1, 2], myList[{3, 4}]]

AssociationMap[
 mapAllExcept[Replace[x_List :> myList @@ x], #, 
   MatchQ[_myList]] &, {myList@{3, 4}, {myList@{3, 4}}, {{1, 2}, myList@{3, 4}}}]

<|myList[{3, 4}] -> myList[{3, 4}], {myList[{3, 4}]} -> 
  myList[myList[{3, 4}]], {{1, 2}, myList[{3, 4}]} -> 
  myList[myList[1, 2], myList[{3, 4}]]|>

Hold[1 + 1, 2 + 2];
mapAllExcept[ff, %, False &]

ff[Hold[ff[ff[1] + ff[1]], ff[ff[2] + ff[2]]]]