10

Consider the following demand of products for the next four months.

data={1,20,3,40};

I could produce the whole demand in the first months, leading to the following "production vector": {63,0,0,0}.

As you can imagine, producing everything in the first month leads to high costs of inventory. Another possibility would be {21,0,43,0}.

Now I would like to get all possible combinations of the subsets of data, leading to:

results=
{{{1},{20,3,40}},
{{1,20},{3,40}},
{{1,20,3},{40}},
{{1},{20,3},{40}},
{{1},{20},{3},{40}},
{1,20,3,4}
}

It is important that Table[Map[Flatten,results][[i]]==data,{i,Length@results}] is True for all i. This means that each sublist of results has the same order of figures as in data.

Mr.Wizard
  • 271,378
  • 34
  • 587
  • 1,371
John
  • 4,361
  • 1
  • 26
  • 41

5 Answers5

9

I would use:

data = {1, 20, 3, 40};

Join @@ Permutations /@ IntegerPartitions[Length@data];

results = Internal`PartitionRagged[data, #] & /@ %

{{4}, {3, 1}, {1, 3}, {2, 2}, {2, 1, 1}, {1, 2, 1}, {1, 1, 2}, {1, 1, 1, 1}}

{{{1, 20, 3, 40}},
 {{1, 20, 3}, {40}},
 {{1}, {20, 3, 40}},
 {{1, 20}, {3, 40}},
 {{1, 20}, {3}, {40}},
 {{1}, {20, 3}, {40}},
 {{1}, {20}, {3, 40}},
 {{1}, {20}, {3}, {40}}}

IntegerPartitions is used get the ways in which you can split a list, to be used with the function above. Permutations is used to get all orders of these. By the way, you could use the function Compositions from the Combinatorica package in place of both of these if you want to include zeros.

These specifications are fed to Internal`PartitionRagged which splits a list into given lengths, e.g. [{1,2,3,4,5}, {2,1,2}] -> {{1,2}, {3}, {4,5}}. Users of Mathematica versions prior to 8 can use my dynamicPartition function in its place.

Community
  • 1
Mr.Wizard
  • 271,378
  • 34
  • 587
  • 1,371
  • 2
    You have my +1, but could you go into some detail about the individual steps involved, as I have no idea how you came up with that function. I see how it works, but I think additional exposition would help myself, and the newbies, understand it better. – rcollyer May 08 '12 at 00:33
  • Better, but I was trying to understand how dynP works. From what I read Accumulate@p creates a list of partition points, specifically the end points of the sublists. {0}~Join~Most@# shifts the list of points to the right, adding 1 to which creates the start points. Then it is just a matter of supplying those values to Part. – rcollyer May 08 '12 at 02:55
  • Actually, it would be preferable if the explanation were here as the ToolBag has been closed, and is on SO. That said, when I replied, I did not notice the link. Sorry. :) – rcollyer May 08 '12 at 03:06
  • @rcollyer as I recall someone (Oleksandr?) posted a version-8 Internal or Developer function that does what my dynP function does. Do remember what it is? Perhaps we can use that instead and just leave a link to the Toolbag post for prior version users. – Mr.Wizard May 08 '12 at 05:34
  • 1
    @Mr.Wizard you're probably thinking of Internal`PartitionRagged, which for version 8 is indeed equivalent to your dynP. Actually I've never had cause to use it personally, but Andy Ross mentioned it here. – Oleksandr R. May 08 '12 at 18:15
  • @Oleksandr thank you! I should take better notes. – Mr.Wizard May 08 '12 at 20:06
  • 1
    Alongside Internal`PartitionRagged we need Developer`ParitionMapRagged. It would be very useful. – rcollyer May 15 '12 at 16:25
6

You might generate all subsets by placing special markers (asterisks) where a list should be split.

data = {1, 20, 3, 40};

(* The asterisks "*" indicate where a list should be split *)
data1 = Insert[data, "*", #] & /@ (Subsets[Range[2, Length[data]]] /.  a_Integer :>  {a})

(* out *)   
{{1, 20, 3, 40}, {1, "*", 20, 3, 40}, {1, 20, "*", 3, 40}, {1, 20, 3, "*", 40}, 
 {1, "*", 20, "*", 3, 40}, {1, "*", 20, 3, "*", 40}, {1,  20, "*", 3, "*", 40}, 
 {1, "*", 20, "*", 3, "*", 40}}

(*  s actually does the splitting  *)
s[list_] := Split[list, # =!= "*" &]

(* t removes asterisks *)
t[list_] := DeleteCases[#, "*"] & /@ list

t[#] & /@ (s[#] & /@ data1)

(* out *)
{{{1, 20, 3, 40}}, {{1}, {20, 3, 40}}, {{1, 20}, {3, 40}}, {{1, 20, 3}, {40}}, 
 {{1}, {20}, {3, 40}}, {{1}, {20, 3}, {40}}, 
 {{1, 20}, {3}, {40}}, {{1}, {20}, {3}, {40}}}

Note

The following snippet targeted all the positions in data where splits could be made:

Subsets[Range[2, Length[data]]] 
(*  out *)

{{}, {2}, {3}, {4}, {2, 3}, {2, 4}, {3, 4}, {2, 3, 4}}

So the first list had no splits; the second list was split at position 2, that is, after the first element; the third list was split at position 3; ... and the final list was split at positions 2, 3 and 4.

DavidC
  • 16,724
  • 1
  • 42
  • 94
3
data = {1, 20, 3, 40};
i = Join @@ Permutations /@ IntegerPartitions[Length[data]];

In version 11.2 TakeList is introduced which does the same thing as Internal'PartitionRagged plus more. But even though TakeList has more functionality, it evaluates much faster:

Do[Internal`PartitionRagged[data, #] & /@ i, {1000}] // RepeatedTiming
Do[                TakeList[data, #] & /@ i, {1000}] // RepeatedTiming

{0.337, Null}
{0.0210, Null}

Coolwater
  • 20,257
  • 3
  • 35
  • 64
2
Needs["Combinatorica`"]
Map[data[[#]] &, 
 Select[SetPartitions[Range[4]], OrderedQ[Flatten@#] &], {2}]

giving

(*{ {{1, 20, 3, 40}},

{{1}, {20, 3, 40}},

{{1, 20}, {3, 40}},

{{1, 20, 3}, {40}},

{{1}, {20}, {3, 40}},

{{1}, {20, 3}, {40}},

{{1, 20},{3}, {40}},

{{1}, {20}, {3}, {40}} }*)

user1066
  • 17,923
  • 3
  • 31
  • 49
0

TakeDrop and FoldPairlist combination for versions 10+:

Using the first part of Mr.Wizard's answer to generate the partition lengths,

lengths = Join @@ Permutations /@ IntegerPartitions[Length @ data];

FoldPairList[TakeDrop, data, #]& /@ lengths  // Column

enter image description here

kglr
  • 394,356
  • 18
  • 477
  • 896