Perl Weekly Challenge: Week 126
Challenge 1:
Count Numbers
You are given a positive integer
$N.Write a script to print count of numbers from 1 to
$Nthat don’t contain digit1.
Example
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.
This one is simple; in fact we can do it as a one-liner in Raku:
(1 .. @*ARGS[0]).grep({ $_ !~~ /1/ }).elems.say;
...and in Perl.
say scalar grep { $_ !~ /1/ } 1 .. @ARGV[0];
All these scripts do is grep out the number in the range 1 - $N which don't contain the digit 1, count the elements in the
resulting list and print it.
Challenge 2:
Minesweeper Game
You are given a rectangle with points marked with either
xor*. Please consider thexas a land mine.Write a script to print a rectangle with numbers and x as in the Minesweeper game.
A number in a square of the minesweeper game indicates the number of mines within the neighbouring squares (usually 8), also implies that there are no bombs on that square.
Example
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
My strategy for this problem (I'll show the Perl version first,) was to first import
a text file containing the minesweeper layout given as an example into a 2d array replacing
all the * with 0 and xs with -1. This makes everything numeric which will ease things later on.
my @board;
open my $fn, '<', $filename or die "$OS_ERROR\n";
while (my $line = <$fn>) {
push @board, [ map { $_ eq '*' ? 0 : -1; } split q{ }, $line ];
}
close $fn;
The search() function is the heart of the program. It takes @board as a parameter. It is passed in as
a reference which makes the array access a little ungainly but that's Perl for you.
sub search {
my ($board) = @_;
The first step is to determine the last row and column in the board. We will need to know these later for bounds checking.
my $rowlast = scalar @{$board} - 1;
my $collast = scalar @{$board->[0]} - 1;
Then for each row and each column in that row, we look for the number -1.
for my $row (0 .. $rowlast) {
for my $col (0 .. $collast) {
if ($board->[$row]->[$col] == -1) {
If we have it, we look at the up to 8 squares around it.
for my $y ($row - 1 .. $row + 1) {
for my $x ($col - 1 .. $col + 1) {
If any of those positions are outside of the board, we skip them.
if ($y < 0 || $y > $rowlast || $x < 0 || $x > $collast) {
next;
}
If on the other hand they are not a mine (i.e. they are not -1,) we increase the value of that square by 1. The good thing about doing it this way is that we don't need a special case for the cell we are standing on which is of course a -1.
if ($board->[$y]->[$x] != -1) {
$board->[$y]->[$x]++;
}
}
}
}
}
}
Finally we return the now fully populated board.
return $board;
}
output() also takes the board as a parameter by reference. It just prints out the board, converting
-1s back into xs.
sub output {
my ($board) = @_;
for my $row (0 .. scalar @{$board} - 1) {
for my $col (0 .. scalar @{$board->[$row]} - 1) {
print $board->[$row]->[$col] == -1 ? 'x' : $board->[$row]->[$col],
' ';
}
print "\n";
}
}
These functions can be put together and used all in one go like this:
output(search(\@board));
This is the Raku version of the search() function.
sub search(@board) {
my $rowlast = @board.elems - 1;
my $collast = @board[0].elems - 1;
One thing to note here is that function parameters are immutable by default in Raku. This means we have to make a copy of
@board in order to change it called @searched.
my @searched;
for 0 .. $rowlast -> $row {
for 0 .. $colmlast-> $col {
@searched[$row][$col] = @board[$row][$col];
}
}
for 0 .. $rowlast -> $row {
for 0 .. $colmlast-> $col {
if @board[$row][$col] == -1 {
for $row - 1 .. $row + 1 -> $y {
for $col - 1 .. $col + 1 -> $x {
if $y < 0 || $y > $rowlast || $x < 0 || $x > $colmlast{
next;
}
if @board[$y][$x] != -1 {
@searched[$y][$x]++;
}
}
}
}
}
}
It is this copy, @searched which is returned from the function and the original @board is left untouched.
return @searched;
}
The beauty of functions that output transformed copies of their input is that we can arrange them in a pipeline like this:
@board ==> search() ==> output();
This is so much more readable than the Perl equivalent.