Skip to content

Commit 86ca520

Browse files
janijani
committed
Merge branch 'master' of github.com:perl6/perl6-examples
2 parents c7658f1 + f8abe2c commit 86ca520

10 files changed

+304
-92
lines changed

‎best-of-rosettacode/100-doors.pl

Lines changed: 31 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -1,17 +1,37 @@
1-
# http://rosettacode.org/wiki/100_doors#Perl_6
1+
use v6;
22

3-
# Problem: You have 100 doors in a row that are all initially closed. You make
4-
# 100 passes by the doors. The first time through, you visit every door and
5-
# toggle the door (if the door is closed, you open it; if it is open, you close
6-
# it). The second time you only visit every 2nd door (door #2, #4, #6, ...).
7-
# The third time, every 3rd door (door #3, #6, #9, ...), etc, until you only
8-
# visit the 100th door.
3+
=begin pod
4+
5+
=head1 100 Doors
6+
7+
You have 100 doors in a row that are all initially closed. You make 100 passes
8+
by the doors. The first time through, you visit every door and toggle the door
9+
(if the door is closed, you open it; if it is open, you close it). The second
10+
time you only visit every 2nd door (door #2, #4, #6, ...). The third time,
11+
every 3rd door (door #3, #6, #9, ...), etc, until you only visit the 100th
12+
door.
13+
14+
=head1 Task
15+
16+
What state are the doors in after the last pass? Which are open,
17+
which are closed?
18+
19+
=head1 More
20+
21+
L<http://rosettacode.org/wiki/100_doors#Perl_6>
22+
23+
=end pod
924

10-
# Question: What state are the doors in after the last pass? Which are open,
11-
# which are closed?
1225

1326
say "Door $_ is open" for 1..10 X** 2;
1427

15-
# More about X** - http://perlcabal.org/syn/S03.html#Cross_operators
1628

17-
# vim: expandtab shiftwidth=4 ft=perl6:
29+
=begin pod
30+
31+
=head1 Features used
32+
33+
C<X**> - L<http://perlcabal.org/syn/S03.html#Cross_operators>
34+
35+
=end pod
36+
37+
# vim: expandtab shiftwidth=2 ft=perl6:

‎best-of-rosettacode/README

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
This directory contains some good examples taken from rosettacode.org. We
2+
make and effort at picking examples that cover some useful or novel aspect
3+
of the Perl 6 language, and share some pointers about where to get more
4+
information about these features.
5+
6+
If you find an instructive example on rosettacode.org, then share it here!

‎best-of-rosettacode/TODO

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,8 @@
11
http://rosettacode.org/wiki/24_game#Perl_6 - a little grammar, casting (?), eval, prompt, roll
2-
http://rosettacode.org/wiki/24_game#Perl_6 [the second one] - ZIP, -> ... {, xx, ...,
2+
*http://rosettacode.org/wiki/24_game#Perl_6 [the second one] - ZIP, -> ... {, xx, ...,
33
http://rosettacode.org/wiki/Accumulator_factory#Perl_6 - returning a sub, is copy, $^var, static vars in subs
4+
http://rosettacode.org/wiki/Ackermann_function#Perl_6 - easy example of multi, ?? !!
5+
http://rosettacode.org/wiki/Arbitrary-precision_integers_(included)#Perl_6 - metaoperator, casting, {} in string,
6+
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)
7+
8+
* something else should be here....

‎best-of-rosettacode/balanced-brackets.pl

Lines changed: 97 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,97 @@
1+
=begin pod
2+
3+
=head1 Problem
4+
5+
Generate a string with N opening brackets (“[”) and N closing brackets (“]”), in some arbitrary order.
6+
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.
7+
8+
=head1 More
9+
10+
L<http://rosettacode.org/wiki/Balanced_brackets#Perl_6>
11+
12+
=head1 What's interesting here?
13+
* idiomatic solutions
14+
* hyper operators
15+
* switch statement
16+
* roll
17+
* grammar
18+
19+
=head2 Depth counter
20+
21+
=end pod
22+
23+
sub balanced($s) {
24+
my $l = 0;
25+
for $s.comb {
26+
when "]" {
27+
--$l;
28+
return False if $l < 0;
29+
}
30+
when "[" {
31+
++$l;
32+
}
33+
}
34+
return $l == 0;
35+
}
36+
37+
my $n = prompt "Number of brackets";
38+
my $s = (<[ ]> xx $n).pick(*).join;
39+
say "$s {balanced($s) ?? "is" !! "is not"} well-balanced"
40+
41+
=begin pod
42+
43+
=head2 FP oriented
44+
45+
=end pod
46+
47+
sub balanced($s) {
48+
.none < 0 and .[*-1] == 0
49+
given [\+] '\\' «leg« $s.comb;
50+
}
51+
52+
my $n = prompt "Number of bracket pairs: ";
53+
my $s = <[ ]>.roll($n*2).join;
54+
say "$s { balanced($s) ?? "is" !! "is not" } well-balanced"
55+
56+
=begin pod
57+
58+
=head2 String munging
59+
60+
=end pod
61+
62+
sub balanced($_ is copy) {
63+
() while s:g/'[]'//;
64+
$_ eq '';
65+
}
66+
67+
my $n = prompt "Number of bracket pairs: ";
68+
my $s = <[ ]>.roll($n*2).join;
69+
say "$s is", ' not' xx not balanced($s)), " well-balanced";
70+
71+
=begin pod
72+
73+
=head2 Prasing with a grammar
74+
75+
=end pod
76+
77+
grammar BalBrack {
78+
token TOP { ^ <balanced>* $ };
79+
token balanced { '[]' | '[' ~ ']' <balanced> }
80+
}
81+
82+
my $n = prompt "Number of bracket pairs: ";
83+
my $s = <[ ]>.roll($n*2).join;
84+
say "$s { BalBrack.parse($s) ?? "is" !! "is not" } well-balanced";
85+
86+
=begin pod
87+
88+
=head1 Features used
89+
90+
C<roll> - L<http://perlcabal.org/syn/S32/Containers.html#roll>
91+
C<given> - L<http://perlcabal.org/syn/S04.html#Switch_statements>
92+
C<prompt> - L<http://perlcabal.org/syn/S32/IO.html#prompt>
93+
C<grammar> - L<http://perlcabal.org/syn/S05.html#Grammars>
94+
95+
=end pod
96+
97+
# vim: expandtab shiftwidth=2 ft=perl6:

