I am failing to write a Mathematica transformation rule that replaces e.g. f[a + 3, b + 3, c + 3] with f[a, b, c] + 3 for an arbitrary number of arguments. However, f[a + 3, b + 3, c + 2] should remain untouched after the transformation.
Asked
Active
Viewed 168 times
8
olafur
- 81
- 3
3 Answers
5
Since the problem is specified without context, here is a very specific solution:
expr = f[a + 3, b + 3, c + 3, d + 3, e + 3];
Thread[expr, Plus] /. f[n_ ..] :> n
3 + f[a, b, c, d, e]
Leaving aside the curious question of pattern matching raised in the comments here is a baroque approach that should at least be applicable in a number of cases.
rep[a : f[__Plus]] :=
With[
{out = Plus @@ f @@@ Factor[Plus @@ Times @@@ (a /. n_?NumericQ :> Hold[n])]},
(out /. {Hold[n_] :> n, f[x_] :> x}) /; Length[out] == 2
]
Test:
f[a + 3, b + 3, c + 3, 3 + d] // rep
f[1 + x, 2 + x, 3 + x] // rep
f[1 + x, 2 + x, x + y] // rep
3 + f[a, b, c, d]x + f[1, 2, 3]
x + f[y, 1, 2]
There must be a better way but I am too distracted by the patten matching issue to refine this now.
Mr.Wizard
- 271,378
- 34
- 587
- 1,371
-
Thanks! It works great for the question I posed. I added a second example to clarify what I had initially omitted to explain. – olafur Jul 26 '16 at 18:28
4
Maybe this will fit your needs
ReplaceAll[
{
f[a + 3, b + 3, c + 3],
f[x + 3, x + 3, x + 1],
f[x + 2, y + 3, x + 1]
},
f[p__] :> With[{c = Intersection[p]}, c + f @@ ({p} - c)]
(*thanks to J.M.*)
]
]
{ 3 + f[a, b, c], x + f[3, 3, 1], f[2 + x, 3 + y, 1 + x] }
Earlier I overdid it with f[p__] :> With[{c = Plus @@ Intersection @@ (List @@@ {p})}, f @@ (# - c & /@ {p}) + c
Kuba
- 136,707
- 13
- 279
- 740
-
2...or,
f[p__] :> With[{c = Intersection[p]}, c + f @@ ({p} - c)]. – J. M.'s missing motivation Jul 26 '16 at 21:09 -
@J.M. That is indeed better. I have overdid it because of some
fvalues hanging around and messing with my code :) – Kuba Jul 26 '16 at 21:28 -
-
0
With a typed pattern.
ClearAll[Evaluate[Context[] <> "*"]];
k = 1;
ReplaceAll[
{f[a + 1, b + 1, k + c], g[x - π, y - π, -π + z], h[u + 1, v + 2, w + 3]},
f_[p : ((_Symbol + n_?NumericQ) ..)] :> n + f[Sequence @@ Cases[{p}, _Symbol, 2]]
]
(* {1 + f[a, b, c], -π + g[x, y, z], h[1 + u, 2 + v, 3 + w]} *)
Hope this helps.
Edmund
- 42,267
- 3
- 51
- 143
f[a + 3, b + 3, c + 3] /. f[pat : (_ + n_) ..] :> f @@ ({pat} - n) + n. Would you be willing to show what you've tried so that we can get a handle on where you're at, Mathematica-knowledge-wise? – march Jul 26 '16 at 17:57f[a + 3, b + 3, c + 3] /. f[pat : ((_ + n_) ..)] :> n + f @@ ({pat} - n)– march Jul 26 '16 at 18:10a + 3, b + 3, c + 3] /. f[pat : (n_Integer + _) ..] :> f @@ ({pat} - n) + n. – olafur Jul 26 '16 at 18:32_+n_stays the same whilea+3is3+aso repeated element is the first one, not the second like in pattern. This works wellMatchQ[ f[a + 3, b + 3, c + 3], f[Verbatim[Plus][n_, _] ..] ]but I don't know how OS affects that. – Kuba Jul 26 '16 at 18:35Orderlessattribute ofPluswould handle that but I guess not. I really should know this stuff better. :-/ I confirm yourMatchQis true. – Mr.Wizard Jul 26 '16 at 18:37f[p : Verbatim[Plus][___, n_, ___] ..] :> n + f @@ ({p} - n). Please consider posting an answer. – Kuba Jul 26 '16 at 18:40f[1 + x, 2 + x, 3 + x]for example. – Mr.Wizard Jul 26 '16 at 18:49f[Verbatim[Plus][___, n_, ___] ..]– Kuba Jul 26 '16 at 18:57f[pat : (_ + n_) ..] := f @@ ({pat} - n) + n; f[a + 3, b + 3, c + 3]. You could probably do something likeSetAttributes[f, HoldFirst]to make it work... – march Jul 26 '16 at 19:04Orderlessattribute that is the problem). – march Jul 26 '16 at 22:14