From chris@tinfoilhats.org

I've put together a patch to add a 'pick' method to the perl6
compiler's List class. This is mainly cargo-culted from the Junction
pick method, with a few changes to bring it inline with the pugs pick
method.

I'm new to this PIR thing, so please bear with me. Critiques
welcome. It's likely that I've not done this in the best way, as
well, I'm not sure what tradeoffs there are between using register
variables or named variables.

Now that that's out of the way, I've implemented two private methods
-- pick_no_replacement and pick_replacement -- as well as pick
itself, which decides which to call based on the :repl flag.

It seems that it's not able to parse the :repl flag right now, so
that one isn't really tested -- however, it's the code that I wrote
first and it behaved as it should.

The algorithm for making the picks without replacement is based on
storing the indexes in the array where a particular element was
chosen -- if this isn't the best way to do it, please let me know --
it may be just the first naive one I thought of, and, well, the pugs
one is rather beyond my ability to read haskell.

pick.t is a test file from pugs with a few extra tests thrown in.
I've endeavored to keep the same behavior as the pugs pick method.

Once again, criticism is more than welcome -- this is the first thing
bigger than hello world that I've done in PIR.

Thanks for your consideration,

Chris Pruden

From chris@tinfoilhats.org

Index: languages/perl6/src/classes/List.pir
===================================================================
--- languages/perl6/src/classes/List.pir	(revision 24193)
+++ languages/perl6/src/classes/List.pir	(working copy)
@@ -55,6 +55,100 @@
     .return (x)
 .end
 
+.sub 'pick' :method
+    .param int count        :optional
+    .param int has_count    :opt_flag
+    .param int repl         :named('repl') :optional
+    .param int has_repl     :opt_flag
+    
+    .local pmc list    
+    
+    if has_count goto choose
+    count = 1
+    
+  choose:
+    unless has_repl goto no_repl
+    list = self.'!pick_replacement'(count)
+    goto ret
+  no_repl:
+    list = self.'!pick_no_replacement'(count)
+  ret:
+    .return(list)
+    
+.end
+    
+
+.sub '!pick_replacement' :method
+    .param int count        :optional
+    .param int has_count    :opt_flag
+    .local pmc values
+    .local int elems, idx
+
+    values = self               # list itself
+    elems  = elements values    # how many in the list
+    
+    .local pmc picks            # list to return
+    .local pmc item
+    $P0 = new 'ResizablePMCArray'
+
+    unless has_count goto list_pick
+    if count == 0 goto end_empty
+
+  list_pick:
+    idx = 'prefix:rand'(elems)
+    $P1 = values[idx]
+    push $P0, $P1
+
+    dec count 
+    if count > 0 goto list_pick
+
+  end_empty:
+    .return 'list'($P0)  
+.end
+
+.sub '!pick_no_replacement' :method    
+    .param int count        :optional    
+    .param int has_count    :opt_flag    
+    .local pmc values    
+    .local int elems, idx
+
+    values = self               # list itself    
+    elems  = elements values    # how many in the list
+
+    .local pmc picks            # list to return    
+    .local pmc item    
+
+    $P0 = new 'ResizablePMCArray'    
+    $P2 = new 'ResizablePMCArray' # already picked indexes - only needed if :repl is off
+  
+    unless count < elems goto too_many
+    unless has_count goto list_pick # if count is not passed, they mean it to be 1
+    if count == 0 goto end_empty
+  
+    goto list_pick
+
+  too_many:
+    count = elems
+  
+  list_pick:
+    idx = 'prefix:rand'(elems)
+    $P1 = values[idx]
+
+    # if $P1 already exists in $P2 and :repl isn't set, goto list_pick
+    $I3 = exists $P2[idx]
+    if $I3 goto list_pick
+
+    push $P0, $P1
+    set $P2[idx], 1
+
+    dec count
+    if count > 0 goto list_pick
+
+  end_empty:
+    .return 'list'($P0)
+
+.end
+
 =back
 
 =cut

From chris@tinfoilhats.org

use v6-alpha;
use Test;
plan 5;

my @​arr = <z z z>;

is @​arr.pick(), <z>, 'method pick with no arg';
is @​arr.pick(0), <>, 'method pick with $num = 0';
is @​arr.pick(2), <z z>, 'method pick with $num < +@​values';
is @​arr.pick(3), <z z z>, 'method pick with $num == +@​values';
is @​arr.pick(4), <z z z>, 'method pick with $num > +@​values';

#is @​arr.pick(4, :repl), <z z z z>, 'method pick(​:repl) with $num > +@​values';

From @pmichaud

On Mon, Dec 24, 2007 at 05​:12​:24PM -0800, Christopher Pruden wrote​:

# New Ticket Created by Christopher Pruden
# Please include the string​: [perl #​49085]
# in the subject line of all future correspondence about this issue.
# <URL​: http://rt.perl.org/rt3/Ticket/Display.html?id=49085 >

I've put together a patch to add a 'pick' method to the perl6
compiler's List class. This is mainly cargo-culted from the Junction
pick method, with a few changes to bring it inline with the pugs pick
method.

Excellent, thank you for the patch!

Before I apply it, though, how hard would it be to submit the
same functionality as a sub (or subs) written in Perl 6? I can
certainly accept the function as a PIR sub, but I'm also looking
to get as much of the libraries and compiler code written in Perl 6
as we can, and this looks like a really good candidate. What
support would be needed from the perl6 compiler to do that?

Once again, criticism is more than welcome -- this is the first thing
bigger than hello world that I've done in PIR.

No immediate criticism on my part as far as the PIR goes (I haven't
reviewed it extensively) -- I'm just thinking this is a good point to
figure out how we can get library functions to be written in Perl 6
instead of PIR. (See also RT#​49173 for more details about this.)

Thanks again!

Pm

The RT System itself - Status changed from 'new' to 'open'

From @pmichaud

The .pick method is now added as of r28703 (although changes in the spec
mean it's substantially different from the submitted patch).

Thanks!

Pm

@pmichaud - Status changed from 'open' to 'resolved'