Merge pull request #10138 from lancew/master

Perl by Lance

2 files changed, 131 insertions, 0 deletions

diff --git a/challenge-270/lance-wicks/perl/lib/Special.pm b/challenge-270/lance-wicks/perl/lib/Special.pm
new file mode 100644
index 0000000000..9b05c0c0c2
--- /dev/null
+++ b/challenge-270/lance-wicks/perl/lib/Special.pm
@@ -0,0 +1,58 @@
+package Special;
+
+use Data::Dumper;
+
+# A position (i, j) is called special if
+#   $matrix[i][j] == 1
+#    and all other elements in the row i
+#    and column j are 0.
+
+sub count_positions {
+    my ( $self, $matrix ) = @_;
+
+    my $positions = 0;
+    for ( @{ $self->coords_list } ) {
+
+        $positions++ if $self->is_special( $matrix, $_->[0], $_->[1], );
+    }
+
+    return $positions;
+}
+
+sub coords_list {
+    return [
+        [ 0, 0 ], [ 0, 1 ], [ 0, 2 ],    #
+        [ 1, 0 ], [ 1, 1 ], [ 1, 2 ],    #
+        [ 2, 0 ], [ 2, 1 ], [ 2, 2 ],    #
+    ];
+}
+
+sub is_special {
+    my ( $self, $matrix_orig, $i, $j ) = @_;
+
+    my $matrix;
+    for ( 0, 1, 2 ) {
+        push @$matrix, [ @{ $matrix_orig->[$_] } ];
+    }
+
+    return 0 if $matrix->[$i][$j] == 0;
+
+    my $row = $matrix->[$i];
+    delete $row->[$j];
+
+    my $result = grep { $_ != 0 } @$row;
+    return 0 if $result;
+
+    my @column;
+    for ( 0, 1, 2 ) {
+        push @column, $matrix->[$_][$j];
+    }
+    delete $column[$i];
+
+    $result = grep { $_ != 0 } @column;
+    return 0 if $result;
+
+    return 1;
+}
+
+1;
diff --git a/challenge-270/lance-wicks/perl/t/ch-1.t b/challenge-270/lance-wicks/perl/t/ch-1.t
new file mode 100644
index 0000000000..5d8595ef2d
--- /dev/null
+++ b/challenge-270/lance-wicks/perl/t/ch-1.t
@@ -0,0 +1,73 @@
+use Test2::V0 -target => 'Special';
+
+subtest 'Example 1' => sub {
+    my $matrix = [
+        [ 1, 0, 0 ],    #
+        [ 0, 0, 1 ],    #
+        [ 1, 0, 0 ],    #
+    ];
+
+    my $got = $CLASS->count_positions($matrix);
+    is $got, 1;
+};
+
+subtest 'Example 2' => sub {
+    my $matrix = [
+        [ 1, 0, 0 ],    #
+        [ 0, 1, 0 ],    #
+        [ 0, 0, 1 ],    #
+    ];
+    my $got = $CLASS->count_positions($matrix);
+    is $got, 3;
+};
+
+subtest 'Extra test 1' => sub {
+    my $matrix = [
+        [ 1, 0, 0 ],    #
+        [ 1, 0, 0 ],    #
+        [ 1, 0, 0 ],    #
+    ];
+    my $got = $CLASS->count_positions($matrix);
+    is $got, 0;
+};
+
+subtest 'Extra test 2' => sub {
+    my $matrix = [
+        [ 1, 1, 1 ],    #
+        [ 0, 0, 0 ],    #
+        [ 0, 0, 0 ],    #
+    ];
+    my $got = $CLASS->count_positions($matrix);
+    is $got, 0;
+};
+
+subtest "Positions generator" => sub {
+    is $CLASS->coords_list, [
+        [ 0, 0 ], [ 0, 1 ], [ 0, 2 ],    #
+        [ 1, 0 ], [ 1, 1 ], [ 1, 2 ],    #
+        [ 2, 0 ], [ 2, 1 ], [ 2, 2 ],    #
+        ],
+        'Should return the correct set of coords';
+};
+
+subtest "Position test" => sub {
+    my $matrix = [
+        [ 1, 0, 0 ],                     #
+        [ 0, 0, 1 ],                     #
+        [ 1, 0, 0 ],                     #
+    ];
+
+    is $CLASS->is_special( $matrix, 0, 0 ), 0;
+    is $CLASS->is_special( $matrix, 0, 1 ), 0;
+    is $CLASS->is_special( $matrix, 0, 2 ), 0;
+
+    is $CLASS->is_special( $matrix, 1, 0 ), 0;
+    is $CLASS->is_special( $matrix, 1, 1 ), 0;
+    is $CLASS->is_special( $matrix, 1, 2 ), 1;
+
+    is $CLASS->is_special( $matrix, 2, 0 ), 0;
+    is $CLASS->is_special( $matrix, 2, 1 ), 0;
+    is $CLASS->is_special( $matrix, 2, 2 ), 0;
+};
+
+done_testing;