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.
3 Answers
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.
-
$\begingroup$ Thanks! It works great for the question I posed. I added a second example to clarify what I had initially omitted to explain. $\endgroup$– olafurJul 26, 2016 at 18:28
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
-
2$\begingroup$ ...or,
f[p__] :> With[{c = Intersection[p]}, c + f @@ ({p} - c)]
. $\endgroup$ Jul 26, 2016 at 21:09 -
$\begingroup$ @J.M. That is indeed better. I have overdid it because of some
f
values hanging around and messing with my code :) $\endgroup$– Kuba ♦Jul 26, 2016 at 21:28 -
$\begingroup$ @J.M. I used your example, if that is not a problem :) $\endgroup$– Kuba ♦Jul 27, 2016 at 5:33
-
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.
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? $\endgroup$_+n_
stays the same whilea+3
is3+a
so 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. $\endgroup$f[p : Verbatim[Plus][___, n_, ___] ..] :> n + f @@ ({p} - n)
. Please consider posting an answer. $\endgroup$