Solutions to challenge-126

2 files changed, 130 insertions, 0 deletions

diff --git a/challenge-126/wanderdoc/perl/ch-1.pl b/challenge-126/wanderdoc/perl/ch-1.pl
new file mode 100644
index 0000000000..4617d6a1ec
--- /dev/null
+++ b/challenge-126/wanderdoc/perl/ch-1.pl
@@ -0,0 +1,42 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+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.
+
+=cut
+
+
+
+
+
+sub counting_numbers
+{
+     my $num = $_[0];
+     my $count = 0;
+     for my $cand ( 2 .. $num )
+     {
+          $count++ unless $cand =~ /1/;
+     }
+     return $count;
+}
+
+
+my $N = shift or die "Number?$/";
+print counting_numbers($N), $/;
\ No newline at end of file
diff --git a/challenge-126/wanderdoc/perl/ch-2.pl b/challenge-126/wanderdoc/perl/ch-2.pl
new file mode 100644
index 0000000000..25d88f7105
--- /dev/null
+++ b/challenge-126/wanderdoc/perl/ch-2.pl
@@ -0,0 +1,88 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+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
+
+=cut
+
+my %ways =     ('n' => [-1, 0], 'ne' => [-1,  1], 'e' => [0,  1], 'se' =>  [1, 1],
+                's' => [ 1, 0], 'sw' => [ 1, -1], 'w' => [0, -1], 'nw' => [-1, -1]);
+
+sub count_mines
+{
+     my $aref = $_[0];
+     my $output;
+     for my $row ( 0 .. $#$aref )
+     {
+
+
+          for my $col ( 0 .. $#{$aref->[$row]} )
+          {
+               if ( $aref->[$row][$col] eq 'x' )
+               {
+                    $output->[$row][$col] = $aref->[$row][$col];
+               }
+               else
+               {
+
+                    my @coords = 
+                         grep {$_->[0] >= 0 and $_->[1] >= 0 and
+                              $_->[0] <= $#$aref and $_->[1] <= $#{$aref->[$row]}}
+                         map  {[$ways{$_}[0] + $row, $ways{$_}[1] + $col]} keys %ways;
+                    my $count = 0;
+                    for my $pair ( @coords )
+                    {
+                         $count++ if ( $aref->[$pair->[0]][$pair->[1]] eq 'x' );
+
+                    }
+                    $output->[$row][$col] = $count;
+               }
+          }
+     }
+
+     return $output;
+}
+
+
+sub print_aref
+{
+     my $aref = $_[0];
+     print join(" ", @{$aref->[$_]}), $/ for 0 .. $#$aref;
+}
+
+
+
+my $rectangle = [
+     [qw (x * * * x * x x x x)],
+     [qw (* * * * * * * * * x) ],
+     [qw (* * * * x * x * x *) ],
+     [qw (* * * x x * * * * *) ],
+     [qw (x * * * x * * * * x) ] ];
+
+
+
+print_aref($rectangle);
+print $/;
+print_aref(count_mines($rectangle));
\ No newline at end of file