How to construct pairs in a list?

I have an expression like this,

    input = x[1] x[2]^3 x[5]^2;


Fist step, we can get a list from the input expression,

    list0={x[1],x[2],x[2],x[2],x[5],x[5]};

list1 = {1, 2, 2, 2, 5, 5};


Second step, I want to get all possible pairs in a new list2. Namely, we divide Length[list1]/2 parts in list1 and combine the possible sublist in a new list. Of course, Length[list1]===Even.

   list2 = {{{1, 2}, {2, 2}, {5, 5}}, {{1, 2}, {2, 5}, {2, 5}} , {{1, 5}, {2, 2}, {2, 5}}};


Last step, we get the output expression,

   output = f[1, 2] f[2, 2] f[5, 5] + f[1, 2] f[2, 5]^2 + f[1, 5] f[2, 2] f[2, 5];


How can I transform the input expression into the output result? Can you show me a simple method that will work for the general problem as well as my example?

In addition, we take another example,

    list1 = {1, 1, 2, 4};


the list2 should be

   list2 = {{1, 1}, {2, 4}}, {{1, 2}, {1, 4}};

• How did you decide to break list2 into three sublists? – s0rce Mar 11 '13 at 14:05
• The relationship between list1 and list2 is not obvious to me. Could you give some further explanation? – m_goldberg Mar 11 '13 at 14:09
• @einbandi. You're right. However, it was a typo. It's really how list2 is derived the bothers me. – m_goldberg Mar 11 '13 at 14:17
• Wouldn't "all" possible pairs from list2 be this?: Tuples[list1, 2] // Union, yielding {{1, 1}, {1, 2}, {1, 5}, {2, 1}, {2, 2}, {2, 5}, {5, 1}, {5, 2}, {5, 5}} – DavidC Mar 11 '13 at 14:28

Another way to get from input to list1:

list1=# & @@@ Flatten[List @@ input /. Power -> ConstantArray]
(* {1, 2, 2, 2, 5, 5} *)


One possible way (without the Combinatorica package and probably not very efficient) to get from list1 to list2:

list2 = Union[
Select[Subsets[Tuples[list1, {2}], {Length@list1/2}],
Sort@Flatten@# == Sort@list1 &],
SameTest -> (Sort[Sort /@ #1] == Sort[Sort /@ #2] &)]
(* {{{1, 2}, {2, 2}, {5, 5}}, {{1, 2}, {2, 5}, {2, 5}}, {{1, 5}, {2, 2}, {2, 5}}} *)


And then, borrowing from kguler's answer:

output=Total@((Times @@ f @@@ #) & /@ list2)
(* f[1, 5] f[2, 2] f[2, 5] + f[1, 2] f[2, 5]^2 + f[1, 2] f[2, 2] f[5, 5] *)


Edit: This updated version should be more general. It works with your second example, too.

Edit 2: To get around the problem adressed in the comments you can use this version of list1. It works just as the earlier version, but also includes the case of only one summand (i.e. the head of input is no longer Plus):

input2 = x[1]^2;
newlist1 = # & @@@ Flatten[{input2} /. {Plus -> Sequence, Power -> ConstantArray}]
(* {1, 1} *)

• Very nice!　This is just what I want. Thanks! – Orders Mar 11 '13 at 15:01
• I find a problem. When input=x[1]^2, we cannot get the correct list1. – Orders Mar 15 '13 at 3:45
• Please take a look at the edited post. I have made the solution more general to include single terms such as your example x[1]^2. – einbandi Mar 15 '13 at 22:34
• f[num_Integer] := Union[Select[Subsets[Tuples[Range[2 num], {2}], {num}], Sort@Flatten@# == Sort@Range[2 num] &], SameTest -> (Sort[Sort /@ #1] == Sort[Sort /@ #2] &)]; Can you find a more simple method? – Orders Mar 17 '13 at 0:46
• f[num_Integer] := Union[Partition[#, 2] & /@ Permutations[Range@num], SameTest -> (Sort[Sort /@ #1] == Sort[Sort /@ #2] &)] – einbandi Mar 17 '13 at 21:04

I take it that the OP gets from list1 to list2 by just taking all distinct partitions in pairs (i.e. the set of all 3 pairs forming list1 when joined). Being lazy, I load

Needs["Combinatorica"]


and then

list2 = Union[
Sort /@ Cases[KSetPartitions[#, Length@#/2],
x_ /; (Min[#] == Max[#] &@(Length /@ x))]] &@list1


which results in the desired output:

{{{1, 2}, {2, 2}, {5, 5}}, {{1, 2}, {2, 5}, {2, 5}}, {{1, 5}, {2, 2}, {2, 5}}}

I am sure there is an easier way but let's see if that's what he wants.

input = x[1] x[2]^3 x[5]^2;
list1 = Flatten[input/.Power|Times->List /.{x[a_], b_}:>ConstantArray[a, {b}] /. x[a_] :> a]
(* {1, 2, 2, 2, 5, 5} *)

list2 = {{{1, 2}, {2, 2}, {5, 5}}, {{1, 2}, {2, 5}, {2, 5}}, {{1, 5}, {2, 2}, {2, 5}}};
output=Total@((Times @@ f @@@ #) & /@ list2)
(* f[1, 5] f[2, 2] f[2, 5] + f[1, 2] f[2, 5]^2 + f[1, 2] f[2, 2] f[5, 5] *)


Missing: how to get list2 from list1 pending clarification from the OP

• I think list2 has ordered subsets of length 2 of list1 so that each element of list1 is selected at most once – gpap Mar 11 '13 at 14:31
constructPairs[input_] := Block[{func, f, list1, permutepart, list2},
func[x[t_]] := t;
func[x[t_]^m_] := ConstantArray[t, m];

list1 = Flatten[Map[func]@Cases[input, p : (t_x | x[_]^_) :> p]];
permutepart = Apply[Partition[{##}, 2] &, Permutations[list1], {1}];
list2 = DeleteDuplicates@*Map[Sort]@Cases[permutepart, p : {{_, _} ..} :> Map[Sort, p]];

Plus @@ Times @@@ Apply[f, list2, {2}]
];


supplying input to function:

input = x[1] x[2]^3 x[5]^2;
constructPairs[input]

(* f[1, 5] f[2, 2] f[2, 5] + f[1, 2] f[2, 5]^2 + f[1, 2] f[2, 2] f[5, 5] *)
`