‎best-of-rosettacode/copy-a-string.pl

Lines changed: 38 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,38 @@
1+
use v6;
2+
3+
=begin pod
4+
5+
=head1 Copy a string
6+
7+
This task is about copying a string. Where it is relevant, distinguish
8+
between copying the contents of a string versus making an additional
9+
reference to an existing string.
10+
11+
=head2 More
12+
13+
L<http://rosettacode.org/wiki/Copy_a_string#Perl_6>
14+
15+
=end pod
16+
17+
# There is no special handling needed to copy a string.
18+
{
19+
my $original = 'Hello.';
20+
my $copy = $original;
21+
say $copy; # prints "Hello."
22+
$copy = 'Goodbye.';
23+
say $copy; # prints "Goodbye."
24+
say $original; # prints "Hello."
25+
}
26+
27+
# You can also bind a new variable to an existing one so that each refers
28+
# to, and can modify the same string.
29+
{
30+
my $original = 'Hello.';
31+
my $bound := $original;
32+
say $bound; # prints "Hello."
33+
$bound = 'Goodbye.';
34+
say $bound; # prints "Goodbye."
35+
say $original; # prints "Goodbye."
36+
}
37+
38+
# vim: expandtab shiftwidth=2 ft=perl6:

‎best-of-rosettacode/create-a-two-dimensional-array-at-runtime.pl

Lines changed: 27 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,27 @@
1+
=begin pod
2+
3+
=head1 Create a two-dimensional array at runtime
4+
5+
Get two integers from the user, then create a two-dimensional array where the
6+
two dimensions have the sizes given by those numbers, and which can be accessed
7+
in the most natural way possible. Write some element of that array, and then
8+
output that element. Finally destroy the array if not done by the language
9+
itself.
10+
11+
=head1 More
12+
13+
L<http://rosettacode.org/wiki/Create_a_two-dimensional_array_at_runtime#Perl_6>
14+
15+
=end pod
16+
17+
18+
my ($major,$minor) = prompt("Dimensions? ").comb(/\d+/);
19+
20+
my @array := [ for ^$major { [ for ^$minor {'@'} ] } ];
21+
22+
@array[ pick 1, ^$major ][ pick 1, ^$minor ] = ' ';
23+
24+
.say for @array;
25+
26+
27+
# vim: expandtab shiftwidth=2 ft=perl6:

‎best-of-rosettacode/hailstone-sequence.pl

