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 a problem with the following task: having some nested list

list = {{k6},{k1,k3,k5},{k7}}

I would like to replace all sublists by their permutations and then split original list w.r.t. these permutations. So I started with permutations

list1 = {{{k6}},{{k1,k3,k5},{k1,k5,k3},{k3,k1,k5},{k3,k5,k1},{k5,k1,k3},{k5,k3,k1}},{{k7}}}

but I got stuck at this point - how to split this list w.r.t. sublists, i.e. to get:

list2 = {{{{k6}},{{k1,k3,k5}},{{k7}}},{{{k6}},{{k1,k5,k3}},{{k7}}},...}

Then I would like also to obtain a list of the form

{{k6,k1,k3,k5,k7},{k6,k1,k5,k3,k7},...}

Perhaps there is a simpler method to do this?

Obviously, if e.g.

list = {{k6},{k1,k3},{k2,k5},{k7}}

then the splitting should give list with all combinations of permutations of {k1,k3} and {k2,k5} taken into account preserving original order.

share|improve this question
    
If I understood Your problem correctly Flatten[] with level consideration should solve it. –  Wojciech Nov 15 '13 at 11:33
    
@Kuba The number of sublists is variable. I think yours is the only solution that works under this condition so far. –  belisarius Nov 15 '13 at 12:03
    
@belisarius ok, that was my guess –  Kuba Nov 15 '13 at 12:19

4 Answers 4

list = {{k6}, {k1, k3, k5}, {k7}};

Flatten /@ Tuples[Permutations /@ list]
{{k6, k1, k3, k5, k7}, {k6, k1, k5, k3, k7}, {k6, k3, k1, k5, k7}, 
  {k6, k3, k5, k1, k7}, {k6, k5, k1, k3, k7}, {k6, k5, k3, k1, k7}}
share|improve this answer
    
that's a wonderful solution @Kuba! –  krzysiekb Nov 18 '13 at 10:15

A rule based approach:

l = {{k6}, {k1, k3, k5}, {k7}}
l1 = Permutations /@ l
l2 = ReplaceList[l1, {{___, a_, ___}, {___, b_, ___}, {___, c_, ___}} -> {a, b, c}]
(*
 {{{k6}, {k1, k3, k5}, {k7}}, 
  {{k6}, {k1, k5, k3}, {k7}}, 
  {{k6}, {k3, k1, k5}, {k7}}, 
  {{k6}, {k3, k5, k1}, {k7}}, 
  {{k6}, {k5, k1, k3}, {k7}}, 
  {{k6}, {k5, k3, k1}, {k7}}}
*)

You can do

 Flatten /@l2

If you want to get flattened lists as the result

Edit

The following works for variable number of lists. Perhaps not elegant, but I wanted to stick with ReplaceList[]:

l = {{k6}, {k1, k3, k5}, {k7}}
l1 = Permutations /@ l
l2 = ReplaceList[l1, Array[ToExpression["{___,x" <> ToString[#] <> "_,___}"] &, Length@l] -> 
                     Array[ToExpression["x" <> ToString[#]] &, Length@l]]

Or shorter (by @PinguinDirk)

ReplaceList[l1, With[{vars = (Unique["x"] & /@ Range[Length@l1])}, 
                     {___, Pattern[#, Blank[]], ___} & /@ vars -> vars]]
share|improve this answer

SlotSequence helps providing an elegant and terse style of Mathematica programming:

Outer[ ## &, ## & @@ list1, 1]
{{{{k6}, {k1, k3, k5}, {k7}}, {{k6}, {k1, k5, k3}, {k7}}, 
  {{k6}, {k3, k1, k5}, {k7}}, {{k6}, {k3, k5, k1}, {k7}}, 
  {{k6}, {k5, k1, k3}, {k7}}, {{k6}, {k5, k3, k1}, {k7}}}}

or satisfying another expectation in the question:

Apply[ ## &, %, {3}][[1]]
{{k6, k1, k3, k5, k7}, {k6, k1, k5, k3, k7}, {k6, k3, k1, k5, k7}, 
 {k6, k3, k5, k1, k7}, {k6, k5, k1, k3, k7}, {k6, k5, k3, k1, k7}}
share|improve this answer
    
Nice fix.... +1 –  belisarius Nov 15 '13 at 12:38
list1 = Permutations[#] & /@ list;
Flatten[{{First[list1] /. List -> Sequence, # /. List -> Sequence, 
     Last[list1] /. List -> Sequence}} & /@ list1[[2 ;; -2]][[1]], 1]

{{k6, k1, k3, k5, k7}, {k6, k1, k5, k3, k7}, {k6, k3, k1, k5, k7}, {k6, k3, k5, k1, k7}, {k6, k5, k1, k3, k7}, {k6, k5, k3, k1, k7}}

share|improve this answer

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.