9
$\begingroup$
list = {2, 1, 8, 10, 1, 4, 4, 5, 3, 4, 4, 11, 12};

th = 10;

It is easy to create sublists whose totals don't exceed th:

SequenceCases[list, a : {___} /; Total[a] <= th :> a]

{{2, 1}, {8}, {10}, {1, 4, 4}, {5, 3}, {4, 4}, {}, {}}

But how can we include the exceeding element to get

{{2, 1, 8}, {10, 1}, {4, 4, 5}, {3, 4, 4}, {11}, {12}}

I tried many combinations like for example:

SequenceCases[list, a : {Shortest[__]} /; Total[a] > th :> a]

{{2, 1, 8, 10, 1, 4, 4, 5, 3, 4, 4, 11, 12}}

To see what went wrong with this and other attempts I would like to get a solution, if possible, with one of the Sequence- or Replace-functions.

$\endgroup$
1
  • $\begingroup$ Shortest subset? sublist? subsequence? $\endgroup$
    – A. Kato
    Commented Jun 19 at 7:30

7 Answers 7

9
$\begingroup$

Why not just use Most:

list = {2, 1, 8, 10, 1, 4, 4, 5, 3, 4, 4, 11, 12};
th = 10;

SequenceCases[list, a : {___} /; Total[Most[a]] <= th :> a]

(*{{2, 1, 8}, {10, 1}, {4, 4, 5}, {3, 4, 4}, {11}, {12}}*)
$\endgroup$
4
$\begingroup$

I may have misunderstood but this finds shortest subset satisfying constraint:

list = {2, 1, 8, 10, 1, 4, 4, 5, 3, 4, 4, 11, 12};
fun[u_] := 
 Module[{j = 1, a = {}}, 
  While[Length[a] == 0, a = Select[Subsets[list, {j}], Total@# > u &];
    j++]; a]
Table[{j, fun[j][[1]]}, {j, {5, 13, 29, 40}}] // Grid

enter image description here

$\endgroup$
4
$\begingroup$
list = {2, 1, 8, 10, 1, 4, 4, 5, 3, 4, 4, 11, 12};
th = 10;

f = SequenceCases[#, {a___, e_} /; ! Max@Accumulate@{a} > th :> {a, e}] &;
f@list

{{2, 1, 8}, {10, 1}, {4, 4, 5}, {3, 4, 4}, {11}, {12}}

list2 = {2, 9, -8, 10, 1, 4, 4, 5, 3, 4, 4, 11, 12};
f@list2

{{2, 9}, {-8, 10, 1, 4, 4}, {5, 3, 4}, {4, 11}, {12}}

$\endgroup$
4
$\begingroup$
split[lst_, th_] := Module[{t = 0}, Split[lst, Or[(t += #) <= th, t = 0] &]];

Examples:

list = {2, 1, 8, 10, 1, 4, 4, 5, 3, 4, 4, 11, 12};

split[list, 10]
 {{2, 1, 8}, {10, 1}, {4, 4, 5}, {3, 4, 4}, {11}, {12}}
split[list, 11]
{{2, 1, 8, 10}, {1, 4, 4, 5}, {3, 4, 4, 11}, {12}}
$\endgroup$
1
  • 1
    $\begingroup$ Excellent ! Very nice and esthetic code. Thanks $\endgroup$ Commented Jun 22 at 22:16
3
$\begingroup$

Assume what you want is just one instance of shortest consecutive sequence of the elements in the list. Then following pattern matching will help you:

th=10;

list /. {___, Shortest[a___ /; Total[{a}] > th], ___} :> {a}

(* {11} *)

th=40;

list /. {___, Shortest[a___ /; Total[{a}] > th], ___} :> {a}

(* {4, 5, 3, 4, 4, 11, 12} *)

If you need more instances,

 ReplaceList[list, {___, Shortest[a___ /; Total[{a}] > th], ___} :> {a}]

will give you more, and you can select what you want. For example,

 th=10;
 ReplaceList[list, {___, Shortest[a___ /; Total[{a}] > th], ___} :> {a}]

enter image description here

$\endgroup$
1
$\begingroup$
list = {2, 1, 8, 10, 1, 4, 4, 5, 3, 4, 4, 11, 12};
th = 10;

A more programmatic way to do it is the following:

 fun[list_, th_] := Module[{sum = 0, sublist = {}, res = {}, i = 1},
    While[i <= Length[list], sum += list[[i]];
    AppendTo[sublist, list[[i]]];
    If[sum > th, AppendTo[res, sublist];
    sublist = {};sum = 0;]; i++;];
    If[sublist =!= {}, AppendTo[res, sublist]]; res];

 fun[list, th]

{{2, 1, 8}, {10, 1}, {4, 4, 5}, {3, 4, 4}, {11}, {12}}

$\endgroup$
1
$\begingroup$

Other way with AppendTo :

list = {2, 1, 8, 10, 1, 4, 4, 5, 3, 4, 4, 11, 12};
th = 10;

t=s={};(AppendTo[t,#];
If[Total[t]>th,AppendTo[s,t];
t={}])&/@list;s

{{2, 1, 8}, {10, 1}, {4, 4, 5}, {3, 4, 4}, {11}, {12}}

$\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.