Peter
Peter Campbell Smith

Lucky concatenations

Weekly challenge 251 — 8 January 2024

Week 251 - 8 Jan 2024

Task 2

Task — 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.

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));
    }
}

Output


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