# Cut a list of length n into even number m of adjacent sublists of odd length in all possible ways?

Consider a list with all different entries of length n, i.e. for n=6:

list = {1,2,3,4,5,6};


I would like to have a function fun[lst_,m_] that given this list will return a list of lists containing all possible ways to cut list into m adjacent sublists, such that the length of each sublist is odd:

fun[list,0]


False

fun[list,2]


{ {{1,2,3,4,5},{6}} , {{1,2,3},{4,5,6}} , {{1},{2,3,4,5,6}} }

fun[list,4]


{ {{1,2,3},{4},{5},{6}} , {{1},{2,3,4},{5},{6}} , {{1},{2},{3,4,5},{6}} , {{1},{2},{3},{4,5,6}} }

fun[list,6]


{ {{1},{2},{3},{4},{5},{6}} }

Again, notice that the resulting list contains lists that divide list into an even number m of sublists, each of which has odd length.

Is there a quick way to implement this in Mathematica?

EDIT

Due to popular demand, behold my monstrosity:

fun[lst_, m_] := Module[{prt,odd, tmp, tmp2, prm, pt},
prt = IntegerPartitions[Length[lst], {m}];
tmp = {};
Do[
odd = True;
Do[
If[EvenQ[prt[[i, j]]], odd = False;];
, {j, 1, Length[prt[[i]]]}];
If[odd, AppendTo[tmp, prt[[i]]];];
, {i, 1, Length[prt]}];
tmp2 = {};
Do[
prm = Permutations[tmp[[i]]] // DeleteDuplicates;
Do[
pt = {};
Do[
AppendTo[pt, lst[[Total[prm[[j, 1 ;; q - 1]]] + 1 ;; Total[prm[[j, 1 ;; q]]]]]];
, {q, 1, Length[prm[[j]]]}];
AppendTo[tmp2, pt];
, {j, 1, Length[prm]}];
, {i, 1, Length[tmp]}];
tmp2
];

• Please show at least one example of what you have tried thus far. Commented May 2, 2017 at 20:58
• probably you want to use IntegerPartitions and Permutations Commented May 2, 2017 at 21:00
• @Edmund I did warn you that it would not be pretty! ^^ See the edit of my question. Commented May 2, 2017 at 21:47
• Yes. It is less-than ideal. :-) Commented May 2, 2017 at 23:53

ClearAll[fun]
fun[lst_, m_] := Module[{lengths = Join @@ (Permutations /@
IntegerPartitions[Length@lst, {m}, Range[1, Length@lst, 2]])},
InternalPartitionRagged[lst, #] & /@ lengths]

fun[Range[6], 0]


{}

fun[Range[6], 2]


{{{1, 2, 3, 4, 5}, {6}}, {{1}, {2, 3, 4, 5, 6}}, {{1, 2, 3}, {4, 5, 6}}}

fun[Range[6], 4]


{{{1, 2, 3}, {4}, {5}, {6}}, {{1}, {2, 3, 4}, {5}, {6}}, {{1}, {2}, {3, 4, 5}, {6}}, {{1}, {2}, {3}, {4, 5, 6}}}

fun[Range[6], 6]


{{{1}, {2}, {3}, {4}, {5}, {6}}}

• This is amazingly short, thank you! Commented May 2, 2017 at 21:48
• @Kagaratsch, thank you for the accept.
– kglr
Commented May 2, 2017 at 22:11
• what should I change if I want to switch m from even to odd? Commented May 2, 2017 at 23:01
• @Kagaratsch, if you still want to have each sublist to have an odd length, you don't have to change anything (m could be even or odd). If you want to have each sublist to have even length, use Range[2, Length@lst, 2] instead of Range[1, Length@lst, 2].
– kglr
Commented May 2, 2017 at 23:10
• Elegant... +1.. Commented May 2, 2017 at 23:41
list = {1, 2, 3, 4, 5, 6};

ReplaceList[list, {
a__ /; OddQ@Length@{a}
, b__ /; OddQ@Length@{b}
} :> {{a}, {b}}
]


{{{1}, {2, 3, 4, 5, 6}}, {{1, 2, 3}, {4, 5, 6}}, {{1, 2, 3, 4, 5}, {6}}}

ReplaceList[list, {
a__ /; OddQ@Length@{a}
, b__ /; OddQ@Length@{b}
, c__ /; OddQ@Length@{c}
, d__ /; OddQ@Length@{d}
} :> {{a}, {b}, {c}, {d}}
]


{{{1}, {2}, {3}, {4, 5, 6}}, {{1}, {2}, {3, 4, 5}, {6}}, {{1}, {2, 3, 4}, {5}, {6}}, {{1, 2, 3}, {4}, {5}, {6}}}

ReplaceList[list, {
a__ /; OddQ@Length@{a}
, b__ /; OddQ@Length@{b}
, c__ /; OddQ@Length@{c}
, d__ /; OddQ@Length@{d}
, e__ /; OddQ@Length@{e}
, f__ /; OddQ@Length@{f}

} :> {{a}, {b}, {c}, {d}, {e}, {f}}
]
`

{{{1}, {2}, {3}, {4}, {5}, {6}}}