While loop in Mathematica: multiple outputs

Question

I have worked on a random number generator in Mathematica, suppressed by a number of conditions. Right now my code looks like this:

list = RandomSample[Range[36], 7];
f := If[1 <= Count[Select[list, # <= 12 &], _Integer] <= 2,
  If[Count[Select[list, # > 31 &], _Integer] >= 1,
   If[Count[Select[list, Divisible[#, {2, 7}] &], _Integer] <= 3, 
    Sort[list], False], False], False]
While[f == False,
  list = RandomSample[Range[36], 7];
  If[list == f, f]];
f

It is build up like this:

1. A random list of 7 integers of the interval 1-36 is made
2. f defines some conditions that have to be met: at least one and at most two elements in the range 1-12. At least one element greater than 31. At most 3 elements can be divisible be the integers in the range 2-7.
3. If the conditions are met, f equals the list, False otherwise.
4. Next thing is the "While" loop. If f is False, then a new list i generated, and this loop continues until f i no longer False.
5. The result stored in f is called.

The thing is now: this only produces one line of output. I am interested in getting multiple outputs, e.g. 5-10. I have tried to do it in some way with the Table command, but the thing is that nothing defines both the function f and the while loop at the same time. So, by running table on f, I only get the same result a lot of times.

Any input on how to proceed here?

Answer 1

I don't think the third line in your definition of f is doing what you think it's doing. Consider for example

Divisible[20, {2, 7}]

which returns {True, False}, not either True or False. This means that Select[list, Divisible[#, {2, 7}] &] will always return an empty list and Count[Select[list, Divisible[#, {2, 7}] &], _Integer] will always return 0.

If I interpret the conditions for the lists correctly, you could instead use something like

Count[Select[list, Or @@ Divisible[#, Range[2, 7]] &], _Integer] <= 3

With this and Alexy's suggestion to use Sow and Reap, you could do something like

f[list_] := And[
  1 <= Count[Select[list, # <= 12 &], _Integer] <= 2, 
  Count[Select[list, # > 31 &], _Integer] >= 1, 
  Count[Select[list, Or @@ Divisible[#, Range[2, 7]] &], _Integer] <= 3]

Block[{n = 0, list},
  Reap[While[n < 5, list = Sort@RandomSample[Range[36], 7]; 
    If[f[list], n++; Sow[list]]]]][[2, 1]]

Answer 2

The function f references list as a free variable instead of as a parameter. While this is not an insurmountable obstacle, it does make it awkward to package up this functionality so that it can be used in a Table. Let's rework these definitions and apply some simplifications along the way.

First, let's tackle the test as to whether a sample is acceptable:

acceptableQ[sample_] :=
  MemberQ[sample, n_ /; n > 31] &&
  1 <= Count[sample, n_ /; n <= 12] <= 2 &&
  Count[sample, n_ /; divisible2to7[n]] <= 3

divisible2to7[n_] := MemberQ[Range[2, 7], d_ /; Divisible[n, d]]

The main simplification from the original is that the nested If statements have been flattened into an And condition. The new definition also exploits the fact that Count can test list values without having to invoke a nested Select. In addition, existence checks have been expressed using MemberQ[...]. A helper function has been introduced to perform the divisibility check in an effort to reduce the visual complexity of the main test expression. Note that the original divisibility check was incorrectly returning a list where a boolean value was expected. The _Integer head tests were removed, but if they are deemed desirable they can be re-introduced by changing each n_ to n_Integer.

Now we just need a way to generate samples in a loop until an acceptable one is found:

generateSample[] :=
  While[
    True
  , RandomSample[Range[36], 7] /.
      s_ :> If[acceptableQ[s], Return[Sort @ s]]
  ]

generateSample[] can now be used to generate a table of as many results as needed:

In[113]:= Table[generateSample[], {5}]

Out[113]= {{6, 13, 17, 19, 25, 29, 33}, {1, 11, 13, 15, 31, 35, 36},
           {1, 10, 17, 23, 25, 31, 32}, {1, 6, 17, 19, 22, 23, 33},
           {8, 17, 19, 23, 30, 31, 36}}

Generalizing the Pattern

The pattern embodied in generateSample could be parameterized to accept arbitrary generator and filter functions:

SetAttributes[generatorSelect, HoldFirst]
generatorSelect[generator_, predicate_] :=
  While[True, generator /. s_ :> If[predicate[s], Return[s]]]

The generator argument is kept in unevaluated form so that can be evaluated afresh on each pass through the loop. This new function can be used thus:

In[114]:= Table[
            generatorSelect[RandomSample[Range[36], 7], acceptableQ] // Sort
          , {5}
          ]

Out[114]= {{9, 17, 19, 23, 27, 29, 32}, {8, 13, 17, 19, 22, 23, 35},
           {4, 17, 19, 21, 23, 29, 36}, {1, 8, 15, 19, 23, 31, 33},
           {1, 10, 17, 19, 24, 29, 36}}

The advantage of the new function is that it can be used with any generator and filter functions. Here we generate tuples of three integers that sum to seven.

In[115]:= Table[
            generatorSelect[RandomInteger[7, 3], Total[#] == 7 &]
          , {5}
          ]

Out[115]= {{2, 3, 2}, {0, 5, 2}, {5, 0, 2}, {2, 4, 1}, {2, 1, 4}}

As a matter of style, some prefer to avoid defining functions with Hold attributes unless absolutely necessary. generatorSelect2 reflects that design choice:

generatorSelect2[generator_, predicate_] :=
  While[True, generator[] /. s_ :> If[predicate[s], Return[s]]]

The only difference between this and generatorSelect is that the first argument is now expected to evaluate to a function:

In[116]:= Table[
            generatorSelect2[RandomInteger[7, 3] &, Total[#] == 7 &]
          , {5}
          ]

Out[116]= {{5, 1, 1}, {3, 0, 4}, {0, 1, 6}, {3, 2, 2}, {4, 1, 2}}

Answer 3

You can use Reap and Sow for this:

n = 1; Last@Last@Reap@While[n < 4, Sow[n++]]

(*=> {1, 2, 3}*)

I recommend also to look at the NestWhileList: it may be found very appropriate for your needs.

Answer 4

This works ok. Note the use of SameQ (===) for comparing possibly mixed types, lists and booleans. E.g. {4, 7, 17, 22, 25, 27, 34} == False does not evaluate.

f := If[1 <= Count[Select[list, # <= 12 &], _Integer] <= 2, 
  If[Count[Select[list, # > 31 &], _Integer] >= 1, 
   If[Count[Select[list, Divisible[#, {2, 7}] &], _Integer] <= 3, 
    Sort[list], False], False], False]

g := (list = RandomSample[Range[36], 7];
  While[f === False, list = RandomSample[Range[36], 7];
   If[list === f, f]];
  f)

Table[g, {9}]