Weekly Challenge #084 Task #2 :: (Raku) 
Tags: challenge, perlweeklychallenge, raku, perl
Published: 2020-10-26 09:51:08

## [**TASK #2 › Find Square**](https://perlweeklychallenge.org/blog/perl-weekly-challenge-084/#TASK2)
Submitted by: Mohammad S Anwar

You are given matrix of size m x n with only 1 and 0.

Write a script to find the count of squares having all four corners set as 1.
```
Example 1:

Input: [ 0 1 0 1 ]
       [ 0 0 1 0 ]
       [ 1 1 0 1 ]
       [ 1 0 0 1 ]

Output: 1
```
Explanation:
There is one square (3x3) in the given matrix with four corners as 1 starts at r=1;c=2.
```
[ 1 0 1 ]
[ 0 1 0 ]
[ 1 0 1 ]
```
```
Example 2:

Input: [ 1 1 0 1 ]
       [ 1 1 0 0 ]
       [ 0 1 1 1 ]
       [ 1 0 1 1 ]

Output: 4
```
Explanation:
There is one square (4x4) in the given matrix with four corners as 1 starts at r=1;c=1.
There is one square (3x3) in the given matrix with four corners as 1 starts at r=1;c=2.
There are two squares (2x2) in the given matrix with four corners as 1. First starts at r=1;c=1 and second starts at r=3;c=3.
```
Example 3:

Input: [ 0 1 0 1 ]
       [ 1 0 1 0 ]
       [ 0 1 0 0 ]
       [ 1 0 0 1 ]

Output: 0
```

