# Construct an infix operation from a list

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.

-
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

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[]...

-

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

-

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]]]]

-
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}  *)

-

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

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

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]].

-