Merge branch 'master' of github.com:perl6/perl6-examples

best-of-rosettacode/24-game.pl

@@ -0,0 +1,74 @@
+=begin pod
+
+=head1 24 game
+
+ The 24 Game tests one's mental arithmetic.
+ Write a program that randomly chooses and displays four digits, each from one to nine, with repetitions allowed. The program should prompt for the player to enter an equation using just those, and all of those four digits. The program should check then evaluate the expression. The goal is for the player to enter an expression that evaluates to 24.
+ Only multiplication, division, addition, and subtraction operators/functions are allowed.
+ Division should use floating point or rational arithmetic, etc, to preserve remainders.
+ Brackets are allowed, if using an infix expression evaluator.
+ Forming multiple digit numbers from the supplied digits is disallowed. (So an answer of 12+12 when given 1, 2, 2, and 1 is wrong).
+ The order of the digits when given does not have to be preserved.
+ Note:
+ The type of expression evaluator used is not mandated. An RPN evaluator is equally acceptable for example.
+ The task is not for the program to generate the expression, or test whether an expression is even possible.
+
+=head1 More
+ http://rosettacode.org/wiki/24_game#Perl_6
+
+=head1 What's interesting here?
+
+=item grammar
+=item eval
+=item prompt
+=item roll
+=item casting
+
+=end pod
+
+grammar Exp24 {
+    token TOP { ^ <exp> $ }
+    token exp { <term> [ <op> <term> ]* }
+    token term { '(' <exp> ')' | \d }
+    token op { '+' | '-' | '*' | '/' }
+}
+ 
+my @digits = roll 4, 1..9;  # to a gamer, that's a "4d9" roll
+say "Here's your digits: {@digits}";
+ 
+while my $exp = prompt "\n24-Exp? " {
+    unless is-valid($exp, @digits) {
+        say "Sorry, your expression is not valid!";
+        next;
+    }
+ 
+    my $value = eval $exp;
+    say "$exp = $value";
+    if $value == 24 {
+        say "You win!";
+        last;
+    }
+    say "Sorry, your expression doesn't evaluate to 24!";
+}
+ 
+sub is-valid($exp, @digits) {
+    unless ?Exp24.parse($exp) {
+        say "Expression doesn't match rules!";
+        return False;
+    }
+ 
+    unless $exp.comb(/\d/).sort.join == @digits.sort.join {
+        say "Expression must contain digits {@digits} only!";
+        return False;
+    }
+ 
+    return True;
+}
+
+=begin pod
+
+=head1 Features used
+
+=item C<type casting> - L<http://perlcabal.org/syn/S13.html#Type_Casting>
+
+=end pod

best-of-rosettacode/TODO

@@ -1,8 +0,0 @@
-http://rosettacode.org/wiki/24_game#Perl_6 - a little grammar, casting (?), eval, prompt, roll
-*http://rosettacode.org/wiki/24_game#Perl_6 [the second one] - ZIP, -> ... {, xx, ..., 
-http://rosettacode.org/wiki/Accumulator_factory#Perl_6 - returning a sub, is copy, $^var, static vars in subs
-http://rosettacode.org/wiki/Ackermann_function#Perl_6 - easy example of multi, ?? !!
-http://rosettacode.org/wiki/Arbitrary-precision_integers_(included)#Perl_6 - metaoperator, casting, {} in string,
-http://rosettacode.org/wiki/Balanced_brackets#Perl_6 - lot of ways, idiomatic solutions, roll, given, <<, s///, xx, is copy, prompt, {} in string, grammar (quite a lot)
-
-* something else should be here....

best-of-rosettacode/accumulator-factory.pl