Lines changed: 46 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -1,25 +1,46 @@
1-
#=head1 Description
2-
# The Hailstone sequence of numbers can be generated from a starting positive integer, n by:
3-
# If n is 1 then the sequence ends.
4-
# If n is even then the next n of the sequence = n/2
5-
# If n is odd then the next n of the sequence = (3 * n) + 1
6-
# The (unproven), Collatz conjecture is that the hailstone sequence for any starting number always terminates.
7-
# Task Description:
8-
# Create a routine to generate the hailstone sequence for a number.
9-
# Use the routine to show that the hailstone sequence for the number 27 has 112 elements starting with 27, 82, 41, 124 and ending with 8, 4, 2, 1
10-
# Show the number less than 100,000 which has the longest hailstone sequence together with that sequences length.
11-
# (But don't show the actual sequence)!
12-
13-
#=head1 Code
14-
sub hailstone($n) { $n, { $_ %% 2 ?? $_ div 2 !! $_ * 3 + 1 } ... 1 }
15-
16-
my @h = hailstone(27);
17-
say "Length of hailstone(27) = {+@h}";
18-
say ~@h;
19-
20-
my $m = 0 => 0;
21-
$m max= +hailstone($_) => $_ for 1..99_999;
22-
say "Max length $m.key() was found for hailstone($m.value()) for numbers < 100_000";
23-
24-
#=head2 More
25-
# http://rosettacode.org/wiki/Hailstone_sequence#Perl_6
1+
use v6;
2+
3+
=begin pod
4+
5+
=head1 Hailstone sequence
6+
7+
The Hailstone sequence of numbers can be generated from a starting positive
8+
integer, n by:
9+
10+
* If n is 1 then the sequence ends.
11+
* If n is even then the next n of the sequence = n/2
12+
* If n is odd then the next n of the sequence = (3 * n) + 1
13+
14+
The (unproven), Collatz conjecture is that the hailstone sequence for any
15+
starting number always terminates.
16+
17+
=head1 Task
18+
19+
Create a routine to generate the hailstone sequence for a number.
20+
21+
Use the routine to show that the hailstone sequence for the number 27 has 112
22+
elements starting with 27, 82, 41, 124 and ending with 8, 4, 2, 1
23+
24+
Show the number less than 100,000 which has the longest hailstone sequence
25+
together with that sequences length.
26+
27+
(But don't show the actual sequence)!
28+
29+
=head1 More
30+
31+
U<http://rosettacode.org/wiki/Hailstone_sequence#Perl_6>
32+
33+
34+
=end pod
35+
36+
sub hailstone($n) { $n, { $_ %% 2 ?? $_ div 2 !! $_ * 3 + 1 } ... 1 }
37+
38+
my @h = hailstone(27);
39+
say "Length of hailstone(27) = {+@h}";
40+
say ~@h;
41+
42+
my $m max= +hailstone($_) => $_ for 1..99_999;
43+
say "Max length $m.key() was found for hailstone($m.value()) for numbers < 100_000";
44+
45+
46+
# vim: expandtab shiftwidth=2 ft=perl6:

‎best-of-rosettacode/hailstone-sequence.pl.niecza

Lines changed: 0 additions & 34 deletions
This file was deleted.

‎best-of-rosettacode/last-fridays-of-year.pl

Lines changed: 28 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,19 @@
1-
# http://rosettacode.org/wiki/Last_Fridays#Perl_6
2-
#
3-
# Write a program or a script that returns the last Fridays of each month
4-
# of a given year. The year may be given through any simple input method
5-
# in your language (command line, std in, etc.).
1+
use v6;
2+
3+
=begin pod
4+
5+
=head1 Last fridays of the year
6+
7+
Write a program or a script that returns the last Fridays of each month
8+
of a given year. The year may be given through any simple input method
9+
in your language (command line, std in, etc.).
10+
11+
=head1 More
12+
13+
L<http://rosettacode.org/wiki/Last_Fridays#Perl_6>
14+
15+
=end pod
16+
617

718
sub MAIN (Int $year = Date.today.year) {
819
my @fri;
@@ -12,7 +23,15 @@ (Int $year = Date.today.year)
1223
.say for @fri[1..12];
1324
}
1425

15-
# The MAIN sub: http://perlcabal.org/syn/S06.html#Declaring_a_MAIN_subroutine
16-
# Date objects: http://perlcabal.org/syn/S32/Temporal.html#Date
17-
#
18-
# vim: expandtab shiftwidth=4 ft=perl6:
26+
27+
=begin pod
28+
29+
=head1 Features used
30+
31+
The MAIN sub - L<http://perlcabal.org/syn/S06.html#Declaring_a_MAIN_subroutine>
32+
33+
Date objects - L<http://perlcabal.org/syn/S32/Temporal.html#Date>
34+
35+
=end pod
36+
37+
# vim: expandtab shiftwidth=2 ft=perl6:

0 commit comments

Comments
 (0)