6
$\begingroup$

I am working through the course Programming Paradigms via Mathematica. One of the exercises asks that you construct a function that mimics Select,even with three arguments. It also includes the following direction:

Do not use the Select[] function in your definition.

Here is an example of how Select works:

Select[{1, 2, 3, 4, 6, 8, 10}, EvenQ, 4]
(* {2, 4, 6, 8} *)

First I tested the following code and got the same result as Select:

l1 = {1, 2, 3, 4, 6, 8, 10};
l2 = {};
crit = EvenQ;
n = 4;
While[Length[l1] > 0 && Length[l2] < n,
 If[crit[First[l1]], l2 = Append[l2, First[l1]]];
    l1 = Rest[l1];
 ]
l2

(* {2, 4, 6, 8} *)

I then tried to write a function that would do the same thing (caution causes infinite loop):

Clear[whileSelect]
whileSelect[l1_List, crit_, n_] := Module[{l2},
  While[Length[l1] > 0 && Length[l2] < n,
    If[crit[First[l1]], l2 = Append[l2, First[l1]]];
        l1 = Rest[l1];
    ]
   l2
  ]

However I got a series of Set::shape: Lists {1,2,3,4,6,8,10} and {2,3,4,6,8,10} are not the same shape. >> error messages and the code put the computer into an infinite loop. I have looked at documentation on Module,Rest,Set and If but have not been able to figure out what I am doing wrong. I would greatly appreciate a point in the right direction.

