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.

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}};
share|improve this question
    
How did you decide to break list2 into three sublists? –  s0rce Mar 11 '13 at 14:05
2  
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
1  
@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
1  
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}} –  David Carraher Mar 11 '13 at 14:28
add comment

3 Answers 3

up vote 3 down vote accepted

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} *)
share|improve this answer
    
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
add comment

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.

share|improve this answer
add comment

A partial answer:

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

share|improve this answer
    
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
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.