diff options
| author | Mohammad Sajid Anwar <Mohammad.Anwar@yahoo.com> | 2024-07-11 09:45:38 +0100 |
|---|---|---|
| committer | GitHub <noreply@github.com> | 2024-07-11 09:45:38 +0100 |
| commit | e79d65d2f3eab4cca119da2f36a98049e73d741e (patch) | |
| tree | 2644df652d93a48ca94c254ebedcfc177511d96d | |
| parent | 3bfb291f8c6105a572754e02b0d4797a15fe2bb7 (diff) | |
| parent | cfc9cf76cecb5dcee259c4e3ed4b61af99e406b2 (diff) | |
| download | perlweeklychallenge-club-e79d65d2f3eab4cca119da2f36a98049e73d741e.tar.gz perlweeklychallenge-club-e79d65d2f3eab4cca119da2f36a98049e73d741e.tar.bz2 perlweeklychallenge-club-e79d65d2f3eab4cca119da2f36a98049e73d741e.zip | |
Merge pull request #10411 from PerlMonk-Athanasius/branch-for-challenge-277
Perl & Raku solutions to Tasks 1 & 2 for Week 277
| -rw-r--r-- | challenge-277/athanasius/perl/ch-1.pl | 226 | ||||
| -rw-r--r-- | challenge-277/athanasius/perl/ch-2.pl | 283 | ||||
| -rw-r--r-- | challenge-277/athanasius/raku/ch-1.raku | 198 | ||||
| -rw-r--r-- | challenge-277/athanasius/raku/ch-2.raku | 234 |
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 +} + +################################################################################ |
