The weekly challenge 298 - Task 1: Maximal Square

  1 #!/usr/bin/env perl
  2 # https://theweeklychallenge.org/blog/perl-weekly-challenge-298/#TASK1
  3 #
  4 # Task 1: Maximal Square
  5 # ======================
  6 #
  7 # You are given an m x n binary matrix with 0 and 1 only.
  8 #
  9 # Write a script to find the largest square containing only 1's and return it’s
 10 # area.
 11 #
 12 ## Example 1
 13 ##
 14 ## Input: @matrix = ([1, 0, 1, 0, 0],
 15 ##                   [1, 0, 1, 1, 1],
 16 ##                   [1, 1, 1, 1, 1],
 17 ##                   [1, 0, 0, 1, 0])
 18 ## Output: 4
 19 ##
 20 ## Two maximal square found with same size marked as 'x':
 21 ##
 22 ## [1, 0, 1, 0, 0]
 23 ## [1, 0, x, x, 1]
 24 ## [1, 1, x, x, 1]
 25 ## [1, 0, 0, 1, 0]
 26 ##
 27 ## [1, 0, 1, 0, 0]
 28 ## [1, 0, 1, x, x]
 29 ## [1, 1, 1, x, x]
 30 ## [1, 0, 0, 1, 0]
 31 #
 32 ## Example 2
 33 ##
 34 ## Input: @matrix = ([0, 1],
 35 ##                   [1, 0])
 36 ## Output: 1
 37 ##
 38 ## Two maximal square found with same size marked as 'x':
 39 ##
 40 ## [0, x]
 41 ## [1, 0]
 42 ##
 43 ## [0, 1]
 44 ## [x, 0]
 45 #
 46 ## Example 3
 47 ##
 48 ## Input: @matrix = ([0])
 49 ## Output: 0
 50 #
 51 ############################################################
 52 ##
 53 ## discussion
 54 ##
 55 ############################################################
 56 #
 57 # We produce all possible squares by creating the indices of
 58 # their corners. Then we calculate the area of each of those,
 59 # which is 0 if any of its fields is != 1, and the amount of
 60 # 1's otherwise. We keep the maximum of those areas and return
 61 # it at the end.
 62 
 63 use strict;
 64 use warnings;
 65 
 66 maximal_square([1, 0, 1, 0, 0], [1, 0, 1, 1, 1], [1, 1, 1, 1, 1], [1, 0, 0, 1, 0]);
 67 maximal_square([0, 1], [1, 0]);
 68 maximal_square([0]);
 69 
 70 sub maximal_square {
 71    my @matrix = @_;
 72    print "Input: (\n";
 73    foreach my $line (@matrix) {
 74       print "   [" . join(", ", @$line) . "],\n";
 75    }
 76    print ")\n";
 77    my $max = 0;
 78    my @first_line = @{$matrix[0]};
 79    foreach my $i (0..$#matrix) {
 80       foreach my $j ($i..$#matrix) {
 81          foreach my $k (0..$#first_line) {
 82             foreach my $l ($k..$#first_line) {
 83                next if ($j-$i) != ($l-$k);
 84                my $area = check($i, $j, $k , $l, \@matrix);
 85                $max = $area if $area > $max;
 86             }
 87          }
 88       }
 89    }
 90    print "Output: $max\n";
 91 }
 92 
 93 sub check {
 94    my ($lower_line, $upper_line, $lower_column, $upper_column, $matrix) = @_;
 95    my $area = 0;
 96    foreach my $i ($lower_line..$upper_line) {
 97       foreach my $j ($lower_column..$upper_column) {
 98          return 0 unless $matrix->[$i]->[$j];
 99          $area++;
100       }
101    }
102    return $area;
103 }
104