# Substitute an expression iteratively

I have defined this function

replaceIteratively[expr_, x_, list_] := Module[{n = 0}, expr /. x :> (n++; list[[n]])]


which does the following job

replaceIteratively[h[a]h[b]h[c]h[d],h,{h1,h2,h3,h4}]
(*Out: h1[a] h2[b] h3[c] h4[d]*)
replaceIteratively[h[a]h[b]h[c],h,{h1,h2,h3}]
(*Out: h1[a] h2[b] h3[c]*)
replaceIteratively[h[a]h[b]h[c,d],h,{h1,h2,h3}]
(*Out: h1[a] h2[b] h3[c,d]*)


However, it does not work when applied to the expression h*h*h*h

replaceIteratively[h*h*h*h,h,{h1,h2,h3,h4}]
(*Out: h1^4*)


I would like it to return h1 h2 h3 h4

How can I modify this function such that it works with expressions like Power[h,4]?

Clear["Global*"]

replaceIteratively[expr_, x_, list_] := Module[{n = 1, expr2},
expr2 =
expr /. Power[y_, n_Integer] :>
Inactive[Times] @@ ConstantArray[y, n];
(expr2 /. x :> list[[n++]]) // Activate]

replaceIteratively[h[a] h[b] h[c] h[d], h, {h1, h2, h3, h4}]

(* h1[a] h2[b] h3[c] h4[d] *)

replaceIteratively[h[a] h[b] h[c, d], h, {h1, h2, h3}]

(* h1[a] h2[b] h3[c, d] *)

replaceIteratively[h*h*h*h, h, {h1, h2, h3, h4}]

(* h1 h2 h3 h4 *)

replaceIteratively[h[]*h[]*h[]*h[], h, {h1, h2, h3, h4}]

(* h1[] h2[] h3[] h4[] *)

• Thanks. Is there a way to make it work also with h[]*h[]*h[]*h[]? The idea is that I only want to specify the Head as the argument x_ – apt45 Jul 31 '20 at 13:17
• Modified to handle that case – Bob Hanlon Jul 31 '20 at 13:22
• While upvoting rapidly is fine, you should not accept an answer so rapidly. An accepted answer tends to discourage others from offering alternative solutions. Give the community some time and you might get a better answer. – Bob Hanlon Jul 31 '20 at 13:29
• Thanks for your advice. I unaccepted the answer. I will wait a few days – apt45 Jul 31 '20 at 13:35

The following small modification should work:

ClearAll@replaceIteratively
SetAttributes[replaceIteratively, HoldFirst]
replaceIteratively[expr_, x_, list_] := Module[{n = 0}, Hold[expr] /. x :> (n++; list[[n]])] // ReleaseHold


Then:

replaceIteratively[h[a] h[b] h[c] h[d], h, {h1, h2, h3, h4}]
replaceIteratively[h[a] h[b] h[c, d], h, {h1, h2, h3}]
replaceIteratively[h*h*h*h, h, {h1, h2, h3, h4}]
(* h1[a] h2[b] h3[c] h4[d]
h1[a] h2[b] h3[c, d]
h1 h2 h3 h4 *)


If you don't want general functionality and really just want to iterate the head name, you can do

replaceIteratively[expr_, x_] := Module[{n = 1}, Hold[expr] /. x :> Symbol@StringJoin[ToString@x, ToString@n++]] // ReleaseHold


and so

replaceIteratively[h[a] h[b] h[c] h[d], h]
replaceIteratively[h[a] h[b] h[c, d], h]
replaceIteratively[h*h*h*h, h]
replaceIteratively[h[] h[] h[] h[], h]
(* h1[a] h2[b] h3[c] h4[d]
h1[a] h2[b] h3[c, d]
h1 h2 h3 h4
h1[] h2[] h3[] h4[]
*)


This will of course work with nested expressions:

replaceIteratively[h[h[h h, h[h[b]]]] h[c, d], h]
(* h1[h2[h3 h4, h5[h6[b]]]] h7[c, d] *)
`