laurent_r

These are some answers to the Week 126 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on August 22, 2021 at 24:00). This blog post offers some solutions to this challenge, please don’t read on if you intend to complete the challenge on your own.

Task 1: Count Numbers

You are given a positive integer $N.

Write a script to print count of numbers from 1 to $N that don’t contain digit 1.

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.

Count Numbers in Raku

This is quite simple. Our program simply loops over the integers in the 2..$N range and increments a counter for each integer not containing any 1.

sub check ( $n where { $n ~~ /^\d+$/} ) {
    my $count = 0;
    for 2..$n -> $i {
        $count++ unless $i ~~ /1/;
    }
    say "There are $count integers without a 1 in the 1..$n range.";
}
check @*ARGS[0] // 24;

This script displays the following output:

$ raku ./count_numbers.raku
There are 12 integers without a 1 in the 1..24 range.

$ raku ./count_numbers.raku 32
There are 19 integers without a 1 in the 1..32 range.

Count Numbers in Perl

To have a bit more fun, I decided to write a different, more functional, implementation, with a grep on the range of integers. All the real work is done in a single code line:

use strict;
use warnings;
use feature qw/say/;

my $n = shift // 24;
my $count = scalar grep {not /1/} 2..$n;
say "There are $count integers with no 1 in the 1..$n range";

This script displays the following output:

$ perl ./count_numbers.pl
There are 12 integers with no 1 in the 1..24 range

$ perl ./count_numbers.pl 32
There are 19 integers with no 1 in the 1..32 range

Count Numbers in Julia

Essentially a port of the Raku program to Julia:

function check(n)
    count = 0;
    for i in 2:n
        if ! contains("$i", "1")
            count += 1
        end
    end
    println("There are $count integers without a 1 in the 1..$n range.")
end
check(24);

Output:

$ julia ./count_numbers.jl
There are 12 integers without a 1 in the 1..24 range.

Task 2: Minesweeper Game

You are given a rectangle with points marked with either x or *. Please consider the x as 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

In principle, this is quite easy, except that there are a number of edge cases (in the literal sense of the word edge), namely the edges and corners of the minesweeper grid.

Solving the edge cases might be as easy as dis-activating the “uninitialized” warnings, but I eschew doing that. Another way might be to add fictitious lines and columns (with no mine) around the grid and removing them at the end after the computations. I doubt though that it leads to a really simpler solution. Anyway, I decided to implement it “the hard way”, i.e. to check whether the position being examined is on a border or a corner.

Minesweeper Game in Raku

The get-count subroutine does the hard work: for an input position in the grid, it checks which adjacent positions are defined and then computes the number of such adjacent position where there is a mine. The rest of the program is populating the grid (an array of arrays) and looping on every position of the grid to get the number of neighboring mines. Note that we’re using some dynamic scope variables to avoid passing them around.

use v6;

sub get-count (\i, \j) {
    my $count = 0;
    my @positions;
    for -1, 0, +1 -> $k {
        for -1, 0, +1 -> $m {
            push @positions, (i + $k, j + $m) unless $k == $m == 0;
        }
    }
    my $count-mines = 0;
    for @positions -> $pos {
        next if $pos[0] | $pos[1] < 0;
        next if $pos[0] > $*max-i or $pos[1] > $*max-j;
        $count-mines++ if @*mine-field[$pos[0]][$pos[1]] eq 'x';
    }
    return $count-mines;
}

my @in-str = 
    "x * * * x * x x x x",  
    "* * * * * * * * * x", 
    "* * * * x * x * x *", 
    "* * * x x * * * * *", 
    "x * * * x * * * * x";

my @*mine-field;
# Populating an AoA from the array of strings
for @in-str -> $line {
    push @*mine-field, [split /\s+/, $line];
}
say join "\n", @*mine-field, "\n";
my $*max-i = @*mine-field.end;
my $*max-j = @*mine-field[0].end;
for 0..$*max-i -> $i {
    for 0..$*max-j -> $j {
        next if @*mine-field[$i][$j] eq 'x';
        @*mine-field[$i][$j] = get-count $i, $j;
    }
}
say join "\n", @*mine-field;

This program displays the following output:

$ raku ./mine-sweeper.raku
x * * * x * x x x x
* * * * * * * * * x
* * * * x * x * x *
* * * x x * * * * *
x * * * x * * * * x
-
-
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

Minesweeper Game in Perl

This is essentially a port to Perl of the above Raku program. The get_count subroutine does the hard work: for an input position in the grid, it checks which adjacent positions are defined and then computes the number of such adjacent position where there is a mine. The rest of the program is populating the grid (an array of arrays) and looping on every position of the grid to get the number of neighboring mines.

use strict;
use warnings;
use feature qw/say/;
use Data::Dumper;

my (@mine_field, $max_i, $max_j);

sub get_count {
    my ($i, $j) = @_;
    my $count = 0;
    my @positions;
    for my $k (-1, 0, +1) {
        for my $m (-1, 0, +1) {
            push @positions, [$i + $k, $j + $m] unless $k == 0 and $m == 0;
        }
    }
    my $count_mines = 0;
    for my $pos (@positions) {
        next if $pos->[0] <0 or $pos->[1] < 0;
        next if $pos->[0] > $max_i or $pos->[1] > $max_j;
        $count_mines++ if $mine_field[$pos->[0]][$pos->[1]] eq 'x';
    }
    return $count_mines;
}

sub print_grid {
    say "@$_" for @_; say "";
}

my @in_str = 
    ( "x * * * x * x x x x",  
      "* * * * * * * * * x", 
      "* * * * x * x * x *", 
      "* * * x x * * * * *", 
      "x * * * x * * * * x" );

# Populating an AoA from the array of strings
for my $line (@in_str) {
    push @mine_field, [split /\s+/, $line];
}

$max_i = $#mine_field;
$max_j = $#{$mine_field[0]};
print_grid @mine_field;

for my $i (0..$max_i) {
    for my $j (0..$max_j) {
        next if $mine_field[$i][$j] eq 'x';
        $mine_field[$i][$j] = get_count $i, $j;
    }
}
print_grid @mine_field;

This program displays the following output:

$ perl ./mine-sweeper.pl
x * * * x * x x x x
* * * * * * * * * x
* * * * x * x * x *
* * * x x * * * * *
x * * * x * * * * x

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

Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on August 29, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.