2
$\begingroup$

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.

$\endgroup$
2
$\begingroup$

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]]]]
$\endgroup$
  • $\begingroup$ Ah, I see; I misread that. I'll put in a quick fix that hopefully doesn't break something else. I am about to leave so if I mess it up I'll have to revisit it later. Looks like I'll need Heads -> False in Position to match the defaults. $\endgroup$ – Mr.Wizard Apr 6 '17 at 0:25
  • 1
    $\begingroup$ Replacing Position[expr, _] with Position[expr, _, Heads->False] seems to work perfectly! +1 $\endgroup$ – jjc385 Apr 6 '17 at 0:47
  • 1
    $\begingroup$ @jjc385 Okay, I added Heads as an option, defaulting to False, so you can use mapAllExcept[. . . Heads -> True] if needed, just like MapAll. $\endgroup$ – Mr.Wizard Apr 6 '17 at 4:14

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.