site.base_url }}/">The Bear's Den -->

The Bear's Den

Enter at your own risk

Uncommon Shapes

Task 1: Uncommon Words

Submitted by: Mohammad Sajid Anwar


You are given two sentences, $line1 and $line2.

Write a script to find all uncommmon words in any order in the given two sentences. Return ('') if none found.

A word is uncommon if it appears exactly once in one of the sentences and doesn’t appear in other sentence.

Example 1

Input: $line1 = 'Mango is sweet'
       $line2 = 'Mango is sour'
Output: ('sweet', 'sour')

Example 2

Input: $line1 = 'Mango Mango'
       $line2 = 'Orange'
Output: ('Orange')

Example 3

Input: $line1 = 'Mango is Mango'
       $line2 = 'Orange is Orange'
Output: ('')

Solution

The definition of an uncommon word has an interesting aspect: It is actually independent from any sentence structure.

A word is uncommon, if and only if it appears exactly once in the flattened list of words.

Thus we may throw away the sentence structure completely and just look at the words as a single list and pick the singletons thereof.

use strict;
use warnings;
use List::MoreUtils 'singleton';

sub uncommon_words {
    singleton map /[[:alpha:]]+/g, @_;
}

See the full solution to task 1.

Task 2: X Matrix

Submitted by: Mohammad Sajid Anwar


You are given a square matrix, $matrix.

Write a script to find if the given matrix is X Matrix.

A square matrix is an X Matrix if all the elements on the main diagonal and antidiagonal are non-zero and everything else are zero.

Example 1

Input: $matrix = [ [1, 0, 0, 2],
                   [0, 3, 4, 0],
                   [0, 5, 6, 0],
                   [7, 0, 0, 1],
                 ]
Output: true

Example 2

Input: $matrix = [ [1, 2, 3],
                   [4, 5, 6],
                   [7, 8, 9],
                 ]
Output: false

Example 3

Input: $matrix = [ [1, 0, 2],
                   [0, 3, 0],
                   [4, 0, 5],
                 ]
Output: true

Solution

With PDL, this task can be solved in a few simple steps:

$matrix must be square to match the mask’s dimensions or - according to where - horrible things happen.

Here is a sample session in the pdl-shell for example 1:

pdl> do_print 1
1
pdl> $m = pdl [ [1, 0, 0, 2],
                [0, 3, 4, 0],
                [0, 5, 6, 0],
                [7, 0, 0, 1],
              ]

[
 [1 0 0 2]
 [0 3 4 0]
 [0 5 6 0]
 [7 0 0 1]
]

pdl> $x = identity($m) | identity($m)->(-1:0)

[
 [1 0 0 1]
 [0 1 1 0]
 [0 1 1 0]
 [1 0 0 1]
]

pdl> $m->where_both($x)
$PDL1 = [1 2 3 4 5 6 7 1];
$PDL2 = [0 0 0 0 0 0 0 0];

The final check is self-explanatory.

use strict;
use warnings;
use PDL;
use PDL::NiceSlice;

sub is_x {
    my $m = pdl @_;
    my ($on_x, $off_x) = $m->where_both(identity($m) | identity($m)->(-1:0));

    all($on_x) && !any($off_x);
}

See the full solution to task 2.


If you have a question about this post or if you like to comment on it, feel free to open an issue in my github repository.