# 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? Mar 11, 2013 at 14:05
• The relationship between list1 and list2 is not obvious to me. Could you give some further explanation? Mar 11, 2013 at 14:09
• @einbandi. You're right. However, it was a typo. It's really how list2 is derived the bothers me. Mar 11, 2013 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}} Mar 11, 2013 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! Mar 11, 2013 at 15:01
• I find a problem. When input=x[1]^2, we cannot get the correct list1. Mar 15, 2013 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. Mar 15, 2013 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? Mar 17, 2013 at 0:46
• f[num_Integer] := Union[Partition[#, 2] & /@ Permutations[Range@num], SameTest -> (Sort[Sort /@ #1] == Sort[Sort /@ #2] &)] Mar 17, 2013 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, 2013 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] *)
`