This is my response to the Perl Weekly Challenge #063.
last_word($string, $regexp) that returns the last word matching
$regexp found in the given string, or undef if the string does
not contain a word matching $regexp.
\S) only. That means punctuation and other
symbols are part of the word.
$regexp is a regular expression. Take care that the regexp can only
match individual words! See the Examples for one way this can break if you are not
careful.
last_word(' hello world', qr/[ea]l/); # 'hello'
last_word("Don't match too much, Chet!", qr/ch.t/i); # 'Chet!'
last_word("spaces in regexp won't match", qr/in re/); # undef
last_word( join(' ', 1..1e6), qr/^(3.*?){3}/); # '399933'
Regexes look somewhat different in Raku, so I'll start with a program in Perl that
works with the code examples given in the challenge (prefixed with say so
that we can see the returned value):
#! /usr/bin/env perl
use feature 'say'; # [1]
use feature 'signatures'; # [1a]
no warnings qw(experimental::signatures); # [1a]
my $verbose = (@ARGV && @ARGV[0] eq "--verbose"); # [2]
sub last_word ($string, $regex) # [3]
{
say ": String: $string" if $verbose;
for my $word (reverse split(/\s/, $string)) # [4]
{
say ": Word: $word (regex: $regex)" if $verbose;
return $word if $word =~ $regex; # [5]
}
return; # [6]
}
say last_word(' hello world', qr/[ea]l/); # 'hello'
say last_word("Don't match too much, Chet!", qr/ch.t/i); # 'Chet!'
say last_word("spaces in regexp won't match", qr/in re/); # undef
say last_word( join(' ', 1..1e6), qr/^(3.*?){3}/); # '399933'
[1] I have chosen to make the program look as mnuch like the Raku version as possible,
hence the usage of say and procedure signatures [1a] which must enabled
explicitly.
[2] The easiest way to detect a single command line argument, without using an argument passing module.
[3] The procedure answering the challenge.
[4] Split the string on \s (the opposite of \S), so that
we end up with a list of «words» consisting of characters matching \S.
Reverse the list (= look from the end), as we were asked for the last match in the
input string.
[5] Does the current word match?
[6] We have reached the end (= the beginning) without any match. Say so.
Running it:
$ raku lawo-perl
hello
Chet!
399933
Printing an undefined value and a newline gives an empty line, so we are good.
Printing the regex (in verbose modue) gives a string that doesn't quite match what we specified. Oh well.
$ raku lawo-perl --verbose
: String: hello world
: Word: world (regex: (?^:[ea]l))
: Word: hello (regex: (?^:[ea]l))
hello
: String: Don't match too much, Chet!
: Word: Chet! (regex: (?^i:ch.t))
Chet!
: String: spaces in regexp won't match
: Word: match (regex: (?^:in re))
: Word: won't (regex: (?^:in re))
: Word: regexp (regex: (?^:in re))
: Word: in (regex: (?^:in re))
: Word: spaces (regex: (?^:in re))
: String: 1 2 3 4 5 6 7 8 9 10 11 ... 999999 1000000
: Word: 1000000 (regex: (?^:^(3.*?){3}))
...
: Word: 399933 (regex: (?^:^(3.*?){3}))
399933
I have abridged the output to make it easier to see what is going on.
Then the Raku version:
File: lawo
#! /usr/bin/env raku
unit sub MAIN (:$verbose);
sub last_word ($string, Regex $regex) # [1]
{
say ": String: $string" if $verbose;
for $string.split(/\s/).reverse -> $word # [2]
{
say ": Word: $word (regex: { $regex.gist })" if $verbose; # [3]
return $word if $word ~~ $regex;
}
return;
}
say last_word(' hello world', rx/<[ea]>l/); # 'hello'
say last_word("Don't match too much, Chet!", rx:i/ch.t/); # 'Chet!'
say last_word("spaces in regexp won't match", rx:s/in re/); # undef
say last_word( join(' ', 1..1e6), rx/^(3.*?) ** 3 /); # '399933'
[1] Note the type constraint on the regex argument.
[2] Note how much easier it is to read this line of chained instruction (where everything happens in a timely fashion from left to right), compared to the Perl version.
[3] Printing a regex doesn't work, but slapping on the gist
or raku methods does the trick.
Running it:
$ raku lawo
hello
Chet!
Nil
399933
Note the Nil, which is Raku's undefined value. It should
probably not be printed, but the task asked for return values. And
we got them right.
With verbose mode:
$ raku lawo --verbose
: String: hello world
: Word: world (regex: rx/<[ea]>l/)
: Word: hello (regex: rx/<[ea]>l/)
hello
: String: Don't match too much, Chet!
: Word: Chet! (regex: rx:i/ch.t/)
Chet!
: String: spaces in regexp won't match
: Word: match (regex: rx:s/in re/)
: Word: won't (regex: rx:s/in re/)
: Word: regexp (regex: rx:s/in re/)
: Word: in (regex: rx:s/in re/)
: Word: spaces (regex: rx:s/in re/)
Nil
: String: 1 2 3 4 5 6 7 8 9 10 11 ... 999999 1000000
: Word: 1000000 (regex: rx/^(3.*?) ** 3 /)
...
: Word: 399933 (regex: rx/^(3.*?) ** 3 /)
399933
This time we actually got the exact regex, which is good.
| Perl | Perl Print | Raku | Comment |
|---|---|---|---|
qr/[ea]l/ |
(?^:[ea]l) |
rx/<[ea]>l/ |
qr has been renamed to rx, and <[ea]>
instead of [ea]. |
qr/ch.t/i |
(?^i:ch.t) |
rx:i/ch.t/ |
The i (ignore case) adverb has been moved to the front of the regex,
as it reads better for humans. Note that Perl Print concurs... |
qr/in re/ |
(?^:in re) |
rx:s/in re/ |
Regexes in Raku ignores spaces by the default, but we can turn them on with the
s (sigspace) adverb. |
qr/^(3.*?){3}/ |
(?^:^(3.*?){3}) |
rx/^(3.*?) ** 3 / |
General quantifiers as ** 3 instead of {3}. |
See docs.raku.org/language/regexes and docs.raku.org/language/regexes-best-practices for more infoprmation about Raku regexes.
x and y characters,
that word can be rotated as follows: For the ith rotation (starting at i = 1), i % length(word)
characters are moved from the front of the string to the end. Thus, for the string
xyxx, the initial (i = 1) % 4 = 1 character (x) is moved to the
end, forming yxxx. On the second rotation, (i = 2) % 4 = 2 characters
(yx) are moved to the end, forming xxyx, and so on. See below
for a complete example.
xs and ys
and returns the minimum non-zero number of rotations required to obtain the original string.
You may show the individual rotations if you wish, but that is not required.
$word = 'xyxx';
yxxx by moving x to the end.
xxyx by moving yx to the end.
xxxy by moving xxy to the end.
xxxy by moving nothing as 4 % length(xyxx) == 0.
xxyx by moving x to the end.
yxxx by moving xx to the end.
xyxx by moving yxx to the end which is same as the given word.
I'll start with a Perl version this time as well:
File: rostr-perl
#! /usr/bin/env perl
use feature 'say';
use Getopt::Long; # [1]
my $verbose; # [1]
GetOptions ("verbose" => \$verbose); # [1]
my $string = @ARGV[0] || 'xyxx'; # [2]
die "Illegal input string" unless $string =~ /^[xy]+$/; # [2a]
my $length = length($string);
my $current = $string;
my $count = 0;
while (1)
{
$count++;
my $rotate = $count % $length;
if ($rotate)
{
my $a = substr($current, $rotate);
my $b = substr($current, 0, $rotate);
$current = $a . $b;
say ": Rotation $count: $current (moved '$b' to the end)" if $verbose;
}
elsif ($verbose)
{
say ": Rotation $count: $current (moved nothing)";
}
last if $current eq $string;
}
say "$count Rotations";
[1] This time I chose to use a module for parsing the command line options.
[2] Get the string from the command line, or use a default value. Die if the string is illegal.
The rest of the program should be self explanatory.
Running it:
$ perl rostr-perl
7 Rotations
$ perl rostr-perl --verbose
: Rotation 1: yxxx (moved 'x' to the end)
: Rotation 2: xxyx (moved 'yx' to the end)
: Rotation 3: xxxy (moved 'xxy' to the end)
: Rotation 4: xxxy (moved nothing)
: Rotation 5: xxyx (moved 'x' to the end)
: Rotation 6: yxxx (moved 'xx' to the end)
: Rotation 7: xyxx (moved 'yxx' to the end)
7 Rotations
$ perl rostr-perl --verbose xxxyyxx
: Rotation 1: xxyyxxx (moved 'x' to the end)
: Rotation 2: yyxxxxx (moved 'xx' to the end)
: Rotation 3: xxxxyyx (moved 'yyx' to the end)
: Rotation 4: yyxxxxx (moved 'xxxx' to the end)
: Rotation 5: xxyyxxx (moved 'yyxxx' to the end)
: Rotation 6: xxxyyxx (moved 'xxyyxx' to the end)
6 Rotations
Then the Raku version:
File: rostr
#! /usr/bin/env raku
subset XY where /^<[xy]>+$/; # [1]
sub MAIN (XY $string = 'xyxx', :$verbose) # [1]
{
my $length = $string.chars;
my $current = $string;
my $count = 0;
loop # [2]
{
$count++;
my $rotate = $count % $length;
if $rotate
{
my $a = $current.substr($rotate);
my $b = $current.substr(0, $rotate);
$current = $a ~ $b;
say ": Rotation $count: $current (moved '$b' to the end)" if $verbose;
}
elsif $verbose
{
say ": Rotation $count: $current (moved nothing)";
}
last if $current eq $string;
}
say "$count Rotations";
}
[1] A custom type (with subset) makes for nice validation
of the input.
[2] An eternal loop with loop without arguments.
See docs.raku.org/language/typesystem#index-entry-subset-subset for more information about «subset».
Running it gives the same result as the perl version:
$ raku rostr-perl
7 Rotations
$ raku rostr-perl --verbose
: Rotation 1: yxxx (moved 'x' to the end)
: Rotation 2: xxyx (moved 'yx' to the end)
: Rotation 3: xxxy (moved 'xxy' to the end)
: Rotation 4: xxxy (moved nothing)
: Rotation 5: xxyx (moved 'x' to the end)
: Rotation 6: yxxx (moved 'xx' to the end)
: Rotation 7: xyxx (moved 'yxx' to the end)
7 Rotations
$ raku rostr --verbose xxxyyxx
: Rotation 1: xxyyxxx (moved 'x' to the end)
: Rotation 2: yyxxxxx (moved 'xx' to the end)
: Rotation 3: xxxxyyx (moved 'yyx' to the end)
: Rotation 4: yyxxxxx (moved 'xxxx' to the end)
: Rotation 5: xxyyxxx (moved 'yyxxx' to the end)
: Rotation 6: xxxyyxx (moved 'xxyyxx' to the end)
6 Rotations
$ raku rostr --verbose xxxyyxx
: Rotation 1: xxyyxxx (moved 'x' to the end)
: Rotation 2: yyxxxxx (moved 'xx' to the end)
: Rotation 3: xxxxyyx (moved 'yyx' to the end)
: Rotation 4: yyxxxxx (moved 'xxxx' to the end)
: Rotation 5: xxyyxxx (moved 'yyxxx' to the end)
: Rotation 6: xxxyyxx (moved 'xxyyxx' to the end)
6 Rotations
And that's it.