@@ -0,0 +1,72 @@
+use v6;
+
+=begin pod
+
+=head1 Accumulator factory
+
+A problem posed by Paul Graham is that of creating a function that takes a single (numeric) argument and which returns another function that is an accumulator. The returned accumulator function in turn also takes a single numeric argument, and returns the sum of all the numeric values passed in so far to that accumulator (including the initial value passed when the accumulator was created).
+
+The detailed rules are at L<http://paulgraham.com/accgensub.html> and are reproduced here for simplicity (with additions).
+
+
+=head1 Task
+
+Make sure the function 
+
+=item Takes a number n and returns a function (lets call it g), that takes a number i, and returns n incremented by the accumulation of i from every call of function g(i). (Although these exact function and parameter names need not be used).
+
+=item Works for any numeric type-- i.e. can take both ints and floats and returns functions that can take both ints and floats. (It is not enough simply to convert all input to floats. An accumulator that has only seen integers must return integers.) (i.e., if the language doesn't allow for numeric polymorphism, you have to use overloading or something like that)
+
+=item Generates functions that return the sum of every number ever passed to them, not just the most recent. (This requires a piece of state to hold the accumulated value, which in turn means that pure functional languages can't be used for this task.)
+
+=item Returns a real function, meaning something that you can use wherever you could use a function you had defined in the ordinary way in the text of your program. (Follow your language's conventions here.)
+
+=item Doesn't store the accumulated value or the returned functions in a way that could cause them to be inadvertently modified by other code. (No global variables or other such things.) 
+
+=head1 Example
+
+If after the example, you added the following code (in a made-up language) where the factory function is called foo:
+
+    x = foo(1); 
+    x(5); 
+    foo(3);
+    print x(2.3);
+
+It should print 8.3. (There is no need to print the form of the accumulator function returned by foo(3); it's not part of the task at all.) 
+
+=head1 Purpose
+
+The purpose of this task is to create a function that implements the described rules. It need not handle any special error cases not described above. The simplest way to implement the task as described is typically to use a closure, providing the language supports them.
+
+
+=head1 More
+
+L<http://rosettacode.org/wiki/Accumulator_factory#Perl_6>
+
+
+=head1 What's interesting here?
+
+=item returning a sub
+=item is copy
+=item $^var
+=item static vars in subs
+
+=end pod
+
+
+sub accum ($n is copy) { sub { $n += $^x } }
+
+my $a = accum 5;
+$a(4.5);
+say $a(.5);   # Prints "10".
+
+
+=begin pod
+
+=head1 Features used
+
+=item C<> - L<http://perlcabal.org/syn/>
+
+=end pod
+
+# vim: expandtab shiftwidth=2 ft=perl6:

best-of-rosettacode/ackermann-function.pl

@@ -0,0 +1,34 @@
+=begin pod
+
+=head1 Ackermann function
+
+ The Ackermann function is a classic recursive example in computer science.
+
+=head1 More
+
+L<http://rosettacode.org/wiki/Ackermann_function#Perl_6>
+
+=head1 What's interesting here?
+
+=item ternary chaining
+=item recursive funtion
+
+=end pod
+
+sub A(Int $m, Int $n) {
+ 
+    $m == 0  ??    $n + 1                   !! 
+    $n == 0  ??  A($m - 1, 1            )   !!
+                 A($m - 1, A($m, $n - 1));
+ 
+}
+A(1, 2).say;
+
+=begin pod
+
+=head1 Features used
+
+=item C<ternary operator> - L<http://perlcabal.org/syn/S03.html#Conditional_operator_precedence>
+=item C<multi subs> - L<http://perlcabal.org/syn/S12.html#Multisubs_and_Multimethods>
+
+=end pod

best-of-rosettacode/arbitrary-precision-integers.pl

@@ -0,0 +1,40 @@
+use v6;
+
+=begin pod
+
+=head1 Arbitrary-precision integers (included)
+
+Using the in-built capabilities of your language, calculate the integer value of:
+
+        5^{4^{3^2}} 
+
+Confirm that the first and last twenty digits of the answer are: 62060698786608744707...92256259918212890625
+Find and show the number of decimal digits in the answer. 
+
+=head1 More
+
+L<http://rosettacode.org/wiki/Arbitrary-precision_integers_(included)#Perl_6>
+
+
+=head1 What's interesting here?
+
+=item metaoperator
+=item casting
+=item {} in string
+
+=end pod
+
+
+my $x = ~[**] 5, 4, 3, 2;
+say "5**4**3**2 = {substr($x,0,20)}...{substr($x,$x.chars-20)} and has {$x.chars} digits";
+
+
+=begin pod
+
+=head1 Features used
+
+=item C<> - L<http://perlcabal.org/syn/>
+
+=end pod
+
+# vim: expandtab shiftwidth=2 ft=perl6:

best-of-rosettacode/balanced-brackets.pl

@@ -1,6 +1,8 @@
+use v6;
+
 =begin pod
 
-=head1 Problem
+=head1 Balanced brackets
 
 Generate a string with N opening brackets (“[”) and N closing brackets (“]”), in some arbitrary order.
 Determine whether the generated string is balanced; that is, whether it consists entirely of pairs of opening/closing brackets (in that order), none of which mis-nest.
@@ -10,17 +12,19 @@ =head1 More
 L<http://rosettacode.org/wiki/Balanced_brackets#Perl_6>
 
 =head1 What's interesting here?
-* idiomatic solutions
-* hyper operators
-* switch statement
-* roll
-* grammar
+
+=item idiomatic solutions
+=item hyper operators
+=item switch statement
+=item roll
+=item grammar
 
 =head2 Depth counter
 
 =end pod
 
-sub balanced($s) {
+{
+  sub balanced($s) {
     my $l = 0;
     for $s.comb {
         when "]" {
@@ -32,65 +36,74 @@ ($s)
         }
     }
     return $l == 0;
-}
+  }
 
-my $n = prompt "Number of brackets";
-my $s = (<[ ]> xx $n).pick(*).join;
-say "$s {balanced($s) ?? "is" !! "is not"} well-balanced"
+  my $n = prompt "Number of brackets >";
+  my $s = (<[ ]> xx $n).pick(*).join;
+  say "$s {balanced($s) ?? "is" !! "is not"} well-balanced";
+}
 
 =begin pod
 
 =head2 FP oriented
 
 =end pod
 
-sub balanced($s) {
+{
+  sub balanced($s) {
     .none < 0 and .[*-1] == 0
-        given [\+] '\\' «leg« $s.comb;
-}
+      given [\+] '\\' «leg« $s.comb;
+  }
 
-my $n = prompt "Number of bracket pairs: ";
-my $s = <[ ]>.roll($n*2).join;
-say "$s { balanced($s) ?? "is" !! "is not" } well-balanced"
+  my $n = prompt "Number of bracket pairs: ";
+  my $s = <[ ]>.roll($n*2).join;
+  say "$s { balanced($s) ?? "is" !! "is not" } well-balanced";
+}
 
 =begin pod
 
 =head2 String munging
 
 =end pod
 
-sub balanced($_ is copy) {
-    () while s:g/'[]'//;
+{
+  sub balanced($_ is copy) {
+    s:g/'[]'// while m/'[]'/;
     $_ eq '';
-}
+  }
 
-my $n = prompt "Number of bracket pairs: ";
-my $s = <[ ]>.roll($n*2).join;
-say "$s is", ' not' xx not balanced($s)), " well-balanced";
+  my $n = prompt "Number of bracket pairs: ";
+  my $s = <[ ]>.roll($n*2).join;
+  say "$s is", ' not' xx not balanced($s), " well-balanced";
+}
 
 =begin pod
 
 =head2 Prasing with a grammar
 
 =end pod
 
-grammar BalBrack {
+{
+
+  grammar BalBrack {
     token TOP { ^ <balanced>* $ };
     token balanced { '[]' | '[' ~ ']' <balanced> }
+  }
+
+  my $n = prompt "Number of bracket pairs: ";
+  my $s = <[ ]>.roll($n*2).join;
+  say "$s { BalBrack.parse($s) ?? "is" !! "is not" } well-balanced";
+
 }
-
-my $n = prompt "Number of bracket pairs: ";
-my $s = <[ ]>.roll($n*2).join;
-say "$s { BalBrack.parse($s) ?? "is" !! "is not" } well-balanced";
 
 =begin pod
 
 =head1 Features used
 
-C<roll> - L<http://perlcabal.org/syn/S32/Containers.html#roll>
-C<given> - L<http://perlcabal.org/syn/S04.html#Switch_statements>
-C<prompt> - L<http://perlcabal.org/syn/S32/IO.html#prompt>
-C<grammar> - L<http://perlcabal.org/syn/S05.html#Grammars>
+=item C<roll> - L<http://perlcabal.org/syn/S32/Containers.html#roll>
+=item C<given> - L<http://perlcabal.org/syn/S04.html#Switch_statements>
+=item C<prompt> - L<http://perlcabal.org/syn/S32/IO.html#prompt>
+=item C<grammar> - L<http://perlcabal.org/syn/S05.html#Grammars>
 
 =end pod