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.

$\endgroup$

4 Answers 4

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.

$\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]] *)
$\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]]
$\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]] *)
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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