3
$\begingroup$

I am trying to do the following with rule-based pattern matching

(f1[t] f2[t] f3[t]) /. {x__ -> n[
     Product[x[[i, 0]][om[i]], {i, 3}]]} // Quiet

which gives me the output n[f1[om[1]] f2[om[2]] f3[om[3]]]. However, it seems as if one cannot specify parts of a pattern MMA gives the error messages

"Part specification x[[1,0]] is longer than depth of object"

I would like to do the operatoration for a product of n arbitrary functions f1[t]...fn[t] where the number of functions is automatically detected (I cannot use Length[] as well). How would one do it correctly?

$\endgroup$
3
$\begingroup$
f1[t] f2[t] f3[t] /. Times[x_, y__] :> n[Times @@ MapIndexed[#[[0]][om[#2[[1]]]] &, {x, y}]]

n[f1[om[1]] f2[om[2]] f3[om[3]]]

Also

Module[{i = 1}, f1[t] f2[t] f3[t] /. {t :> om[i++]} // n]

n[f1[om[1]] f2[om[2]] f3[om[3]]]

Update: "If all the functions are equal":

Inactivate[f1[t] f1[t] f1[t]] /. 
 Inactive[Times][x_, y__] :> Activate@n[Times @@ MapIndexed[#[[0]][om[#2[[1]]]] &, {x, y}]]

n[f1[om[1]] f1[om[2]] f1[om[3]]]

Activate@Module[{i = 1}, Inactivate[f1[t] f1[t] f1[t]] /. {t :> om[i++]} // n]

n[f1[om[1]] f1[om[2]] f1[om[3]]]

Update 2: "... if one replaces e.g. f1[t] to become (x1[t]-x2[t])"

The first method works if the level specification {-2} is used in MapIndexed:

Inactivate[f1[t] f2[t] f3[t]] /. Inactive[Times][x_, y__] :> 
   Activate@n[Times @@ MapIndexed[#[[0]][om[#2[[1]]]] &, {x, y}, {-2}]]

n[f1[om[1]] f2[om[2]] f3[om[3]]]

Inactivate[f1[t] f1[t] f1[t]] /. Inactive[Times][x_, y__] :> 
  Activate@n[Times @@ MapIndexed[#[[0]][om[#2[[1]]]] &, {x, y}, {-2}]]

n[f1[om[1]] f1[om[2]] f1[om[3]]]

Inactivate[(x1[t] - x2[t]) (x1[t] - x2[t]) (x1[t] - x2[t])] /. 
 Inactive[Times][x_, y__] :> 
  Activate@n[Times @@ MapIndexed[#[[0]][om[#2[[1]]]] &, {x, y}, {-2}]]

n[(x1[om[1]] - x2[om[1]]) (x1[om[2]] - x2[om[2]]) (x1[om[3]] - x2[om[3]])]

The second method can also be modified (so that ReplaceAll is mapped onto the terms of the product) to work for all three cases:

Activate@Module[{i = 1}, n[With[{j = i++}, # /. t :> om[j]] & /@ 
    Inactivate[f1[t] f2[t] f3[t]]]]

n[f1[om[1]] f2[om[2]] f3[om[3]]]

Activate@Module[{i = 1}, n[With[{j = i++}, # /. t :> om[j]] & /@ 
    Inactivate[f1[t] f1[t] f1[t]]]]

n[f1[om[1]] f1[om[2]] f1[om[3]]]

Activate@Module[{i = 1}, n[With[{j = i++}, # /. t :> om[j]] & /@ 
    Inactivate[(x1[t] - x2[t]) (x1[t] - x2[t]) (x1[t] - x2[t])]]]

n[(x1[om[1]] - x2[om[1]]) (x1[om[2]] - x2[om[2]]) (x1[om[3]] - x2[om[3]])]

$\endgroup$
  • $\begingroup$ Thank you for your answer. It works for f1 != f2 != f3 but stops working if all the functions are equal. $\endgroup$ – Display Name Jan 17 at 11:56
  • $\begingroup$ @DisplayName, please see the update. $\endgroup$ – kglr Jan 17 at 12:05
  • $\begingroup$ Thanks again. I think I lack a little bit of knowledge to come up with sth like this. I just read into pattern matching but it needs some time to settle. But I also like the approach with the RuleDelayed. The mathematical background of this question is to write a product in time domain as a product in Fourier space via the convolution theorem. n[] is then simply a functional involving integrations over the oms. $\endgroup$ – Display Name Jan 17 at 12:18
  • $\begingroup$ I think the code must be edited once more if one replaces e.g. f1[t] to become (x1[t]-x2[t]). $\endgroup$ – Display Name Jan 17 at 14:14
  • $\begingroup$ @DisplayName, please see update 2. $\endgroup$ – kglr Jan 18 at 10:52
1
$\begingroup$

A simple function can do it.

changeArg[p : Times[__], var_Symbol, head_Symbol] := 
  head[MapIndexed[#1[var[#2[[1]]]] &, Head /@ p]]

changeArg[f1[t] f2[t] f3[t], om, n] 

n[f1[om[1]] f2[om[2]] f3[om[3]]]

$\endgroup$
  • $\begingroup$ Thank you for another possible answer. I think in the current form it doesn't cover the case of equal functions. $\endgroup$ – Display Name Jan 17 at 12:32

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.