This is my response to the Perl Weekly Challenge #091.
$N.
Input: $N = 1122234
Output: 21321314
as we read "two 1 three 2 one 3 one 4"
Input: $N = 2333445
Output: 12332415
as we read "one 2 three 3 two 4 one 5"
Input: $N = 12345
Output: 1112131415
as we read "one 1 one 2 one 3 one 4 one 5"
I did just this (in addition to 97 other things) in my Centenary Sequences with Raku article. See the «Look-and-Say Sequences» section at the top of Part 8: Look-and-Say and Text.
The «look-and-say» procedure, as used below, is copied verbatim from the program with the same name.
File: count-number
#! /usr/bin/env raku
subset PositiveInt of Int where * > 0; # [1]
unit sub MAIN (PositiveInt $N);
say look-and-say($N);
sub look-and-say ($input)
{
my $return = "";
for $input.comb: / (.) $0* / -> $batch # [2]
{
$return ~= $batch.chars ~ $batch.substr(0,1); # [3]
}
return $return;
}
[1] It does not make sense to allow positive numbers (as stated in the challenge), so I restrict the input to positive integers only.
[2] As long as we can get blocks of identical letters (1 or more),
[3] • Add the count and the character.
The comb method will, when used without arguments, return a Sequence
containing all the letters in the string separately:
> "122333444".comb.raku
("1", "2", "2", "3", "3", "3", "4", "4", "4").Seq
When given a number, the returned strings will have that length (or less, as in the final one):
> "122333444".comb(2)
("12", "23", "33", "44", "4").Seq
We can also use a Regex. The regex is applied to the original string, and whatever matches is the first value in the returned Sequence. Then this goes on, until there are no more characters in the string.
This one matches a single digit at a time, giving the same Sequence as initially. As long as there are only digits in the string:
> "122333444".comb(/\d/).raku
("1", "2", "2", "3", "3", "3", "4", "4", "4").Seq
> "122HELP333444ME!!!".comb(/\d/).raku
("1", "2", "2", "3", "3", "3", "4", "4", "4").Seq
The second one shows that it silently ignores characters that does nop match.
We want to extract groups of the same digit, and can do that with a backwards
reference ($0) to the first match ((.)) like this:
> "122333444".comb(/(.)$0*/).raku
("1", "22", "333", "444").Seq
We could have used \d here, but . is shorter. We have already
ensured that the input is a positive integer, so it does not really matter which one
we use here.
See
docs.raku.org/routine/comb for
more information about comb.
Running it:
$ ./count-number 1122234
21321314
$ ./count-number 2333445
12332415
$ ./count-number 12345
1112131415
This does not work, as the input is not a positive number:
$ ./count-number 00
Usage:
./count-number <N>
comb, and split is no good as it removes
the delimiter character(s). It is possible to do this with a Regex (as shown in this
Rosetta Code
article - and included as «count-number-perl-regex» in the zip file), but I am unable
to come up with this kind of cleverness on my own.
So the hard way it is:
File: count-number-perl
#! /usr/bin/env perl
use strict;
use warnings;
my $N = shift(@ARGV) || "";
die "Please specify a positive integer" unless $N =~ /^[1-9]\d*$/;
my @input = split("", $N);
my $current = shift(@input);
my $count = 1;
while (@input)
{
if ($input[0] eq $current)
{
shift(@input);
$count++;
}
else
{
print $count . $current;
$current = shift(@input);
$count = 1;
}
}
print $count . $current . "\n";
Running it gives the same result as the Raku version:
$ ./count-number-perl 1 2 1 2
11
$ ./count-number-perl 1122234
21321314
$ ./count-number-perl 2333445
12332415
$ ./count-number-perl 12345
1112131415
@N, where value at each index
determines how far you are allowed to jump further.
Input: @N = (1, 2, 1, 2)
Output: 1
as we jump one place from index 0 and then twoe places from index 1 to
reach the last index.
Input: @N = (2,1,1,0,2)
Output: 0
it is impossible to reach the last index. as we jump two places from
index 0 to reach index 2, followed by one place jump from index 2 to
reach the index 3. once you reached the index 3, you can't go any
further because you can only jump 0 position further.
#! /usr/bin/env raku
subset PositiveInt of Int where * > 0; # [1]
unit sub MAIN (*@N where @N.elems > 0 && all(@N) ~~ PositiveInt; # [2]
my $index = 0;
loop # [3]
{
( say 1; last ) if $index == @N.end; # [4]
@N[$index].defined # [5]
?? ( $index += @N[$index] ) # [5a]
!! ( say 0; last); # [5b]
}
[1] Positive numbers does not make much sense, so I have restricted the input to positive integers.
[2] Ensure that we have at least one element, and that they all satisfy the restriction set up in [1].
[3] An eternal loop. We have two exit stretegies, in [4] and [5].
[4] Have we reached the end of the array? If so print "1" (as in «hurrah») and exit.
[5] Have we jumped past the array end? If so print "0" (as in «bummer») and exit [5b]. If not, add the number at that position to the index [5a], ready for the next iteration (and check in [4]).
Note the postfix «if» in [4] and the ternary
«if» (?? and !!) in [5]. You have probably read somewhere
that you can only have one expression before a postfix «if», and that
is almost true. You can only have one block, and using the
grouping operator ( and ) allows us to add as much code
as we want. And yes, you can use { and } instead, if
that makes you feel better.
{ say 1; last } if $index == @N.end; # [4x]
Running it:
$ ./jump-game 1 2 1 2
1
$ ./jump-game 2 1 1 0 2
Usage:
./jump-game [<N> ...]
Oops.
The problem is the «0», which is illegal as per the challenge. So the challenge
should have said «non-negative integers @N».
Let us so just that:
File: jump-game
#! /usr/bin/env raku
subset PositiveInt0 of Int where * >= 0;
unit sub MAIN (*@N where @N.elems > 0 && all(@N) ~~ PositiveInt0);
my $index = 0;
loop
{
(say 1; last ) if $index == @N.end;
@N[$index].defined && @N[$index] # [1]
?? ( $index += @N[$index] )
!! ( say 0; last);
}
[1] The last part is there to ensure program termination. We would have an eternal loop without it.
Running it:
$ ./jump-game 1 2 1 2
1
$ ./jump-game 2 1 1 0 2
0
#! /usr/bin/env perl
use strict;
use feature 'say';
use List::Util qw(all);
die "Non-negative integers only" unless all { $ ~= /^\d+$/ } @ARGV;
my $index = 0;
while (1)
{
if ($index == @ARGV -1) { say 1; last; }
if (defined $ARGV[$index] && $ARGV[$index])
{
$index += @ARGV[$index];
}
else
{
say 0; last;
}
}
Running it gives the same result as the Raku version:
$ ./jump-game-perl 1 2 1 2
1
$ ./jump-game-perl 2 1 1 0 2
0
And that's it.