Perl & Raku solutions to Tasks 1 & 2 for Week 277

4 files changed, 941 insertions, 0 deletions

diff --git a/challenge-277/athanasius/perl/ch-1.pl b/challenge-277/athanasius/perl/ch-1.pl
new file mode 100644
index 0000000000..029556f722
--- /dev/null
+++ b/challenge-277/athanasius/perl/ch-1.pl
@@ -0,0 +1,226 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 277
+=========================
+
+TASK #1
+-------
+*Count Common*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given two array of strings, @words1 and @words2.
+
+Write a script to return the count of words that appears in both arrays exactly
+once.
+
+Example 1
+
+  Input: @words1 = ("Perl", "is", "my", "friend")
+         @words2 = ("Perl", "and", "Raku", "are", "friend")
+  Output: 2
+
+  The words "Perl" and "friend" appear once in each array.
+
+Example 2
+
+  Input: @words1 = ("Perl", "and", "Python", "are", "very", "similar")
+         @words2 = ("Python", "is", "top", "in", "guest", "languages")
+  Output: 1
+
+Example 3
+
+  Input: @words1 = ("Perl", "is", "imperative", "Lisp", "is", "functional")
+         @words2 = ("Crystal", "is", "similar", "to", "Ruby")
+  Output: 0
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Assumptions
+-----------
+1. Only words matching exactly (including case) are considered "the same". For
+   example, "Perl" and "perl" are treated as different words, as are "friend"
+   and "friends".
+2. Within the input strings, words are separated by whitespace only. Any punctu-
+   ation characters are treated as part of the words.
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. If an explanation of the output is required, the flag "--verbose" is entered
+   on the command-line.
+3. The input word lists are entered as two strings. Within each string, words
+   are separated by whitespace.
+
+=cut
+#===============================================================================
+
+use v5.32.1;       # Enables strictures
+use warnings;
+use Const::Fast;
+use Getopt::Long;
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+  perl $0 [--verbose] <words1-str> <words2-str>
+  perl $0
+
+    <words1-str>    String 1 of whitespace-separated words
+    <words2-str>    String 2 of whitespace-separated words
+    --verbose       Explain the output? [default: False]
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 277, Task #1: Count Common (Perl)\n\n";
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my ($verbose, $words1, $words2) = parse_command_line();
+
+        printf "Input:  \@words1 = (%s)\n",
+                join ', ', map { qq["$_"] } @$words1;
+
+        printf "        \@words2 = (%s)\n",
+                join ', ', map { qq["$_"] } @$words2;
+
+        my $common = find_common_words( $words1, $words2 );
+        my $count  = scalar @$common;
+
+        print "Output: $count\n";
+
+        if ($verbose && $count > 0)
+        {
+            printf "\nWord%s appearing exactly once in each array: %s\n",
+                   ($count == 1 ? '' : 's'),
+                    join ', ', map { qq["$_"] } @$common;
+        }
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub find_common_words
+#-------------------------------------------------------------------------------
+{
+    my ($words1, $words2) = @_;
+    my  @common;
+
+    my  %dict1;
+      ++$dict1{ $_ } for @$words1;
+
+    my  %dict2;
+      ++$dict2{ $_ } for @$words2;
+
+    for my $key (keys %dict1)
+    {
+        if ($dict1{ $key } == 1 && exists $dict2{ $key } && $dict2{ $key } == 1)
+        {
+            push @common, $key;
+        }
+    }
+
+    return [ sort @common ];
+}
+
+#-------------------------------------------------------------------------------
+sub parse_command_line
+#-------------------------------------------------------------------------------
+{
+    my $verbose = 0;
+
+    GetOptions
+    (
+        verbose => \$verbose
+
+    )              or error( 'Error in command-line arguments' );
+
+    my $argc = scalar @ARGV;
+
+    $argc == 2     or error( "Expected 2 command-line arguments, found $argc" );
+
+    my @words1 = split / \s+ /x, $ARGV[ 0 ];
+    my @words2 = split / \s+ /x, $ARGV[ 1 ];
+
+    return ($verbose, \@words1, \@words2);
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        while ($line =~ / \\ $ /x)
+        {
+            $line =~ s/ \\ $ / /x;
+
+            my $next = <DATA>;
+
+            $next =~ s/ ^ \s+ //x;
+            $line .= $next;
+        }
+
+        my  ($test_name, $words1_str, $words2_str, $expected_str) =
+             split / \| /x, $line;
+
+        for ($test_name, $words1_str, $words2_str, $expected_str)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my @words1   = split / \s+ /x, $words1_str;
+        my @words2   = split / \s+ /x, $words2_str;
+        my $common   = find_common_words( \@words1, \@words2 );
+        my @expected = split / \s+ /x, $expected_str;
+
+        is_deeply $common, \@expected, $test_name;
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|Perl is my friend|Perl and Raku are friend|Perl friend
+Example 2|Perl and Python are very similar|Python is top in guest languages|   \
+          Python
+Example 3|Perl is imperative Lisp is functional|Crystal is similar to Ruby|
diff --git a/challenge-277/athanasius/perl/ch-2.pl b/challenge-277/athanasius/perl/ch-2.pl
new file mode 100644
index 0000000000..005be6f45f
--- /dev/null
+++ b/challenge-277/athanasius/perl/ch-2.pl
@@ -0,0 +1,283 @@
+#!perl
+
+################################################################################
+=comment
+
+Perl Weekly Challenge 277
+=========================
+
+TASK #2
+-------
+*Strong Pair*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of integers, @ints.
+
+Write a script to return the count of all strong pairs in the given array.
+
+    A pair of integers x and y is called strong pair if it satisfies:
+    0 < |x - y| < min(x, y).
+
+Example 1
+
+  Input: @ints = (1, 2, 3, 4, 5)
+  Output: 4
+
+  Strong Pairs: (2, 3), (3, 4), (3, 5), (4, 5)
+
+Example 2
+
+  Input: @ints = (5, 7, 1, 7)
+  Output: 1
+
+  Strong Pairs: (5, 7)
+
+=cut
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. If an explanation of the output is required, the flag "--verbose" is entered
+   on the command-line.
+3. The input integers are entered as a non-empty list at the end of the command-
+   line.
+4. If any input integer is negative, the first such must be preceded by "--" to
+   indicate that it is not a command-line flag.
+
+Assumption
+----------
+Within a strong pair (x, y), the order of x and y is not significant. So (x, y)
+is the same strong pair as (y, x). For convenience, strong pairs are always
+given as (x, y) where x < y (see Analysis below).
+
+Analysis
+--------
+Requirements (given): (a) 0 < |x - y|
+                      (b) 0 < min(x, y)         (by transitivity)
+                      (c) |x - y| < min(x, y)
+
+1. Let d = |x - y|. If x = y, then d = 0; but from (a) we know that 0 < d, so it
+   follows that x ≠ y.
+2. For convenience, let each strong pair (x, y) be ordered such that x < y.
+   Then min(x, y) = x.
+3. From (2) together with (b) it follows that x > 0; and from (1) we know that
+   d > 0. But if x = 1, (c) is impossible; therefore, x > 1.
+4. From (c) we have y - x < x. Adding x to both sides yields y < 2x.
+
+Summary. For any strong pair (x, y) ordered so that x < y, it is required that:
+
+                      (d) 1 < x < y < 2x
+
+=cut
+#===============================================================================
+
+use v5.32.1;       # Enables strictures
+use warnings;
+use Const::Fast;
+use Getopt::Long;
+use List::Util     qw( uniqint );
+use Regexp::Common qw( number );
+use Test::More;
+
+const my $USAGE => <<END;
+Usage:
+  perl $0 [--verbose] [<ints> ...]
+  perl $0
+
+    --verbose       Explain the output? [default: False]
+    [<ints> ...]    A non-empty list of integers
+END
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    $| = 1;
+    print "\nChallenge 277, Task #2: Strong Pair (Perl)\n\n";
+}
+
+#-------------------------------------------------------------------------------
+package StrongPair
+#-------------------------------------------------------------------------------
+{
+    use Moo;
+    use Types::Standard qw( Int );
+    use namespace::clean;
+
+    #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    has x =>
+    #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    (
+        is  => 'ro',
+        isa =>  Int
+    );
+
+    #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    has y =>
+    #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    (
+        is  => 'ro',
+        isa =>  Int
+    );
+
+    #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    sub BUILD                                                     # Sanity check
+    #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    {
+        my ($self) = @_;
+        my  $x     = $self->{ x };
+        my  $y     = $self->{ y };
+
+        $x < $y && 0 < ($y - $x) < $x or die 'Invalid StrongPair';
+    }
+
+    #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    sub fmt
+    #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    {
+        my ($self) = @_;
+        my  $x     = $self->{ x };
+        my  $y     = $self->{ y };
+
+        return "($x, $y)";
+    }
+}
+
+#===============================================================================
+MAIN:
+#===============================================================================
+{
+    if (scalar @ARGV == 0)
+    {
+        run_tests();
+    }
+    else
+    {
+        my ($verbose, $ints) = parse_command_line();
+
+        printf "Input:  \@ints = (%s)\n", join ', ', @$ints;
+
+        my $pairs = find_strong_pairs( $ints );
+        my $count = scalar @$pairs;
+
+        print "Output: $count\n";
+
+        if ($verbose && $count > 0)
+        {
+            printf "\nStrong pair%s: %s\n",
+                    $count == 1 ? '' : 's', join ', ', map { $_->fmt } @$pairs;
+        }
+    }
+}
+
+#-------------------------------------------------------------------------------
+sub find_strong_pairs
+#-------------------------------------------------------------------------------
+{
+    my ($ints_arg) = @_;
+    my  @ints      = sort { $a <=> $b } uniqint grep { $_ > 1 } @$ints_arg;
+    my  @pairs;
+
+    for my $i (0 .. $#ints - 1)
+    {
+        for my $j ($i + 1 .. $#ints)
+        {
+            my $x = $ints[ $i ];
+            my $y = $ints[ $j ];
+
+            if ($y < 2 * $x)            # See requirement (d) in Analysis, above
+            {
+                push @pairs, StrongPair->new( x => $x, y => $y );
+            }
+            else
+            {
+                last;
+            }
+        }
+    }
+
+    return \@pairs;
+}
+
+#-------------------------------------------------------------------------------
+sub parse_command_line
+#-------------------------------------------------------------------------------
+{
+    my $verbose = 0;
+
+    GetOptions
+    (
+        verbose => \$verbose
+    )                          or error( 'Invalid command-line argument' );
+
+    my @ints = @ARGV;
+
+    scalar @ints > 0           or error( 'Missing command-line input' );
+
+    for (@ints)
+    {
+        / ^ $RE{num}{int} $ /x or error( qq["$_" is not a valid integer] );
+    }
+
+    return ($verbose, \@ints);
+}
+
+#-------------------------------------------------------------------------------
+sub run_tests
+#-------------------------------------------------------------------------------
+{
+    print "Running the test suite\n";
+
+    while (my $line = <DATA>)
+    {
+        chomp $line;
+
+        my  ($test_name, $ints_str, $exp_str) = split / \| /x, $line;
+
+        for ($test_name, $ints_str, $exp_str)
+        {
+            s/ ^ \s+   //x;
+            s/   \s+ $ //x;
+        }
+
+        my @ints     = split /    \s+ /x, $ints_str;
+        my $pairs    = find_strong_pairs( \@ints );
+        my @exp_strs = split / \; \s* /x, $exp_str;
+        my @expected;
+
+        for my $str (@exp_strs)
+        {
+            my ($x, $y) = split / \s+ /x, $str;
+
+            push @expected, StrongPair->new( x => $x, y => $y );
+        }
+
+        is_deeply $pairs, \@expected, $test_name; 
+    }
+
+    done_testing;
+}
+
+#-------------------------------------------------------------------------------
+sub error
+#-------------------------------------------------------------------------------
+{
+    my ($message) = @_;
+
+    die "ERROR: $message\n$USAGE";
+}
+
+################################################################################
+
+__DATA__
+Example 1|1 2 3 4 5|2 3; 3 4; 3 5; 4 5
+Example 2|5 7 1 7  |5 7
diff --git a/challenge-277/athanasius/raku/ch-1.raku b/challenge-277/athanasius/raku/ch-1.raku
new file mode 100644
index 0000000000..c82fb496ed
--- /dev/null
+++ b/challenge-277/athanasius/raku/ch-1.raku
@@ -0,0 +1,198 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 277
+=========================
+
+TASK #1
+-------
+*Count Common*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given two array of strings, @words1 and @words2.
+
+Write a script to return the count of words that appears in both arrays exactly
+once.
+
+Example 1
+
+  Input: @words1 = ("Perl", "is", "my", "friend")
+         @words2 = ("Perl", "and", "Raku", "are", "friend")
+  Output: 2
+
+  The words "Perl" and "friend" appear once in each array.
+
+Example 2
+
+  Input: @words1 = ("Perl", "and", "Python", "are", "very", "similar")
+         @words2 = ("Python", "is", "top", "in", "guest", "languages")
+  Output: 1
+
+Example 3
+
+  Input: @words1 = ("Perl", "is", "imperative", "Lisp", "is", "functional")
+         @words2 = ("Crystal", "is", "similar", "to", "Ruby")
+  Output: 0
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Assumptions
+-----------
+1. Only words matching exactly (including case) are considered "the same". For
+   example, "Perl" and "perl" are treated as different words, as are "friend"
+   and "friends".
+2. Within the input strings, words are separated by whitespace only. Any punctu-
+   ation characters are treated as part of the words.
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. If an explanation of the output is required, the flag "--verbose" is entered
+   on the command-line.
+3. The input word lists are entered as two strings. Within each string, words
+   are separated by whitespace.
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 277, Task #1: Count Common (Raku)\n".put;
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    Str:D   $words1-str,               #= String 1 of whitespace-separated words
+    Str:D   $words2-str,               #= String 2 of whitespace-separated words
+    Bool:D :$verbose = False           #= Explain the output?
+)
+#===============================================================================
+{
+    my Str @words1 = $words1-str.split: / \s+ /, :skip-empty;
+    my Str @words2 = $words2-str.split: / \s+ /, :skip-empty;
+
+    "Input:  \@words1 = (%s)\n".printf:  @words1.map( { qq["$_"] } ).join: ', ';
+    "        \@words2 = (%s)\n".printf:  @words2.map( { qq["$_"] } ).join: ', ';
+
+    my Str  @common = find-common-words( @words1, @words2 );
+    my UInt $count  = @common.elems;
+
+    "Output: $count".put;
+
+    if $verbose && $count > 0
+    {
+        "\nWord%s appearing exactly once in each array: %s\n".printf:
+             ($count == 1 ?? '' !! 's'), @common.map( { qq["$_"] } ).join: ', ';
+    }
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub find-common-words
+(
+    List:D[Str:D] $words1,
+    List:D[Str:D] $words2
+--> List:D[Str:D]
+)
+#-------------------------------------------------------------------------------
+{
+    my Str @common;
+
+    my %dict1;
+     ++%dict1{ $_ } for @$words1;
+
+    my %dict2;
+     ++%dict2{ $_ } for @$words2;
+
+    for %dict1.keys -> Str $key
+    {
+        if %dict1{ $key } == 1 and %dict2{$key}:exists and %dict2{ $key } == 1
+        {
+            @common.push: $key;
+        }
+    }
+
+    @common .= sort;
+
+    return @common;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $words1-str, $words2-str, $expected-str) =
+                $line.split: / \| /;
+
+        for     $test-name, $words1-str, $words2-str, $expected-str
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Str @words1   = $words1-str.split:   / \s+ /, :skip-empty;
+        my Str @words2   = $words2-str.split:   / \s+ /, :skip-empty;
+        my Str @common   = find-common-words( @words1, @words2 );
+        my Str @expected = $expected-str.split: / \s+ /, :skip-empty;
+
+        is-deeply @common, @expected, $test-name;
+    }
+
+    done-testing;
+}
+
+#-------------------------------------------------------------------------------
+sub USAGE()
+#-------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s:g/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+#-------------------------------------------------------------------------------
+sub test-data( --> Str:D )
+#-------------------------------------------------------------------------------
+{
+    my Str $data = q:to/END/;
+        Example 1|Perl is my friend|Perl and Raku are friend|Perl friend
+        Example 2|Perl and Python are very similar|Python is top in guest      \
+                  languages|Python
+        Example 3|Perl is imperative Lisp is functional|Crystal is similar to  \
+                  Ruby|
+        END
+
+    $data ~~ s:g/ \\ \n \s* / /;                 # Concatenate backslashed lines
+
+    return $data;
+}
+
+################################################################################
diff --git a/challenge-277/athanasius/raku/ch-2.raku b/challenge-277/athanasius/raku/ch-2.raku
new file mode 100644
index 0000000000..6ae50531a9
--- /dev/null
+++ b/challenge-277/athanasius/raku/ch-2.raku
@@ -0,0 +1,234 @@
+use v6d;
+
+################################################################################
+=begin comment
+
+Perl Weekly Challenge 277
+=========================
+
+TASK #2
+-------
+*Strong Pair*
+
+Submitted by: Mohammad Sajid Anwar
+
+You are given an array of integers, @ints.
+
+Write a script to return the count of all strong pairs in the given array.
+
+    A pair of integers x and y is called strong pair if it satisfies:
+    0 < |x - y| < min(x, y).
+
+Example 1
+
+  Input: @ints = (1, 2, 3, 4, 5)
+  Output: 4
+
+  Strong Pairs: (2, 3), (3, 4), (3, 5), (4, 5)
+
+Example 2
+
+  Input: @ints = (5, 7, 1, 7)
+  Output: 1
+
+  Strong Pairs: (5, 7)
+
+=end comment
+################################################################################
+
+#--------------------------------------#
+# Copyright © 2024 PerlMonk Athanasius #
+#--------------------------------------#
+
+#===============================================================================
+=begin comment
+
+Interface
+---------
+1. If no command-line arguments are given, the test suite is run. Otherwise:
+2. If an explanation of the output is required, the flag "--verbose" is entered
+   on the command-line.
+3. The input integers are entered as a non-empty list at the end of the command-
+   line.
+4. If the first input integer is negative, it must be preceded by "--" to
+   indicate that it is not a command-line flag.
+
+Assumption
+----------
+Within a strong pair (x, y), the order of x and y is not significant. So (x, y)
+is the same strong pair as (y, x). For convenience, strong pairs are always
+given as (x, y) where x < y (see Analysis below).
+
+Analysis
+--------
+Requirements (given): (a) 0 < |x - y|
+                      (b) 0 < min(x, y)         (by transitivity)
+                      (c) |x - y| < min(x, y)
+
+1. Let d = |x - y|. If x = y, then d = 0; but from (a) we know that 0 < d, so it
+   follows that x ≠ y.
+2. For convenience, let each strong pair (x, y) be ordered such that x < y.
+   Then min(x, y) = x.
+3. From (2) together with (b) it follows that x > 0; and from (1) we know that
+   d > 0. But if x = 1, (c) is impossible; therefore, x > 1.
+4. From (c) we have y - x < x. Adding x to both sides yields y < 2x.
+
+Summary. For any strong pair (x, y) ordered so that x < y, it is required that:
+
+                      (d) 1 < x < y < 2x
+
+=end comment
+#===============================================================================
+
+use Test;
+
+#-------------------------------------------------------------------------------
+BEGIN
+#-------------------------------------------------------------------------------
+{
+    "\nChallenge 277, Task #2: Strong Pair (Raku)\n".put;
+}
+
+#-------------------------------------------------------------------------------
+class StrongPair
+#-------------------------------------------------------------------------------
+{
+    has Int $.x;
+    has Int $.y;
+
+    #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    submethod TWEAK                                               # Sanity check
+    #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    {
+        $!x < $!y && 0 < $!y - $!x < $!x or die 'Invalid StrongPair';
+    }
+
+    #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    method format( --> Str:D )
+    #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    {
+        return "($!x, $!y)";
+    }
+}
+
+#===============================================================================
+multi sub MAIN
+(
+    Bool:D :$verbose = False,                    #= Explain the output?
+
+    *@ints where { .elems > 0 && .all ~~ Int:D } #= A non-empty list of integers
+)
+#===============================================================================
+{
+    "Input:  \@ints = (%s)\n".printf: @ints.join: ', ';
+
+    my StrongPair @pairs = find-strong-pairs( @ints );
+    my UInt       $count = @pairs.elems;
+
+    "Output: $count".put;
+
+    if $verbose && $count > 0
+    {
+        "\nStrong pair%s: %s\n".printf:
+         $count == 1 ?? '' !! 's', @pairs.map( { .format } ).join: ', ';
+    }
+}
+
+#===============================================================================
+multi sub MAIN()                                  # No input: run the test suite
+#===============================================================================
+{
+    run-tests();
+}
+
+#-------------------------------------------------------------------------------
+sub find-strong-pairs( List:D[Int:D] $ints-arg --> List:D[StrongPair:D] )
+#-------------------------------------------------------------------------------
+{
+    my Int        @ints = $ints-arg.grep( { $_ > 1 } ).unique.sort;
+    my StrongPair @pairs;
+
+    for 0 .. @ints.end - 1 -> UInt $i
+    {
+        for $i + 1 .. @ints.end -> UInt $j
+        {
+            my Int $x = @ints[ $i ];
+            my Int $y = @ints[ $j ];
+
+            if $y < 2 * $x              # See requirement (d) in Analysis, above
+            {
+                @pairs.push: StrongPair.new: :$x, :$y;
+            }
+            else
+            {
+                last;
+            }
+        }
+    }
+
+    return @pairs;
+}
+
+#-------------------------------------------------------------------------------
+sub run-tests()
+#-------------------------------------------------------------------------------
+{
+    'Running the test suite'.put;
+
+    for test-data.lines -> Str $line
+    {
+        my Str ($test-name, $ints-str, $exp-str) = $line.split: / \| /;
+
+        for     $test-name, $ints-str, $exp-str
+        {
+            s/ ^ \s+   //;
+            s/   \s+ $ //;
+        }
+
+        my Int        @ints     = int-split( $ints-str );
+        my StrongPair @pairs    = find-strong-pairs( @ints );
+        my Str        @exp-strs = $exp-str.split: / \; \s* /, :skip-empty;
+        my StrongPair @expected;
+
+        for @exp-strs -> Str $str
+        {
+            my Int ($x, $y) = int-split( $str );
+
+            @expected.push: StrongPair.new: :$x, :$y;
+        }
+
+        is-deeply @pairs, @expected, $test-name; 
+    }
+
+    done-testing;
+}
+
+#-------------------------------------------------------------------------------
+sub int-split( Str:D $str --> Seq:D[Int:D] )
+#-------------------------------------------------------------------------------
+{
+    return $str.split( / \s+ /, :skip-empty ).map: { .Int };
+}
+
+#-------------------------------------------------------------------------------
+sub USAGE()
+#-------------------------------------------------------------------------------
+{
+    my Str $usage = $*USAGE;
+
+    $usage ~~ s:g/ ($*PROGRAM-NAME) /raku $0/;
+
+    $usage.put;
+}
+
+#-------------------------------------------------------------------------------
+sub test-data( --> Str:D )
+#-------------------------------------------------------------------------------
+{
+    return q:to/END/;
+        Example 1|1 2 3 4 5|2 3; 3 4; 3 5; 4 5
+        Example 2|5 7 1 7  |5 7
+        END
+}
+
+################################################################################