$\endgroup$
8
  • 1
    $\begingroup$ You're supposed to store l1 in a temporary variable. Try whileSelect[l1_List, crit_, n_] := Module[{l1temp = l1, l2}, (* stuff *)]. l1 = Rest[l1] will not work because if, say, you executed whileSelect[{1, 2, 3, 4, 6, 8, 10}, EvenQ, 3], you then encounter absurdities like {1, 2, 3, 4, 6, 8, 10} = Rest[{1, 2, 3, 4, 6, 8, 10}] due to replacement. But I'll let someone else flesh out the details... $\endgroup$ Jun 21, 2013 at 14:01
  • 1
    $\begingroup$ Consider whileSelect[l1_List, crit_, n_Integer] := Module[{l1temp = l1, l2 = {}, temp}, While[Length[l1temp] > 0 && Length[l2] < n, temp = First[l1temp]; If[crit[temp], AppendTo[l2, temp]]; l1temp = Rest[l1temp]]; l2], and note well what I did differently. $\endgroup$ Jun 21, 2013 at 14:35
  • 1
    $\begingroup$ Closed as already answered, as I specifically addressed this issue here. $\endgroup$
    – Mr.Wizard
    Jun 21, 2013 at 22:44
  • 1
    $\begingroup$ outline of a "mathematica-idiomatic" way: Take[Pick[list, fQ /@ list, True], max] $\endgroup$
    – amr
    Jun 21, 2013 at 23:29
  • 1
    $\begingroup$ @amr A problem with that construct is that the test (fQ) is applied to every list element; a second problem occurs if max exceeds the number of matches. Also, there is no need for True in Pick as that is the default. If one chooses not to use built-in functions with a length parameter (e.g. Cases) I would use something like: select[lst_List, crit_, n_: Infinity] := Module[{f, r = 0}, f = If[r < n, If[crit@#, r++; Sow @ #], Return[]] &; Reap[f ~Scan~ lst][[2, 1]] ] with a block-based optimization if appropriate. $\endgroup$
    – Mr.Wizard
    Jun 22, 2013 at 20:42

5 Answers 5

1
$\begingroup$

The following code does what you want to do.

Clear[whileSelect]
whileSelect[l1_List, crit_, n_] := Module[{l1temp = l1, l2 = {}},
  While[Length[l1temp] > 0 && Length[l2] < n, 
   If[crit[First[l1temp]], l2 = Append[l2, First[l1temp]]];
   l1temp = Rest[l1temp];
   ];
   Return[l2];
  ]

The important lesson for you is, that you have to declare a local variable for l1 because an argument is not considered a variable by mathematica. So when you wrote l1 = Rest[l1], mathematica tried to assign a list to a list, not change any variables.

BTW: The code still contains some flaws, but it shows the essential changes. I also recommend using Return, though just writing l2 without semicolon would suffice, too.

$\endgroup$
2
  • $\begingroup$ thank you, declaring a local variable is a good point. I'll try to keep that in mind in the future. $\endgroup$
    – Clif
    Jun 21, 2013 at 15:09
  • $\begingroup$ While this answer did not address the default value of n case, it did clearly state where I had made a mistake ,local value as opposed to argument. $\endgroup$
    – Clif
    Jun 22, 2013 at 12:04
3
$\begingroup$

My answer is along the same lines as Wizard's, but I don't think Return is necessary or desirable. Also, to mimic Select better, the 3rd argument needs have the default value ∞.

whileSelect[l1_List, crit_, n : (_Integer | ∞) : ∞] /; n > 0 :=
  Module[{t = l1, l2 = {}},
    While[Length[t] > 0 && Length[l2] < n, 
      If[crit[First[t]], l2 = Append[l2, First[t]]];
      t = Rest[t]];
  l2]

Then you have

whileSelect[Range@10, EvenQ, 3]

{2, 4, 6}

But, if you omit the 3rd argument, you get

whileSelect[Range@10, EvenQ]

{2, 4, 6, 8, 10}

and the following doesn't evaluate

whileSelect[Range@10, EvenQ, -2]

whileSelect[{1, 2, 3, 4, 5, 6, 7, 8, 9, 10}, EvenQ, -2]

Note; Select prints an error message in this last case. I leave implementing that behavior as a exercise :-)

Edit

Here is a more functional-style implementation:

altSelect[l1_List, crit_, n : (_Integer?Positive | ∞)] :=
  Module[{u},
    Take[u = altSelect[l1, crit], Min[Length@u, n]]]
altSelect[l1_List, crit_] :=
  (crit@# && #) & /@ l1 /. False :> Sequence[]
$\endgroup$
3
  • 1
    $\begingroup$ ...or, one could have done n : (_Integer?Positive | Infinity) : Infinity. $\endgroup$ Jun 21, 2013 at 15:34
  • $\begingroup$ @0x4A4D. Yes, that's better. $\endgroup$
    – m_goldberg
    Jun 21, 2013 at 15:38
  • $\begingroup$ Thank You and yes, setting the default value for n was next on the todo list, and I can't say that I had a good idea. I will work on error message generation for the case of -n. I also appreciate the functional-style, I guess I would call it recursive, code. I can't say that I understand it, but I will look forward to studying it. $\endgroup$
    – Clif
    Jun 21, 2013 at 18:41
3
$\begingroup$

I suppose it's time to put in my take:

mySelect[list_List, crit_, n : (_Integer?Positive | ∞) : ∞] := Block[{k = 0}, 
         Reap[Scan[If[crit @ # && (++k) <= n, Sow[#]] &, list]][[-1, 1]]]

where I use Scan[] to loop though the input list and Sow[]/Reap[] to accumulate the elements selected according to the set criterion.

$\endgroup$
1
  • $\begingroup$ Thanks again for the help, I went back and changed the original code again replacing l1 with l1temp as you had suggested in the first comment and it worked, I must have made a mistake earlier. $\endgroup$
    – Clif
    Jun 22, 2013 at 12:00
2
$\begingroup$

Here's a one-line function that doesn't use If or While, but instead vectorizes the list into True/False, then uses these to index into the list.

sel[list_, crit_, maxLen_] := 
  Take[out = Rest@list[[Union[Range[Length[list]]  Boole[crit /@ list]]]], 
       Min[maxLen, Length[out]]]

For example:

sel[Range[10], OddQ, 4]

{1, 3, 5, 7}
$\endgroup$
2
  • $\begingroup$ Thank you for working on this. I am going to study the Take[out=... some more so that I'll understand what it is doing. $\endgroup$
    – Clif
    Jun 21, 2013 at 18:45
  • $\begingroup$ @Clif -- It is simpler than it might appear: it assigns the variable out to the right hand side of the equals sign. You are used to seeing this in a separate line of code; here it is used inside a function (in this case, Take) to do the definition. The Take command removes all but the first several entries, either maxLen or Length[out], whichever is smaller. $\endgroup$
    – bill s
    Jun 22, 2013 at 1:07
2
$\begingroup$

Here's the easiest, probably:

sel[list_, crit_, n_: Infinity] := Cases[list, _?crit, 1, n]

Almost seems like cheating. This one is similar.

sel[list_, crit_, n_: Infinity] := Extract[list, Position[list, _?crit, 1, n]]

The problem is that there are so many ways to do the same thing. I can't tell from the statement of the question whether a program from "scratch" was desired, or to search out more-or-less ready-made substitutes. (I'm not familiar with the book.)

$\endgroup$
1
  • $\begingroup$ Thanks for helping, I am looking over the documentation on Cases and Extract. $\endgroup$
    – Clif
    Jun 22, 2013 at 11:57

Not the answer you're looking for? Browse other questions tagged or ask your own question.