3
$\begingroup$

I would like to replace the occurrences of the head f in an expression.

The expression only contains two possible heads: f and g.

These heads are applied to exactly two arguments.

Example:

f[g[x,f[y,z]],f[u,v]]

The occurrences of f need to be replaced by a list of two elements {f, i}.

The element i is an integer drawn from a given permutation, i.e. a list of integers.

This list must have the same length as the number of occurrences of the head f in the expression.

Continuing the above example for the expression f[g[x,f[y,z]],f[u,v]]

the permutation must have 3 elements (since the expression contains three occurrences of f).

For instance the permutation:

{2, 3, 1}

Each occurrence of the head f in the expression must be replaced in left to right order by a pair {f, i} where i is the corresponding element in the permutation.

Output:

{f,2}[g[x,{f,3}[y,z]],{f,1}[u,v]]

Second example:

g[x, f[ g[f[u,v],w], r]]

The expression has two occurrences of the head f.

A permutation of the same length is given:

{1,2}

The outcome should be:

g[x, {f,1}[ g[{f,2}[u,v],w], r]]

I am not sure how to control the execution of a rule so it occurs in left to right order of execution and replaces each head f as above.

ETA: it seems ReplacePart might help. The positions of f can be found by Position[ ]. ReplacePart can then be applied on a Threaded version, creating rules to replace each position by the corresponding element in the permutation. I posted a suggested solution and will leave the question up to see how others approach it.

ETA: I accepted the answer indicated below based on its elegance. I did not take speed into account when making the choice.

Improve this question
$\endgroup$

4 Answers 4

Reset to default
3
$\begingroup$

Using a classic trick where we can iterate a counter each time we replace in an expression, consider the following:

lst = {2, 3, 1};
f[g[x, f[y, z]], f[u, v]] /. Module[{i = 1}, f :> {f, lst[[i++]]}]
(* {f, 2}[g[x, {f, 3}[y, z]], {f, 1}[u, v]] *)
g[x, f[g[f[u, v], w], r]]
(* g[x, {f, 2}[g[{f, 3}[u, v], w], r]] *)

and so on.

Improve this answer
$\endgroup$
5
$\begingroup$

Using the power of (undocumented) iterators:

replaceHead[f_][expr_] := 
 Module[{count = Count[expr, f[__], All], perm},
  perm = GeneralUtilities`ListIterator[RandomSample[Range[count]]];
  expr /. f :> {f, Read[perm]}
  ]

f[g[x, f[y, z]], f[u, v]] // replaceHead[f]
(* {f, 3}[g[x, {f, 2}[y, z]], {f, 1}[u, v]] *)

g[x, f[g[f[u, v], w], r]] // replaceHead[f]
(* g[x, {f, 1}[g[{f, 2}[u, v], w], r]] *)
Improve this answer
$\endgroup$
3
$\begingroup$

Suggested solution (OP):

headFPosition[expression_] := Position[expression, f]
    
        annotateHeadF[permutation_] := 
         Insert[#, f, 1] & /@ ({#} & /@ permutation)
        
        alteredExpression[expression_, permutation_] :=
         Module[{threadedList},
          threadedList = 
           Thread[Rule[headFPosition[expression], 
             pairedPermutation[permutation]] ];
          ReplacePart[expression, threadedList]]

alteredExpression[g[x, f[g[f[u, v], w], r]], {1, 2}]

produces the output

g[x, {f, 1}[g[{f, 2}[u, v], w], r]]
Improve this answer
$\endgroup$
3
$\begingroup$ 
$Version

(* "14.0.0 for Mac OS X ARM (64-bit) (December 13, 2023)" *)

Clear["Global`*"]

repl[expr_, perm_, sym : _Symbol : f] :=
 Module[{n = 1},
   expr /. sym :> ({sym, #} & /@ perm)[[n++]]] /;
  Length[StringCases @@ (ToString /@ {expr, sym})] ==
   Length[perm]

repl[f[g[x, f[y, z]], f[u, v]], {2, 3, 1}]

(* {f, 2}[g[x, {f, 3}[y, z]], {f, 1}[u, v]] *)

repl[g[x, f[g[f[u, v], w], r]], {1, 2}]

(* g[x, {f, 1}[g[{f, 2}[u, v], w], r]] *)
Improve this answer
$\endgroup$

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