Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Streamline Bag.pick/roll/grab/pickpairs/grabpairs 
Using MMD: should be significantly faster on no param calls, and on Whatever/Inf
calls.  Also fix #120407
  • Loading branch information
@lizmat
lizmat committed Oct 20, 2014
1 parent dcd32e5 commit 7ff58f0
Show file tree
Hide file tree
Showing 4 changed files with 104 additions and 27 deletions.
6 changes: 3 additions & 3 deletions src/core/Bag.pm
View file
Expand Up @@ -22,13 +22,13 @@ my class Bag does Baggy {
@!pairs ||= %!elems.values.map: { Enum.new(:key(.key),:value(.value)) };
}

method delete_key($a --> Int) is hidden_from_backtrace {
method delete_key($a) is hidden_from_backtrace {
X::Immutable.new( method => 'delete_key', typename => self.^name ).throw;
}
method grab($count? --> Int) is hidden_from_backtrace {
multi method grab(Bag:D: $count?) is hidden_from_backtrace {
X::Immutable.new( method => 'grab', typename => self.^name ).throw;
}
method grabpairs($count? --> Int) is hidden_from_backtrace {
multi method grabpairs(Bag:D: $count?) is hidden_from_backtrace {
X::Immutable.new( method => 'grabpairs', typename => self.^name ).throw;
}

Expand Down
115 changes: 96 additions & 19 deletions src/core/Baggy.pm
View file
Expand Up @@ -72,37 +72,96 @@ my role Baggy does QuantHash {
method list() { self.pairs }
method pairs() { %!elems.values.map: { (.key => .value) } }

method grab ($count = 1) {
my @grab = ROLLPICKGRAB(self, $count, %!elems.values);
%!elems{ @grab.map({.WHICH}).grep: { %!elems{$_} && %!elems{$_}.value == 0 } }:delete;
@grab;
proto method grabpairs (|) { * }
multi method grabpairs(Baggy:D:) {
%!elems.delete_key(%!elems.keys.pick);
}
method grabpairs($count = 1) {
(%!elems{ %!elems.keys.pick($count) }:delete).list;
multi method grabpairs(Baggy:D: $count) {
if $count ~~ Whatever || $count == Inf {
my @grabbed = %!elems{%!elems.keys.pick(%!elems.elems)};
%!elems = ();
@grabbed;
}
else {
%!elems{ %!elems.keys.pick($count) }:delete;
}
}

proto method pickpairs(|) { * }
multi method pickpairs(Baggy:D:) {
%!elems.at_key(%!elems.keys.pick);
}
method pick ($count = 1) {
ROLLPICKGRAB(self, $count, %!elems.values.map: { (.key => .value) });
multi method pickpairs(Baggy:D: $count) {
%!elems{ %!elems.keys.pick(
$count ~~ Whatever || $count == Inf ?? %!elems.elems !! $count
) };
}

proto method grab(|) { * }
multi method grab(Baggy:D:) {
my \grabbed := ROLLPICKGRAB1(self,%!elems.values);
%!elems.delete_key(grabbed.WHICH)
if %!elems.at_key(grabbed.WHICH).value-- == 1;
grabbed;
}
multi method grab(Baggy:D: $count) {
if $count ~~ Whatever || $count == Inf {
my @grabbed = ROLLPICKGRABN(self,self.total,%!elems.values);
%!elems = ();
@grabbed;
}
else {
my @grabbed = ROLLPICKGRABN(self,$count,%!elems.values);
for @grabbed {
if %!elems.at_key(.WHICH) -> $pair {
%!elems.delete_key(.WHICH) unless $pair.value;
}
}
@grabbed;
}
}
method pickpairs ($count = 1) {
(%!elems{ %!elems.keys.pick($count) }).list;

proto method pick(|) { * }
multi method pick(Baggy:D:) {
ROLLPICKGRAB1(self,%!elems.values);
}
method roll ($count = 1) {
ROLLPICKGRAB(self, $count, %!elems.values, :keep);
multi method pick(Baggy:D: $count) {
ROLLPICKGRABN(self,
$count ~~ Whatever || $count == Inf ?? self.total !! $count,
%!elems.values.map: { (.key => .value) }
);
}

sub ROLLPICKGRAB ($self, $count, @pairs is rw, :$keep) is hidden_from_backtrace {
my int $total = $self.total;
my int $todo = $count ~~ Num
?? $total min $count
!! ($count ~~ Whatever ?? ( $keep ?? 0x7ffffff !! $total ) !! $count);
$todo = $todo + 1;
proto method roll(|) { * }
multi method roll(Baggy:D:) {
ROLLPICKGRAB1(self,%!elems.values);
}
multi method roll(Baggy:D: $count) {
$count ~~ Whatever || $count == Inf
?? ROLLPICKGRABW(self,%!elems.values)
!! ROLLPICKGRABN(self,$count, %!elems.values, :keep);
}

sub ROLLPICKGRAB1($self,@pairs) is hidden_from_backtrace { # one time
my Int $rand = $self.total.rand.Int;
my Int $seen = 0;
for @pairs -> $pair {
return $pair.key if ( $seen += $pair.value ) > $rand;
}
Nil;
}

sub ROLLPICKGRABN( # N times
$self, $count, @pairs is rw, :$keep
) is hidden_from_backtrace {
my Int $total = $self.total;
my Int $rand;
my Int $seen;
my int $todo = ($keep ?? $count !! ($total min $count)) + 1;

gather {
while $todo = $todo - 1 {
$rand = nqp::rand_I($total,Int);
$rand = $total.rand.Int;
$seen = 0;
for @pairs -> $pair {
next if ( $seen += $pair.value ) <= $rand;
Expand All @@ -118,6 +177,24 @@ my role Baggy does QuantHash {
}
}

sub ROLLPICKGRABW($self,@pairs) is hidden_from_backtrace { # keep going
my Int $total = $self.total;
my Int $rand;
my Int $seen;

gather {
loop {
$rand = $total.rand.Int;
$seen = 0;
for @pairs -> $pair {
next if ( $seen += $pair.value ) <= $rand;
take $pair.key;
last;
}
}
}
}

proto method classify-list(|) { * }
multi method classify-list( &test, *@list ) {
fail 'Cannot .classify an infinite list' if @list.infinite;
Expand Down
4 changes: 2 additions & 2 deletions src/core/Mix.pm
View file
Expand Up @@ -23,10 +23,10 @@ my class Mix does Mixy {
method delete_key($a --> Real) is hidden_from_backtrace {
X::Immutable.new( method => 'delete_key', typename => self.^name ).throw;
}
method grab($count? --> Real) is hidden_from_backtrace {
multi method grab($count? --> Real) is hidden_from_backtrace {
X::Immutable.new( method => 'grab', typename => self.^name ).throw;
}
method grabpairs($count? --> Real) is hidden_from_backtrace {
multi method grabpairs($count? --> Real) is hidden_from_backtrace {
X::Immutable.new( method => 'grabpairs', typename => self.^name ).throw;
}

Expand Down
6 changes: 3 additions & 3 deletions src/core/Mixy.pm
View file
Expand Up @@ -29,15 +29,15 @@ my role Mixy does Baggy {
~ ')';
}

method grab ($count?) {
multi method grab(Mixy:D: $count?) {
fail ".grab is not supported on a {self.^name}";
}

method pick ($count?) {
multi method pick(Mixy:D: $count?) {
fail ".pick is not supported on a {self.^name}";
}

method roll ($count = 1) {
multi method roll($count = 1) {
my $total = [+] self.values.grep: * > 0;
my $rolls = $count ~~ Num
?? $total min $count !! $count ~~ Whatever ?? Inf !! $count;
Expand Down

0 comments on commit 7ff58f0

Please sign in to comment.