# Replacing the heads of an expression in left to right order

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.

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.

Using the power of (undocumented) iterators:

replaceHead[f_][expr_] :=
Module[{count = Count[expr, f[__], All], perm},
perm = GeneralUtilitiesListIterator[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]] *)


Suggested solution (OP):

headFPosition[expression_] := Position[expression, f]

Insert[#, f, 1] & /@ ({#} & /@ permutation)

alteredExpression[expression_, permutation_] :=
pairedPermutation[permutation]] ];

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]]

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