Skip to content
Browse files

Lots of changes, including four next scripts!

  • Loading branch information...
1 parent 63e0ebb commit 3e3fe6202979d1fdf0add5c857f7a6c0c61c5906 @colomon committed Dec 20, 2012
Showing with 102 additions and 22 deletions.
  1. +12 −0 bin/collatz-recursive2.pl
  2. +29 −0 bin/collatz-recursive3.pl
  3. +26 −0 bin/collatz-recursive4.pl
  4. +11 −0 bin/collatz-sequence2.pl
  5. +12 −11 bin/testing-harness.pl
  6. +12 −11 bin/timing-harness.pl
View
12 bin/collatz-recursive2.pl
@@ -0,0 +1,12 @@
+sub collatz-length(Int $n) {
+ return 1 if $n eq 1;
+ 1 + ($n %% 2 ?? collatz-length($_ div 2) !! collatz-length(3 * $_ + 1));
+}
+
+sub MAIN(*@numbers) {
+ for @numbers -> $n {
+ say "$n: " ~ collatz-length($n.Int);
+ }
+}
+
+
View
29 bin/collatz-recursive3.pl
@@ -0,0 +1,29 @@
+multi sub trait_mod:<is>(Routine $r, :$cached!) {
+ my %cache;
+ #wrap the routine in a block that..
+ $r.wrap(-> $arg {
+ # looks up the argument in the cache
+ %cache.exists($arg)
+ ?? %cache{$arg}
+ # ... and calls the original, if it
+ # is not found in the cache
+ !! (%cache{$arg} = callwith($arg))
+ }
+ );
+}
+
+sub collatz-length(Int $n) is cached {
+ given $n {
+ when 1 { 1 }
+ when * %% 2 { 1 + collatz-length($_ div 2) }
+ default { 1 + collatz-length(3 * $_ + 1) }
+ }
+}
+
+sub MAIN(*@numbers) {
+ for @numbers -> $n {
+ say "$n: " ~ collatz-length($n.Int);
+ }
+}
+
+
View
26 bin/collatz-recursive4.pl
@@ -0,0 +1,26 @@
+multi sub trait_mod:<is>(Routine $r, :$cached!) {
+ my %cache;
+ #wrap the routine in a block that..
+ $r.wrap(-> $arg {
+ # looks up the argument in the cache
+ %cache.exists($arg)
+ ?? %cache{$arg}
+ # ... and calls the original, if it
+ # is not found in the cache
+ !! (%cache{$arg} = callwith($arg))
+ }
+ );
+}
+
+sub collatz-length(Int $n) is cached {
+ return 1 if $n eq 1;
+ 1 + ($n %% 2 ?? collatz-length($_ div 2) !! collatz-length(3 * $_ + 1));
+}
+
+sub MAIN(*@numbers) {
+ for @numbers -> $n {
+ say "$n: " ~ collatz-length($n.Int);
+ }
+}
+
+
View
11 bin/collatz-sequence2.pl
@@ -0,0 +1,11 @@
+sub collatz-length(Int $start) {
+ +($start, { when * %% 2 { $_ div 2 }; when * !%% 2 { 3 * $_ + 1 }; } ... 1);
+}
+
+sub MAIN(*@numbers) {
+ for @numbers -> $n {
+ say "$n: " ~ collatz-length($n.Int);
+ }
+}
+
+
View
23 bin/testing-harness.pl
@@ -1,4 +1,3 @@
-my $perl6 = @*ARGS.shift;
my @numbers = 1..100, 10000..10100;
sub collatz-length(Int $n) {
@@ -9,16 +8,18 @@
}
}
-for @*ARGS -> $script {
- my $results = qqx/$perl6 $script { @numbers }/;
- my @mistakes;
- for $results.lines.map({ $_.comb(/\d+/) }) -> $n, $length {
- push @mistakes, $n if collatz-length($n.Int) != $length;
- }
- if @mistakes {
- say "Mistakes in $script: { @mistakes }";
- } else {
- say "$script correct";
+sub MAIN(Str $perl6, *@scripts) {
+ for @scripts -> $script {
+ my $results = qqx/$perl6 $script { @numbers }/;
+ my @mistakes;
+ for $results.lines.map({ $_.comb(/\d+/) }) -> $n, $length {
+ push @mistakes, $n if collatz-length($n.Int) != $length;
+ }
+ if @mistakes {
+ say "Mistakes in $script: { @mistakes }";
+ } else {
+ say "$script correct";
+ }
}
}
View
23 bin/timing-harness.pl
@@ -1,15 +1,16 @@
-my $perl6 = @*ARGS.shift;
-my @numbers = 1..100, 10000..10100;
+my @numbers = 1..200, 10000..10200;
-my %results;
-for @*ARGS -> $script {
- my $start = now;
- qqx/$perl6 $script { @numbers }/;
- my $end = now;
+sub MAIN(Str $perl6, *@scripts) {
+ my %results;
+ for @scripts -> $script {
+ my $start = now;
+ qqx/$perl6 $script { @numbers }/;
+ my $end = now;
- %results{$script} = $end - $start;
-}
+ %results{$script} = $end - $start;
+ }
-for %results.pairs.sort(*.value) -> (:key($script), :value($time)) {
- say "$script: $time seconds";
+ for %results.pairs.sort(*.value) -> (:key($script), :value($time)) {
+ say "$script: $time seconds";
+ }
}

0 comments on commit 3e3fe62

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