2
$\begingroup$

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
   ];
Improve this question
$\endgroup$
4
  • 1
    $\begingroup$ Please show at least one example of what you have tried thus far. $\endgroup$
    – Edmund
    Commented May 2, 2017 at 20:58
  • 1
    $\begingroup$ probably you want to use IntegerPartitions and Permutations $\endgroup$
    – george2079
    Commented May 2, 2017 at 21:00
  • 1
    $\begingroup$ @Edmund I did warn you that it would not be pretty! ^^ See the edit of my question. $\endgroup$
    – Kagaratsch
    Commented May 2, 2017 at 21:47
  • $\begingroup$ Yes. It is less-than ideal. :-) $\endgroup$
    – Edmund
    Commented May 2, 2017 at 23:53

2 Answers 2

Reset to default
6
$\begingroup$ 
ClearAll[fun]
fun[lst_, m_] := Module[{lengths = Join @@ (Permutations /@ 
       IntegerPartitions[Length@lst, {m}, Range[1, Length@lst, 2]])}, 
  Internal`PartitionRagged[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}}}

Improve this answer
$\endgroup$
5
  • 1
    $\begingroup$ This is amazingly short, thank you! $\endgroup$
    – Kagaratsch
    Commented May 2, 2017 at 21:48
  • 1
    $\begingroup$ @Kagaratsch, thank you for the accept. $\endgroup$
    – kglr
    Commented May 2, 2017 at 22:11
  • $\begingroup$ what should I change if I want to switch m from even to odd? $\endgroup$
    – Kagaratsch
    Commented May 2, 2017 at 23:01
  • 1
    $\begingroup$ @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]. $\endgroup$
    – kglr
    Commented May 2, 2017 at 23:10
  • $\begingroup$ Elegant... +1.. $\endgroup$
    – David G. Stork
    Commented May 2, 2017 at 23:41
0
$\begingroup$ 
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}}}

Improve this answer
$\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.