# How to split a list with respect to its nested sublists?

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.

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

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}}

• that's a wonderful solution @Kuba! Nov 18, 2013 at 10:15

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}}

• Nice fix.... +1 Nov 15, 2013 at 12:38

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]]

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}}