Last time in [Challenge #077](https://perlweeklychallenge.org/blog/perl-weekly-challenge-077/#TASK2) we found lonely X and Today We are going to find squares. and squares are made of 4 points. the task doesn't mention about diagonal squares, so I'll skip that. 

### **Reading User Mind..(User Input from STDIN)**
 Here is a subroutine to read the data from user input. 
```perl
sub read-matrix {
    $*IN.lines. # read lines from STDIN
    map( |*.split( /"]" \s* "\n"* | "\n"/  ) ).
    #  `-> split rows by newline or `]'
    map( -> $l { next if $l ~~ "";  # skip empty line
                 S:g/ '[' || \s+ //.comb.cache with $l } );
    # `-> remove unused chars.
}
```
```perl
# this is one-line for copy and paste in Raku shell
sub read-matrix { $*IN.lines.map( |*.split( /"]" \s* "\n"* | "\n"/  ) ).map( -> $l { next if $l ~~ ""; S:g/ '[' || \s+ //.comb.cache with $l } ); }
```

The routine a bit flexible so you can input like below.

```perl
> read-matrix
[1101][1100][0111][1011] # Ctrl-D to finish input
((1 1 0 1) (1 1 0 0) (0 1 1 1) (1 0 1 1))
```
For you reminder, PWC is **not so strict** to get user input. so you can start with simple put an Array into your code. so you can even start with an example.

```perl
my @matrix = [1,1,0,1], [1,1,0,0], [0,1,1,1], [1,0,1,1];
```
Or even
```perl
my @matrix = <1 1 0 1>, <1 1 0 0>, <0 1 1 1>, <1 0 1 1>;
```

### **Searching the One Among Empty World**
So we are basically searching row by row I wanted to make a record something useful before go next one. *I can do it even while getting user input. but for debugging purpose I don't normally do that.*
![Rectangle](https://dev-to-uploads.s3.amazonaws.com/i/mr3wsi00l8tnf2qal33f.jpg)

> **A Rectangle canbe made from parallel TWO LINES**

This is the basic concept what I'm going to follow today. however what we are looking for is actually squares so those pairs of lines ...

0. Two lines are parallel (given)
1. Two lines must have the same length (Parallelogram)
2. Two lines must start at the same column (Rectangle)
3. The distance between two lines must be same as the its length.

### *Collecting* **Lines**
We are going to make records, all possible lines at each rows.
To make a lines, we need two distinct points. so I'm going to use combinations again. (and have to check actually each point has the value of 1, otherwise those are not points.)

```perl
(^@matrix.elems).
map( -> $r
    {
        @matrix[$r].pairs.grep( *.value == 1, :k ).
        combinations(2).
        map({( $_, $r)}).Slip
} ).say
```

For copy and paste ✂️📋
```perl
(^@matrix.elems).map( -> $r { @matrix[$r].pairs.grep( *.value == 1, :k ).combinations(2).map({( $_, $r)}).Slip } ).say
```
```perl
(((0 1) 0) ((0 3) 0) ((1 3) 0) ((0 1) 1) ((1 2) 2) ((1 3) 2) ((2 3) 2) ((0 2) 3) ((0 3) 3) ((2 3) 3))
```
👉 ((0 1) 0) means points of 0 and 1 at row number of 0

### **Finding Rectangles (classify)**
And we are going to find the lines which are aligned vertically and has the same length

```perl
...snip...
    classify( {.[0].Str}, # key:  two points as *pair*
              # note: if we don't pair, classify() will smartly make trees
              #       which, I don't want to here.
            ).
...snip...
```
For copy and paste ✂️📋
```perl
((^@matrix.elems).map( -> $r { @matrix[$r].pairs.grep( *.value == 1, :k ).combinations(2).map({( $_, $r)}).Slip } ).classify( {.[0].Str} ).say;
```

```perl
# indented by hand ✍️ ;;;
{ 0 1 => [((0 1) 0) ((0 1) 1)],
  0 2 => [((0 2) 3)],
  0 3 => [((0 3) 0) ((0 3) 3)],
  1 2 => [((1 2) 2)],
  1 3 => [((1 3) 0) ((1 3) 2)],
  2 3 => [((2 3) 2) ((2 3) 3)] }
```
What we have here is that. classified by two points at each row. if number of values are 2 or more there are possibility we can find a square.

### **Square Square Square**
So It's time to apply rule No. 3

> 3. The distance between two lines must be same as the its length.

```perl
...snip...
    values. # only interested in values not keys like "*0 1* =>"
    map(
        { .combinations(2).cache.       # -> combinations of two lines
          grep( {  ([-] .[0;0].reverse) # length of a line
                   ==                   #    is same as
                   ([-] .[*;1].reverse) # distacne between two lines
               } ).Slip
        } ).

...snip...
```

Again, For copy and paste ✂️📋
```perl
((^@matrix.elems).map( -> $r { @matrix[$r].pairs.grep( *.value == 1, :k ).combinations(2).map({( $_, $r)}).Slip } ).classify( {.[0].Str} ).values.map({ .combinations(2).cache.grep( {  ([-] .[0;0].reverse) == ([-] .[*;1].reverse)} ).Slip } ).say
```

```perl
# again handcrafted indented output
(
    (((0 3) 0) ((0 3) 3))
    (((0 1) 0) ((0 1) 1))
    (((2 3) 2) ((2 3) 3))
    (((1 3) 0) ((1 3) 2))
)
```

Each row contains information about two lines and if we calculate the distance between two row number we can confirm they are making a square!

### **Final Code**
I left the final code for any curiosity and test. please let me know if something is wrong or question. Thank you!!!

```perl
#!/usr/bin/env raku
# -*- Mode: Raku; indent-tabs-mode: nil; coding: utf-8 -*-
# vim: set et ts=4 sw=4:

use v6.d;

=begin test-example

echo '[101][110][011] ' | raku jeongoon/raku/ch-2.raku
# -> 0
echo '[1101][1100][0111][1011]' | raku jeongoon/raku/ch-2.raku # example #2
# -> 4

=end test-example

# modifed from #077/ch-2.raku
sub USAGE {
    say "Usage:";
    say '    echo -e "[1 0 1][0 1 0][1 0 1]" | raku ch-2.raku',"\n";
    say "# or input ending with EOF (Ctrl-D or Ctrl-Z)";
    say "# you might need to filter the STDERR to get only answer.";
}

unit sub MAIN;

say "Input: (Ctrl-D or Ctrl-Z to finish to input.)";
my @matrix =
$*IN.lines.                                     # read lines from STDIN
map( |*.split( /"]" \s* "\n"* | "\n"/  ) ).     # split rows by newline or `]'
map( -> $ln { next if $ln eq "";                # skip empty line
              S:g/ '[' || \s+ //.comb.cache     # remove unused chars.
                 with $ln } );

with @matrix {
    say "A matrix recognized as ..\n";
    say "{.Array}" for $_;
    say "";

    # part1: find the all possible horizontal lines(pairs of two points)
    (^.elems).
    map( -> $r {
               .[$r].pairs.
               grep( *.value == 1, :k ).      # filter point(has value of 1)
               combinations(2).               # make pairs of two column number
               map({( $_, $r)}).Slip          # as line(two points), row number
           } ).

    # part2: group the lines which starts at the same point and has the same len
    classify( -> $rec
              {$rec[0].Str},                  # key:  two points as *pair*
              # note: if we don't pair, classify() will smartly make trees
              #       which, I don't want to here.
            ).

    # part3: find squares
    #        (check two lines has distance as same as the length of line)

    ## only interested in values (the list of (distance between pts, row num))
    values.
    map(
        { .combinations(2).cache.             # -> combinations of two lines
          grep( {  ([-] .[0;0].reverse)       # length of a line
                   ==                         #    is same as
                   ([-] .[*;1].reverse)       # distacne between two lines
               } ).Slip
        } ).

    # explaination
    map(
        {
            FIRST { $*ERR.say("Explanations:\n") }
            $*ERR.say( ++$,":{.raku}" );
            $*ERR.say( " ☞ both lines have length of "
                       ~ "{[-] .[0][0].reverse} "
                       ~ " and {[-] .[*;1].reverse} away from each other.\n" );
            LAST { $*ERR.print( "∴ " ) }
            .self }).
    elems.
    say;
}
```

This will be a part of  [🐪PWC🦋](https://perlweeklychallenge.org), Thank for reading !!!