B.pl

#! /usr/bin/env perl

use v5.14;
use strict;
use warnings;
use List::Util qw{first};

sub read_line {
    my $line = scalar <>;
    return () unless $line;
    chomp $line;
    return $line;
}

sub find_max {
    my ($map, $limit) = @_;
    $limit //= 101;

    my $max = -1;
    for (@$map) {
        for (@$_) {
            $max = $_ if $_ > $max && $_ < $limit;
        }
    }
    return $max;
}

sub find_min {
    my ($map, $limit) = @_;
    $limit //= 0;

    my $min = 101;
    for (@$map) {
        for (@$_) {
            $min = $_ if $_ < $min && $_ > $limit;
        }
    }
    return $min;
}

# Tells whether it's feasible for a row to have been cut with $level
# It's possible for the row to have been cut as long as there's no grass
# *taller* than the cutter's level.
# Returns the amount of "tiles" that are passable
sub passable {
    my ($row, $level) = @_;
    print "Row ", join(' ', @$row), ", level $level: " if $ENV{DEBUG};
    my $score = 0;
    for (@$row) {
        ++$score if $_ <= $level;
    }
    print "$score tiles passable\n" if $ENV{DEBUG};
    return $score;
}

# Returns the amount of "tiles" that are identical to $level
sub present {
    my ($row, $level) = @_;
    my $count = 0;
    for (@$row) {
        ++$count if $_ == $level;
    }
    print "Row ", join(' ', @$row), ", level $level, found $count\n" if $ENV{DEBUG};
    return $count;
}

# Returns the indexes where tiles identical to $level can be found
sub extract {
    my ($row, $level) = @_;
    my @found;
    for (0..(@$row-1)) {
        push @found, $_ if $$row[$_] == $level;
    }
    return @found;
}

sub transpose {
    my ($orig) = @_;
    use Data::Dumper;
    my $new = [];
    for my $row (0..(@$orig-1)) {
        for my $col (0..(@{$$orig[$row]}-1)) {
            $$new[$col][$row] = $$orig[$row][$col];
        }
    }
    return $new;
}

sub feasible_level {
    my ($map, $tr_map, $level) = @_;
    my $rows = @$map;
    my $cols = @$tr_map;

    use Data::Dumper;
    my $feasible = 1;
    my @check_cols;
    for my $row (0..($rows-1)) {
        my $pass = passable($$map[$row], $level);
        unless ($pass == $cols) {
            # since this is not a full feasible row, add to the list of columns to check
            my @cols = extract($$map[$row], $level);
            for my $c (@cols) {
                push @check_cols, $c unless defined first { $_ == $c } @check_cols;
            }
        }
    }
    for my $col (@check_cols) {
        my $pass = passable($$tr_map[$col], $level);
        unless ($pass == $rows) {
            $feasible = 0;
        }
    }
    return $feasible;
}

my $lawncount = read_line;

for my $case (1..$lawncount) {
    read_line =~ /^(\d+) (\d+)$/;
    my ($rows, $cols) = ($1, $2);

    my $map = [];
    for (1..$rows) {
        push @$map, [split ' ', read_line];
    }
    my $tr_map = transpose($map, $rows, $cols);

    my $feasible = 1;
    my $min = undef;
    until (($min = find_min($map, $min)) > 100) {
        print "Checking level $min\n" if $ENV{DEBUG};
        $feasible = feasible_level($map, $tr_map, $min);
        last unless $feasible;
    }

    print "Case #$case: ", ($feasible ? "YES" : "NO"), "\n";
}