8
$\begingroup$

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.

$\endgroup$
23
  • 3
    $\begingroup$ 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$
    – march
    Jul 26, 2016 at 17:57
  • 2
    $\begingroup$ In addition, can you expand on your problem? It's not specified enough, and so it's quite possible that people will spend time figuring out how to answer your question, and then you'll show a different example on which it fails. Or maybe it'll be a case where you want to specify what number (e.g. 3) gets pulled out. Please include more information in your post, and then I will consider posting an answer. $\endgroup$
    – march
    Jul 26, 2016 at 18:01
  • 2
    $\begingroup$ @march Your proposed replacement doesn't seem to work for me. Could you check it? $\endgroup$
    – MarcoB
    Jul 26, 2016 at 18:03
  • 2
    $\begingroup$ @Mr.Wizard and rest, isn't it a reordering somewhere what causes that? _+n_ stays the same while a+3 is 3+a so repeated element is the first one, not the second like in pattern. This works well MatchQ[ f[a + 3, b + 3, c + 3], f[Verbatim[Plus][n_, _] ..] ] but I don't know how OS affects that. $\endgroup$
    – Kuba
    Jul 26, 2016 at 18:35
  • 2
    $\begingroup$ @march Here is your replacement rule compatible with Windows :P f[p : Verbatim[Plus][___, n_, ___] ..] :> n + f @@ ({p} - n). Please consider posting an answer. $\endgroup$
    – Kuba
    Jul 26, 2016 at 18:40

3 Answers 3

5
$\begingroup$

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.

$\endgroup$
1
  • $\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$
    – olafur
    Jul 26, 2016 at 18:28
4
$\begingroup$

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

$\endgroup$
4
  • 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
  • $\begingroup$ I'm happy you did. $\endgroup$ Jul 27, 2016 at 6:35
0
$\begingroup$

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.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.