new file: challenge-126/mattneleigh/perl/ch-1.pl

	new file:   challenge-126/mattneleigh/perl/ch-2.pl

2 files changed, 212 insertions, 0 deletions

diff --git a/challenge-126/mattneleigh/perl/ch-1.pl b/challenge-126/mattneleigh/perl/ch-1.pl
new file mode 100755
index 0000000000..4347c69bdd
--- /dev/null
+++ b/challenge-126/mattneleigh/perl/ch-1.pl
@@ -0,0 +1,101 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use English;
+
+################################################################################
+# Begin main execution
+################################################################################
+
+my @args = (15, 25);
+my $answers;
+
+# Sort args just for general safety-
+# numbers_without_one() expects a
+# sorted list
+@args = sort({$a <=> $b} @args);
+
+$answers = numbers_without_one(@args);
+
+foreach(@args){
+    # Grab a slice from the array of numbers matching
+    # our search criteria, ranging from zero to the next
+    # index in the indices list, which corresponds to
+    # the sequence found for the original argument
+    # presently held in $_
+    my @numbers = @{$answers->{numbers}}[0..shift(@{$answers->{indices}})];
+
+    printf(
+        "There are %d numbers between 1 and %d that don't contain digit 1:\n",
+        scalar(@numbers),
+        $_
+    );
+    printf("    %s\n\n", join(", ", @numbers));
+}
+
+exit(0);
+################################################################################
+# End main execution; subroutines follow
+################################################################################
+
+
+
+################################################################################
+# Find a series of integers that do not contain the digit '1'
+# Takes one argument:
+# * A list of integers, which must be sorted in ascending order
+# Returns:
+# * A ref to a hash containing the following fields:
+#   {
+#       numbers => [], # A list of numbers between 2 and the highest number
+#                      # in the argument list, none of which contain '1'
+#       indices => []  # A list of indices that indicate which number in the
+#                      # numbers list corresponds to the highest number found
+#                      # for each of the supplied arguments
+#   }
+################################################################################
+sub numbers_without_one{
+
+    # Don't bother checking 1- it happens
+    # to contain '1'
+    my $num = 2;
+    my $found = {
+        numbers => [],
+        indices => [],
+    };
+
+    while(1){
+        # Treat the number like a string
+        # because we can
+        if($num !~ m/1/){
+            # Number did not have a '1' in it-
+            # store it in the list of found
+            # numbers
+            push(@{$found->{numbers}}, $num);
+        }
+        if($num == $ARG[0]){
+            # $num matches the 0th member of the
+            # remaining arguments- store the
+            # index of the current last member
+            # of the found number list in the
+            # list of indices
+            push(
+                @{$found->{indices}},
+                $#{$found->{numbers}}
+            );
+
+            # Strip the 0th element from @ARG and
+            # break the loop if @ARG is empty
+            shift(@ARG);
+            last unless(@ARG);
+        }
+        $num++;
+    }
+
+    return($found);
+
+}
+
+
+
diff --git a/challenge-126/mattneleigh/perl/ch-2.pl b/challenge-126/mattneleigh/perl/ch-2.pl
new file mode 100755
index 0000000000..a62b6aff2a
--- /dev/null
+++ b/challenge-126/mattneleigh/perl/ch-2.pl
@@ -0,0 +1,111 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+################################################################################
+# Begin main execution
+################################################################################
+
+my @grid = (
+    "x * * * x * x x x x",
+    "* * * * * * * * * x",
+    "* * * * x * x * x *",
+    "* * * x x * * * * *",
+    "x * * * x * * * * x"
+);
+
+print("Input:\n");
+foreach(@grid){
+    print("    $_\n");
+}
+print("\nOutput:\n");
+foreach(mark_minefield_counts(@grid)){
+    print("    $_\n");
+}
+print("\n");
+
+exit(0);
+################################################################################
+# End main execution; subroutines follow
+################################################################################
+
+
+
+################################################################################
+# Mark a minefield grid with the number of mines adjacent to each non-mine
+# cell
+# Takes one argument:
+# * An array of strings that describe a grid, with 'x' representing mined
+#   cells, and '*' representing non-mined cells, e.g.:
+#   (
+#       "x * * * * x",
+#       "* * * * x *",
+#       "* x * * * x"
+#   )
+#   Note that all the strings must be the same length
+# Returns:
+# * A copy of the minefield grid, with the non-mine cells marked with the
+#   number of mines adjacent to each, e.g.:
+#   (
+#       "x 1 0 1 2 x",
+#       "2 2 1 1 x 3",
+#       "1 x 1 1 2 x"
+#   )
+################################################################################
+sub mark_minefield_counts{
+    my @grid = @_;
+
+    my $h;
+    my $w;
+    my $i;
+    my $j;
+
+    $h = scalar(@grid);
+
+    # Eliminate spaces, change un-mined
+    # cells to zeros, and break each line
+    # into its component characters
+    $j = $h;
+    while($j--){
+        $grid[$j] =~ s/ //g;
+        $grid[$j] =~ s/\*/0/g;
+        $grid[$j] = [split('', $grid[$j])];
+    }
+
+    $w = scalar(@{$grid[0]});
+
+    # Wander the grid in an orderly fashion
+    $j = $h;
+    while($j--){
+        $i = $w;
+        while($i--){
+            # There are probably fewer mines than
+            # not-mines, so look for mines
+            if($grid[$j][$i] eq 'x'){
+                # This cell has a mine- examine adjacent
+                # cells within the bounds of the grid
+                for my $y (($j ? $j-1 : 0) .. ($j+1-$h ? $j+1 : $j)){
+                    for my $x (($i ? $i-1 : 0) .. ($i+1-$w ? $i+1 : $i)){
+                        # Increment the adjacent cell at
+                        # $x, $y unless it has a mine
+                        $grid[$y][$x]++
+                            unless($grid[$y][$x] eq 'x');
+                    }
+                }
+            } # end if($grid[$j][$i] eq 'x')
+        }
+    }
+
+    # Reconstitute the grid's original spacing
+    $j = $h;
+    while($j--){
+        $grid[$j] = join(" ", @{$grid[$j]});
+    }
+
+    return(@grid);
+
+}
+
+
+