Iterating through a set of sublists to find some desired sublists

Question

I looked at three answers, including the previous ones, but Syed and I just noticed that running Subsets[Range[n]] when $n$ is large first seems to take up a lot of memory. I hope I haven’t misunderstood. If that's the case, it goes against my original intention.

Earlier, in the question, we inquired about finding all the subsets that meet the desired conditions, and Daniel Huber provided an answer.

d = Subsets[Range[6]];
Reap[
  Scan[(If[Total[#] > 15, Sow[#]]) &, d]][[2]]

I'm now wondering if, instead of retrieving all the valid subsets, we only need to find the first $k$ subsets and stop once they are found.

For example, I only want to find 5 subsets s such that Total[s] > 15. The premise remains to avoid generating all subsets at once, considering memory usage.

Answer 1

If you want to stop after e.g. 5 hits, you must replace Scan by a Do loop and use Return:

d = Subsets[Range[6]];
count = 0;
Reap[Do[If[Total[d[[i]]] > 15, Sow[d[[i]]]; If[++count >= 5, Return[]]]
   , {i, Length[d]}]
  ][[2, 1]]

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

Answer 2

only need to find the first k subsets and stop once they are found.

If I understand you right, then you can do the following.

Instead of

d = Subsets[Range[6]];
Reap[Scan[(If[Total[#] > 15, Sow[#]]) &, d]][[2]]

You can use a loop. Inside the loop, just add an if statement to check if you found as many items as you want, and if so, then break out of the loop.

This is how we used to program in the good old days instead of all this fancy functional programming :)

ps. I looked at Scan but did not find a way to stop it at a condition, that is why I used a Do loop.

d = Subsets[Range[6]];
k = 0;
maxItemsNeeded = 3; (*change as neeed *)
Last@Reap@Do[
        If[Total[d[[n]]] > 15,
            k++;
            If[k > maxItemsNeeded,
                 Break[]
                 ,
                 Sow[ d[[n]] ]
             ]
         ]
        ,
        {n, 1, Length@d}
       ]

Answer 3

Without generating subsets:

n = 6;
count = 0;
elems = Range@n;
thresh = 5;
Do[
    x = IntegerDigits[i, 2, n] elems ;
    (*Echo[{count,i,x}];*)
    If[Total@x > 15,
     count++;
     If[count > thresh, Break[]
      , Sow[Select[x, Positive]]
      ]
     ]
    , {i, 0, 2^n - 1}
    ] // Reap // Last // First

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

------------------ Original

Use the third argument of Select:

d = Subsets[Range[6]];
Select[d, GreaterThan[15]@*Total, 5]

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

Answer 4

An alternative is to use Catch and Throw instead of Break. Thus, a variant of @Syed's answer is:

n = 6;
elems = Range@n;
thresh = 5;

Catch[Module[{ssets = {}}, Do[x = IntegerDigits[i, 2, n]  elems;
   If[Total@x > 15, If[Length[ssets] >= thresh, Throw[ssets]];
    AppendTo[ssets, Select[x, Positive]];], {i, 0, 2^n - 1}]; ssets]]

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