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
add comment

5 Answers 5

up vote 7 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
add comment

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]

On my machine 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
add comment

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
add comment
 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
add comment

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
add comment

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.