5
$\begingroup$

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.

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

4 Answers 4

8
$\begingroup$
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}}
$\endgroup$
1
  • $\begingroup$ that's a wonderful solution @Kuba! $\endgroup$
    – krzysiekb
    Nov 18, 2013 at 10:15
5
$\begingroup$

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}}
$\endgroup$
1
  • $\begingroup$ Nice fix.... +1 $\endgroup$ Nov 15, 2013 at 12:38
4
$\begingroup$

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]]
$\endgroup$
1
$\begingroup$
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}}

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.