This is my response to the Perl Weekly Challenge #126.
$N.
1 to $N
that don’t contain digit 1.
Input: $N = 15
Output: 8
There are 8 numbers between 1 and 15 that don't contain digit 1.
2, 3, 4, 5, 6, 7, 8, 9.
Input: $N = 25
Output: 13
There are 13 numbers between 1 and 25 that don't contain digit 1.
2, 3, 4, 5, 6, 7, 8, 9, 20, 22, 23, 24, 25.
Let us start with the basic sequence:
File: non-one-seq
#! /usr/bin/env raku
unit sub MAIN (Int $N where $N > 0); # [1]
my $non-one := gather # [2]
{
for 2 .. Inf -> $candidate # [3]
{
take $candidate unless $candidate ~~ /1/; # [4]
}
}
say "First $N non-one numbers: { $non-one[^$N].join(', ') }."; # [5]
[1] Ensure a positive integer.
[2] Setting up the sequence with gather/take
is ideal here.
[3] Start at 2 (as 1 cannot be part of the solution, and go of ad infinitum.
[4] Use (take) the value if it does not contain any 1 digit.
[5] Print the specified number of values. The sequnce is lazy, so the values are only computed on demand.
See my Raku Gather,
I Take article or
docs.raku.org/syntax/gather take for more information about
gather/take.
Running it:
$ ./non-one-seq 10
First 10 non-one numbers: 2, 3, 4, 5, 6, 7, 8, 9, 20, 22.
$ ./non-one-seq 15
First 15 non-one numbers: 2, 3, 4, 5, 6, 7, 8, 9, 20, 22, 23, 24, 25, 26, 27.
$ ./non-one-seq 20
First 20 non-one numbers: 2, 3, 4, 5, 6, 7, 8, 9, 20, 22, 23, 24, 25, 26, 27,\
28, 29, 30, 32, 33.
We can make it more compact, and definitely less readable:
File: non-one-seq-shorter
#! /usr/bin/env raku
unit sub MAIN (Int $N where $N > 0);
my $non-one := gather take $_ unless /1/ for 2 .. Inf; # [1]
say "First $N non-one numbers: { $non-one[^$N].join(', ') }.";
[1] Yes, this works.
$ ./non-one-seq-shorter 10
First 10 non-one numbers: 2, 3, 4, 5, 6, 7, 8, 9, 20, 22.
Then we can use this sequence to answer the challenge:
File: count-numbers
#! /usr/bin/env raku
unit sub MAIN (Int $N where $N > 0, :v(:$verbose));
my $non-one := gather take $_ unless /1/ for 2 .. Inf;
my @numbers = $non-one.map({ $_ <= $N ?? $_ !! last }); # [1]
say ": Numbers: { @numbers.join(", ") }" if $verbose; # [3]
say @numbers.elems; # [2]
[1] This gives us a list (non lazy) with values lower than the
limit. The last statement terminates the implicit loop (the
map).
[2] Print the number of elements.
[3] use verbose mode if you want the sequence as well.
See
docs.raku.org/routine/last
for more information about last.
Running it:
$ ./count-numbers -v 15
: Numbers: 2, 3, 4, 5, 6, 7, 8, 9
8
$ ./count-numbers -v 25
: Numbers: 2, 3, 4, 5, 6, 7, 8, 9, 20, 22, 23, 24, 25
13
Or we could turn it upside down, and generate a sequence that stops where we want it to - instead of pulling the plug later on:
File: count-numbers-last
#! /usr/bin/env raku
unit sub MAIN (Int $N where $N > 0, :v(:$verbose));
my $non-one := gather
{
for 2 .. Inf -> $candidate
{
last if $candidate > $N; # [1]
take $candidate unless $candidate ~~ /1/;
}
}
say ": Numbers: { @$non-one.join(', ') }." if $verbose;
say @$non-one.elems; # [2]
[1] The sequence stops when we have passed the target.
[2] print the whole sequence. This works, as it isn<'t infinite anymore.
Running it:
$ ./count-numbers-last -v 15
: Numbers: 2, 3, 4, 5, 6, 7, 8, 9.
8
$ ./count-numbers-last -v 25
: Numbers: 2, 3, 4, 5, 6, 7, 8, 9, 20, 22, 23, 24, 25.
13
We can do a one linerish trick here as well, but it is not as elegant:
File: count-numbers-last-shorter
#! /usr/bin/env raku
unit sub MAIN (Int $N where $N > 0, :v(:$verbose));
my $non-one :=
gather ( $_ > $N ?? (last) !! take $_ unless $_ ~~ /1/ ) for 2 .. Inf;
say ": Numbers: { @$non-one.join(', ') }." if $verbose;
say @$non-one.elems;
Note the parens around last. The
keyword will gobble up the following !! if we did not supply them.
Running it:
$ ./count-numbers-last-shorter -v 15
: Numbers: 2, 3, 4, 5, 6, 7, 8, 9.
8
$ ./count-numbers-last-shorter -v 25
: Numbers: 2, 3, 4, 5, 6, 7, 8, 9, 20, 22, 23, 24, 25.
13
gather/take:
> say (2 .. Inf).grep({ $_ !~~ /1/})[^10];
(2 3 4 5 6 7 8 9 20 22)
The challenge itself, as a true one liner:
> say (2 .. Inf).grep({ $_ > 15 ?? (last) !! $_ !~~ /1/}).eager.elems;
8
The eager
keyword is required, as elems does not work on lazy data structures (as
we get here).
See
docs.raku.org/routine/eager
for more information about eager.
> say (2 .. 15).grep({ $_ !~~ /1/}).elems;
8
> say (2 .. 25).grep({ !! $_ !~~ /1/}).elems;
13
As a program, with the «crash bang» line:
File: count-numbers-oneliner
#! /usr/bin/env raku
say (2 .. @*ARGS[0]).grep( * !~~ /1/ ).elems;
We can fix the gather/take version, keeping the
MAIN line as it takes care of error handling:
#! /usr/bin/env raku
unit sub MAIN (Int $N where $N > 0, :v(:$verbose));
my @non-one = gather ( take $_ unless $_ ~~ /1/ ) for 2 .. $N;
say ": Numbers: { @non-one.join(', ') }." if $verbose;
say @non-one.elems;
Note the use of assignment to an array, instead of binding to a scalar, as the data structure clearly isn't infinite anymore.
#! /usr/bin/env perl
use strict;
use warnings;
use feature 'say';
my $N = $ARGV[0] // die "Please specify a positive integer";
die "Please specify a positive integer" unless $N =~ /^[1-9]\d*$/;
my $count = 0;
/1/ ? () : $count++ for (2 .. $N);
say $count;
We can use map instead of the loop:
File: count-numbers-map-perl
#! /usr/bin/env perl
use strict;
use warnings;
use feature 'say';
my $N = $ARGV[0] // die "Please specify a positive integer";
die "Please specify a positive integer" unless $N =~ /^[1-9]\d*$/;
say scalar (grep { $_ !~ /1/ } (2 .. $N)); # [1]
[1] Evaluating an array in scalar context (as we do her, quite explicitly) gives us the size.
Running them gives the correct result:
$ ./count-numbers-perl 15
8
$ ./count-numbers-map-perl 15
8
$ ./count-numbers-perl 25
13
$ ./count-numbers-map-perl 25
13
x or
*. Please consider the x as a land mine.
x as in the
Minesweeper game.
Input:
x * * * x * x x x x
* * * * * * * * * x
* * * * x * x * x *
* * * x x * * * * *
x * * * x * * * * x
Output:
x 1 0 1 x 2 x x x x
1 1 0 2 2 4 3 5 5 x
0 0 1 3 x 3 x 2 x 2
1 1 1 x x 4 1 2 2 2
x 1 1 3 x 2 0 0 1 x
We need a way of specifying the rectangle, and I have chosen to recycle the
command line idea last used a week ago (Challenge #125.2: Binary Tree Diameter).
Specify the rows as given above, and use a vertical bar to separate the rows.
E.g. "x * * * | x * x x | * * * * | * * * x".
#! /usr/bin/env raku
unit sub MAIN (Str $game = "x * * * x * x x x x | * * * * * * * * * x | \
* * * * x * x * x * | * * * x x * * * * * | x * * * x * * * * x"); # [1]
my @board = $game.split("|")>>.words; # [2]
die "Uneven row length" unless [==] @board>>.elems; # [3]
die "Illegal character(s)"
unless all( $game.split("|")>>.words.flat) eq any("x", "*");
# [4]
for ^@board.elems -> $row # [5]
{
for ^@(@board[$row]).elems -> $col # [6]
{
print get-cell(@board, $row, $col), " "; # [7]
}
say ""; # [8]
}
sub get-cell (@board, Int $row, Int $col) # [9]
{
return 'x' if @board[$row][$col] eq 'x'; # [10]
my $count = 0; # [11]
for -1, 0, 1 -> $row-offset # [12]
{
for -1, 0, 1 -> $col-offset # [13]
{
next if $row-offset == $col-offset == 0; # [14]
next unless @board[$row + $row-offset][$col + $col-offset]; # [15]
$count++ if @board[$row + $row-offset][$col + $col-offset] eq "x"; # [16]
}
}
return $count; # [17]
}
[1] The rectangle given in the challenge is used, unless another one is specified.
[2] Turn the string into a two dimentional array.
[3] Check that all the rows have the same number of elements. (Note that zero is ok.)
[4] Check for illegal characters (i.e. anything except * and x).
[5] For each row (the index).
[6] For each cell on that row (also as the index).
[7] Get the current cell, convert it as needed (see [7]) and print it.
[8] Add a newline after printing each row.
[9] Procedure giving the value to print.
[10] The simplest case, a mine returns a mine sign.
[11] The number of neighboring mines will go here.
[12] A 3x3 square around the current cell can be computed like this,
[13] and this (as offset to the indices).
[14] The cell itself, ignore.
[15] Off the edge? If so, ignore.
[16] Add to the count if we find a mine at the given position.
[17] Return the mine count.
Running it:
$ ./minesweeper-game
x 1 0 1 x 2 x x x x
1 1 0 2 2 4 3 5 5 x
0 0 1 3 x 3 x 2 x 2
1 1 1 x x 4 1 2 2 2
x 1 1 3 x 2 0 0 1 x
Looking good.
Error checking:
$ ./minesweeper-game "x x x | * * * | x x x"
x x x
4 6 4
x x x
$ ./minesweeper-game "x x x | * * * | x x @"
Illegal character(s)
in sub MAIN at ./minesweeper-game line 9
$ ./minesweeper-game "x x x | * * * | x x"
Uneven row length
in sub MAIN at ./minesweeper-game line 7
It does not catch empty rows, though:
$ ./minesweeper-game ""
$ ./minesweeper-game "|"
Note the number of blank lines, one for each empty row.
#! /usr/bin/env perl
use strict;
use warnings;
use feature 'say';
use feature 'signatures';
use Perl6::Junction qw/all any/;
no warnings qw(experimental::signatures);
my $string = $ARGV[0] // "x * * * x * x x x x | * * * * * * * * * x | \
* * * * x * x * x * | * * * x x * * * * * | x * * * x * * * * x";
my @board;
my @size;
for my $row (split(/\s*\|\s*/, $string)) # [1]
{
my @row = split(/\s+/, $row);
die "Illegal character(s)" unless all(@row) eq any("x", "*"); # [2]
push(@board, \@row);
push(@size, scalar @row);
}
die "Uneven row length" unless all(@size) == $size[0]; # [2]
for my $row (0 .. scalar @board -1)
{
for my $col (0 .. scalar @{$board[$row]} -1)
{
print get_cell($row, $col, @board), " ";
}
say "";
}
sub get_cell ($row, $col, @board) # [3]
{
return 'x' if $board[$row][$col] eq 'x';
my $count = 0;
for my $row_offset (-1, 0, 1)
{
for my $col_offset (-1, 0, 1)
{
next if $row_offset == $col_offset && $col_offset == 0;
next unless $board[$row + $row_offset][$col + $col_offset];
next if $row + $row_offset < 0; # [4]
next if $col + $col_offset < 0; # [4]
$count++ if $board[$row + $row_offset][$col + $col_offset] eq "x";
}
}
return $count;
}
[1] Compare this loop with the elegant single line of Raku code.
[2] The checks on row length (they should be the same) and legal characters are done with Junctions, supplied by the Raku inspired module «Perl6::Junction».
[3] I have moved the array argument to the end, as it will gobble up all the other arguments if placed up front (as in the Raku version).
[4] Negative indices (as we may have in the line above) are perfectly ok in Perl, and are from the end of the array. So we need an explicit check on negative indices.
Running it gives the same result as the Raku version:
$ ./minesweeper-game-perl
x 1 0 1 x 2 x x x x
1 1 0 2 2 4 3 5 5 x
0 0 1 3 x 3 x 2 x 2
1 1 1 x x 4 1 2 2 2
x 1 1 3 x 2 0 0 1 x
And that's it.