Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

Inspired by this question, if I have a list

{a, p, b, q, c}

where p and q are binary operators, such as Plus and Times, how would I construct the expression

a ~ p ~ b ~ q ~ c

and execute it?

Obviously, the solution proposed in the other question of constructing it via strings is the most straightforward approach, but I would like to know if the infix formulation, above, is doable without resorting to string manipulation.

share|improve this question
    
Does Hold[{a, Plus, b, Times, c}] //. {PatternSequence[a_, p_, b_, c___]} :> {p[a, b], c} work? –  J. M. Nov 22 '12 at 6:39
    
@J.M. it looks like it does. I expected that to take a little longer, but I've been up for quite a while now. –  rcollyer Nov 22 '12 at 6:52

6 Answers 6

up vote 8 down vote accepted

Two variants:

(* left-associative *)
Hold[a, Times, b, Plus, c, Subtract, f] //. f_[a_, p_, b_, c___] :> f[p[a, b], c]
 (* Hold[(a b + c) - f] *)

(* right-associative *)
Hold[a, Times, b, Plus, c, Subtract, f] //. f_[c___, a_, p_, b_] :> f[c, p[a, b]]
 (* Hold[a (b + (c - f))] *)

after which one can apply ReleaseHold[]...

share|improve this answer

Looks like I'm late to the party but I can still have fun with the existing answers.

Terse form of István's method:

x = {a, p, b, q, c, r, d, s, e};

First@Nest[{#2[#, #3], ##4} & @@ # &, x, (Length@x - 1)/2]

With two-parameter Fold syntax kguler's foldF can be written:

Fold[{##} /. {{x_, f_}, y_} :> x ~f~ y &, #] &

Last but not least a method based on Rojo's answer:

infixate =
  Module[{f},
    SetAttributes[f, HoldAll];
    f @@ # //. {f@i_ :> i, f[a1__, h_, a2_] :> h[f@a1, a2]}
  ] &;

{a, p, b} // infixate
p[a, b]
Hold[a, Print, 2 + 2, q, 8/4, r, d, Hold, e] // infixate
Hold[r[q[Print[a, 2 + 2], 8/4], d], e]

Here's one more I couldn't pass by, even though it is string-based:

x = {a, Times, b, Plus, c, Subtract, f};

ToExpression@ToString@Row[x, "~"]
a b + c - f
share|improve this answer
    
Quotient[] is nice: First@Nest[{#2[#, #3], ##4} & @@ # &, x, Length@x ~Quotient~ 2] –  J. M. Nov 23 '12 at 2:16
    
I was hoping you'd join the party. Now I have to decide on a winner. –  rcollyer Nov 23 '12 at 2:25
    
@rcollyer J.M.'s, clearly, IMHO. –  Mr.Wizard Nov 23 '12 at 2:26
2  
Since we all know you just loooooove infix and are always keen to save a few characters, why not try, instead of Module/SetAttributes, f ~Unique~ {HoldAll, Temporary}... (and +1, of course!) –  Oleksandr R. Nov 24 '12 at 2:31
    
@Oleksandr Interesting proposition. :-) –  Mr.Wizard Nov 25 '12 at 1:38

Is this what you want?

f[{i_}] := i;
f[{a1__, h_, a2_}] := h[f[{a1}], a2]

So

{a, p, b, q, c}//f

(* q[p[a, b], c] *)

It doesn't respect holding attributes, but Plus and Times don't hold their arguments anyway

share|improve this answer

Implementation with Nest. Note, that this version is left-associative, and requires an input list of $2n+1$ elements (with $n$ infix operators):

x = {a, p, b, q, c, r, d, s, e};

First@Nest[{#[[2]][#[[1]], #[[3]]], Sequence @@ Drop[#, 3]} &, x, (Length@x - 1)/2]
s[r[q[p[a, b], c], d], e]

Right-associative:

First@Nest[{Sequence @@ Drop[#, -3], #[[-2]][#[[-3]], #[[-1]]]} &, x, (Length@x - 1)/2]
p[a, q[b, r[c, s[d, e]]]]
share|improve this answer
    
Alternatively: First @ Nest[Prepend[Drop[#, 3], #[[1]] ~#[[2]]~ #[[3]]] &, x, Quotient[Length @ x, 2]] and First @ Nest[Append[Drop[#, -3], #[[-3]] ~#[[-2]]~ #[[-1]]] &, x, Quotient[Length @ x, 2]] –  J. M. Nov 22 '12 at 7:39
 foldF = Fold[{#1, #2} /. {{x_, f_}, y_} :> f[x, y] &, First@#, Rest@#] &;
 foldF /@ {{a, p, b, q, c, r, d, s, e},
     {a, Times, b, Plus, c, Subtract, d, Divide, e},
     {2, Times, 3, Plus, 4, Subtract, 5, Divide, 2}}
 (* {s[r[q[p[a,b],c],d],e], (a*b+c-d)/e, 5/2} *)

  ClearAll[fldInfiX, infiX, evaluateF];
  evaluateF = # //. Infix[x__] :> x &;
  infiX[x_] := x;
  infiX[f_[x_, y_]] := Infix[f[x, y]];
  fldInfiX = Function[{lst}, Fold[{#1, #2} /. {{x_, f_}, y_} :> infiX[f[x, y]] &,
       First@lst, Rest@lst]];
  fldInfiX /@ {{a, op1, b, op2, c},
     {a, Times, b, Plus, c}, {1, Times, 2, Plus, 3},
    {5, Subtract, 2, Plus, 12, Divide, 2}}
  (* {(a~op1~b)~op2~c, c~Plus~(a~Times~b), 5, 15~Rational~2}  *)
  evaluateF /@ %
  (* {op2[op1[a, b], c], a*b + c, 5, 15/2}  *)
share|improve this answer

You need to reformulate the question: you can't do this generally without declaring the precedence of p and q. If p takes precedence of q, your expression is fully represented as

{{a,p,b},q,c}

otherwise it is

{a,p,{b,q,c}}

Once you've done that, use this replacement:

{a, p, {b, q, c}} //. {x_, f_, y_} -> Infix@f[x, y]
{{a, p, b}, q, c} //. {x_, f_, y_} -> Infix@f[x, y]

For this output:

a~p~(b~q~c)
(a~p~b)~q~c

What you probably want though, is the Notations package:

Needs["Notation`"]
InfixNotation[ParsedBoxWrapper["\"~p~\""], p]
InfixNotation[ParsedBoxWrapper["\"~q~\""], q]

Then, when you enter

p[a, q[b,c]]

the output is automatically

a ~p~ (b ~q~ c)

but the internal representation is still p[a, q[b,c]].

share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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