10
$\begingroup$

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.

Improve this question
$\endgroup$
0

5 Answers 5

Reset to default
9
$\begingroup$

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.

Improve this answer
$\endgroup$
7
  • 2
    $\begingroup$ 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. $\endgroup$
    – rcollyer
    Commented May 8, 2012 at 0:33
  • $\begingroup$ 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. $\endgroup$
    – rcollyer
    Commented May 8, 2012 at 2:55
  • $\begingroup$ 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. :) $\endgroup$
    – rcollyer
    Commented May 8, 2012 at 3:06
  • 1
    $\begingroup$ @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. $\endgroup$
    – Oleksandr R.
    Commented May 8, 2012 at 18:15
  • 1
    $\begingroup$ Alongside Internal`PartitionRagged we need Developer`ParitionMapRagged. It would be very useful. $\endgroup$
    – rcollyer
    Commented May 15, 2012 at 16:25
6
$\begingroup$

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.

Improve this answer
$\endgroup$
3
$\begingroup$ 
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}

Improve this answer
$\endgroup$
2
$\begingroup$ 
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}} }*)

Improve this answer
$\endgroup$
0
$\begingroup$

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

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.