Peter’s blog ✴ Week 251 ✴ 8 January 2024

THE WEEKLY CHALLENGE
Lucky concatenations

The Perl Camel

Task 2

Lucky numbers

You are given a m x n matrix of distinct numbers. Write a script to return the lucky number, if there is one, or -1 if not.

A lucky number is an element of the matrix such that it is the minimum element in its row and maximum in its column.

Examples


Example 1
Input: $matrix = [ [ 3,  7,  8],
                   [ 9, 11, 13],
                   [15, 16, 17] ];
Output: 15

15 is the only lucky number since it is the minimum in its row
and the maximum in its column.

Example 2
Input: $matrix = [ [ 1, 10,  4,  2],
                   [ 9,  3,  8,  7],
                   [15, 16, 17, 12] ];
Output: 12

Example 3
Input: $matrix = [ [7 ,8],
                   [1 ,2] ];
Output: 7

Analysis

The calculations required by this challenge are straightforward, but perhaps the most challenging aspect is to produce clearly understandable code.

I started by writing this:

for $r (0 .. @$m - 1) {
   for $c (0 .. @{$m->[0]} - 1) {
      push(@lucky, $m->[$r]->[$c]) 
         if (min_in_row($r, $c) 
         and max_in_col($r, $c));
   }
}

So clearly I am iterating over all the elements and pushing their values onto the array @lucky if they are the minimum in their row and maximum in their column.

The functions min_in_row and max_in_col could be written simply to check the supplied element against all the others in its row or column. But that's a bit wasteful, because we'd be looking for the smallest value in row r for every column c - and of course coming up with the same answer each time. So I chose to cache these values when first calculated in the arrays @mins and @maxs.

The last rather tedious part is to print out the input in a format which lines up the columns - but we did that already in week 211 and I have more-or-less copied that code from there.

The rules state that we must return -1 if there is no lucky element, but Mohammad doesn't provide an example, so I wondered for a moment whether such a matrix exists - but in another moment I created an example, and included it in my test runs.

That prompted me to wonder whether there could be more than one lucky number in a matrix, and a little thought demonstrated that the answer is that there can be more than one lucky element - but they must all have the same value.

Why is that? Consider a matrix with cell r1c1 having the value n, and r2c2 having the value m. Can these both be lucky? The rules say that they are both lucky if r1c2 is >= n (since r1c1 is the smallest in row 1), and <= m, and also r2c1 has to be <= n and >= m. The only solution to that is if m = n, and that assumes the rules allow that 'the minimum element' could be the lowest equal value rather than the uniquely lowest. I have provided an example using the 'lowest equal' condition.

Perl Weekly’s review

from Perl Weekly issue 651

Iterate from both ends? You must check it how. Keep it up great work.

Try it 

Try running the script with any input:



example: [1, 2, 3], [2, 3, 4], [3, 4, 5]

Script


#!/usr/bin/perl

use v5.16;    # The Weekly Challenge - 2024-01-08
use utf8;     # Week 251 task 2 - Lucky numbers
use strict;   # Peter Campbell Smith
use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge

binmode STDOUT, ':utf8';

lucky_numbers([[ 3,  7,  8],
               [ 9, 11, 13],
               [15, 16, 17]]);
               
lucky_numbers([[ 1, 10,  4,  2],
               [ 9,  3,  8,  7],
               [15, 16, 17, 12]]);
               
lucky_numbers([[7, 8],
               [1, 2]]);
               
lucky_numbers([[1, 2, 3],
               [2, 1, 4],
               [3, 4, 1]]);
               
lucky_numbers([[7, 4, 4, 7],
               [6, 5, 5, 6],
               [6, 5, 5, 6],
               [7, 4, 4, 7]]);
                
                        
sub lucky_numbers {
    
    my ($r, $c, @lucky);
    our ($m, @mins, @maxs);
    @mins = @maxs = ();
    
    $m = shift;
    
    # loop over elements of matrix
    for $r (0 .. @$m - 1) {
        for $c (0 .. @{$m->[0]} - 1) {
            
            # save value if element is lucky
            push(@lucky, $m->[$r]->[$c]) if (min_in_row($r, $c) and max_in_col($r, $c));
        }
    }
    say format_matrix(qq{\nInput: \@matrix = }, $m);
    say qq[Output: ] . (@lucky > 0 ? join(', ', @lucky) : -1);

    sub min_in_row {
        
        my ($r, $c, $cx, $min_value);
        
        # return true/false if element $m($r, $c) is the minimum in its row
        ($r, $c) = @_;
        
        # return saved value if we've been here before
        return ($mins[$r] == $m->[$r]->[$c] ? 1 : 0) if defined $mins[$r];
        
        # or determine and save it if not
        $min_value = 99999;
        for $cx (0 .. @{$m->[0]} - 1) {
            $min_value = $m->[$r]->[$cx] if $m->[$r]->[$cx] < $min_value;
        }
        $mins[$r] = $min_value;
        return $m->[$r]->[$c] == $min_value;
    }
    
    sub max_in_col {
        
        my ($r, $c, $rx, $max_value);
        
        # return true/false if element $m($r, $c) is the maximum in its column
        ($r, $c) = @_;

        # return saved value if we've been here before
        return ($maxs[$c] == $m->[$r]->[$c] ? 1 : 0) if defined $maxs[$c];
        
        # or determine and save it if not
        $max_value = -99999;
        for $rx (0 .. @$m - 1) {
            $max_value = $m->[$rx]->[$c] if $m->[$rx]->[$c] > $max_value;
        }
        $maxs[$c] = $max_value;
        return $m->[$r]->[$c] == $max_value;
    }
}

sub format_matrix {
    
    # format the output
    my ($w, $m, $r, $c, $prefix, $width, $rubric, $spaces, $line);
    
    ($rubric, $m) = @_;
    $spaces = length($rubric);
    
    # find maximum width of element as printed by Perl
    $w = 0;
    for $r (0 .. @$m - 1) {
        for $c (0. .. @{$m->[0]} - 1) {
            $width = length($m->[$r]->[$c]);
            $w = $width if $width > $w;
        }
    }
    
    # construct and output each row of matrix
    for $r (0 .. @$m - 1) {
        $line = $rubric . '[';
        for $c (0 .. @{$m->[0]} - 1) {
            $line .= sprintf("%${w}d", $m->[$r]->[$c]) . ', ';
        }
        $line =~ s|, $|]|;
        print $line;
        say '' unless $r == @$m - 1;
        $rubric = (' ' x ($spaces - 1));
    }
}

45 lines of code

Output from script


Input: @matrix = [ 3,  7,  8]
                 [ 9, 11, 13]
                 [15, 16, 17]
Output: 15

Input: @matrix = [ 1, 10,  4,  2]
                 [ 9,  3,  8,  7]
                 [15, 16, 17, 12]
Output: 12

Input: @matrix = [7, 8]
                 [1, 2]
Output: 7

Input: @matrix = [1, 2, 3]
                 [2, 1, 4]
                 [3, 4, 1]
Output: -1

Input: @matrix = [7, 4, 4, 7]
                 [6, 5, 5, 6]
                 [6, 5, 5, 6]
                 [7, 4, 4, 7]
Output: 5, 5, 5, 5

 

Any content of this website which has been created by Peter Campbell Smith is in the public domain