Skip to content
Browse files

Add permute and take-while with test files. Only very very lightly te…

…sted at this point!
  • Loading branch information...
1 parent 334b2e6 commit 33a4dc448bdc0a6e9f45844e908c217fc1ebc2c6 @colomon committed Sep 3, 2010
Showing with 58 additions and 0 deletions.
  1. +37 −0 lib/List/Utils.pm
  2. +12 −0 t/02-permute.t
  3. +9 −0 t/03-take-while.t
View
37 lib/List/Utils.pm
@@ -13,3 +13,40 @@ sub sliding-window(@a, $n) is export(:DEFAULT) {
}
}
}
+
+sub permute(@items) is export(:DEFAULT) {
+ sub pattern_to_permutation(@pattern, @items1) {
+ my @items = @items1;
+ my @r;
+ for @pattern {
+ push @r, @items.splice($_, 1);
+ }
+ @r;
+ }
+
+ sub n_to_pat($n is copy, $length) {
+ my @odometer;
+ for 1 .. $length -> $i {
+ unshift @odometer, $n % $i;
+ $n div= $i;
+ }
+ return $n ?? () !! @odometer;
+ }
+
+ my $n = 0;
+ gather loop {
+ my @pattern = n_to_pat($n++, +@items);
+ last unless ?@pattern;
+ take pattern_to_permutation(@pattern, @items).item;
+ }
+}
+
+sub take-while(@a, Mu $test) is export(:DEFAULT) {
+ gather {
+ for @a.list {
+ when $test { take $_ }
+ last;
+ }
+ }
+}
+
View
12 t/02-permute.t
@@ -0,0 +1,12 @@
+use Test;
+use List::Utils;
+
+plan *;
+
+{
+ my @a = permute((1, 2, 3));
+ say :@a.perl;
+ is @a.elems, 6, "(1, 2, 3) has 6 permutations";
+}
+
+done_testing;
View
9 t/03-take-while.t
@@ -0,0 +1,9 @@
+use Test;
+use List::Utils;
+
+plan *;
+
+is take-while((1...*), * <= 10), ~(1...10), "take-while works on a basic infinite loop";
+is take-while((1...*), * <= -1), "", "take-while works if condition is initially false";
+
+done_testing;

0 comments on commit 33a4dc4

Please sign in to comment.
Something went wrong with that request. Please try again.