From ab1b88bb468184fcfcc2ce1d5c2e17edf44da775 Mon Sep 17 00:00:00 2001 From: PerlMonk-Athanasius Date: Mon, 1 Jan 2024 00:17:53 +1000 Subject: Perl & Raku solutions to Tasks 1 & 2 for Week 249 --- challenge-249/athanasius/perl/ch-1.pl | 188 +++++++++++++++++++++ challenge-249/athanasius/perl/ch-2.pl | 281 ++++++++++++++++++++++++++++++++ challenge-249/athanasius/raku/ch-1.raku | 196 ++++++++++++++++++++++ challenge-249/athanasius/raku/ch-2.raku | 274 +++++++++++++++++++++++++++++++ 4 files changed, 939 insertions(+) create mode 100644 challenge-249/athanasius/perl/ch-1.pl create mode 100644 challenge-249/athanasius/perl/ch-2.pl create mode 100644 challenge-249/athanasius/raku/ch-1.raku create mode 100644 challenge-249/athanasius/raku/ch-2.raku diff --git a/challenge-249/athanasius/perl/ch-1.pl b/challenge-249/athanasius/perl/ch-1.pl new file mode 100644 index 0000000000..1d0be2f1a5 --- /dev/null +++ b/challenge-249/athanasius/perl/ch-1.pl @@ -0,0 +1,188 @@ +#!perl + +################################################################################ +=comment + +Perl Weekly Challenge 249 +========================= + +TASK #1 +------- +*Equal Pairs* + +Submitted by: Mohammad S Anwar + +You are given an array of integers with even number of elements. + +Write a script to divide the given array into equal pairs such that: + + a) Each element belongs to exactly one pair. + b) The elements present in a pair are equal. + +Example 1 + + Input: @ints = (3, 2, 3, 2, 2, 2) + Output: (2, 2), (3, 3), (2, 2) + + There are 6 elements in @ints. + They should be divided into 6 / 2 = 3 pairs. + @ints is divided into the pairs (2, 2), (3, 3), and (2, 2) satisfying all the + conditions. + +Example 2 + + Input: @ints = (1, 2, 3, 4) + Output: () + + There is no way to divide @ints 2 pairs such that the pairs satisfy every + condition. + +=cut +################################################################################ + +#--------------------------------------# +# Copyright © 2023 PerlMonk Athanasius # +#--------------------------------------# + +#=============================================================================== +=comment + +Interface +--------- +If no command-line arguments are given, the test suite is run. + +Algorithm +--------- + +=cut +#=============================================================================== + +use v5.32.1; # Enables strictures +use warnings; +use Const::Fast; +use Regexp::Common qw( number ); +use Test::More; + +const my $USAGE => +"Usage: + perl $0 [ ...] + perl $0 + + [ ...] An even-numbered list of integers\n"; + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + $| = 1; + print "\nChallenge 248, Task #1: Equal Pairs (Perl)\n\n"; +} + +#=============================================================================== +MAIN: +#=============================================================================== +{ + my $argc = scalar @ARGV; + + if ($argc == 0) + { + run_tests(); + } + else + { + $argc % 2 == 0 + or error( "Expected an even number of integers, found $argc" ); + + my @ints = @ARGV; + + for (@ints) + { + / ^ $RE{num}{int} $ /x + or error( qq[Element "$_" is not a valid integer] ); + } + + printf "Input: \@ints = (%s)\n", join ', ', @ints; + + my $pairs = find_equal_pairs( \@ints ); + + printf "Output: %s\n", + @$pairs ? join ', ', map { '(' . join( ', ', @$_ ) . ')' } @$pairs + : '()'; + } +} + +#------------------------------------------------------------------------------- +sub find_equal_pairs +#------------------------------------------------------------------------------- +{ + my ($ints) = @_; + my @pairs; + my @sorted = sort { $a <=> $b } @$ints; + + while (@sorted) + { + my $pair = [ shift @sorted, shift @sorted ]; + + if ($pair->[ 0 ] == $pair->[ 1 ]) + { + push @pairs, $pair; + } + else # No solution is possible + { + @pairs = (); + last; + } + } + + return \@pairs; +} + +#------------------------------------------------------------------------------- +sub run_tests +#------------------------------------------------------------------------------- +{ + print "Running the test suite\n"; + + while (my $line = ) + { + chomp $line; + + my ($test_name, $ints_str, @exp_pair_strs) = split / \| /x, $line; + + for ($test_name, $ints_str, @exp_pair_strs) + { + s/ ^ \s+ //x; + s/ \s+ $ //x; + } + + my @ints = split / \s+ /x, $ints_str; + my $pairs = find_equal_pairs( \@ints ); + my @expected; + + for (@exp_pair_strs) + { + push @expected, [ split / \s+ /x ] if $_; + } + + is_deeply $pairs, \@expected, $test_name; + } + + done_testing; +} + +#------------------------------------------------------------------------------- +sub error +#------------------------------------------------------------------------------- +{ + my ($message) = @_; + + die "ERROR: $message\n$USAGE"; +} + +################################################################################ + +__DATA__ +Example 1 | 3 2 3 2 2 2 | 2 2| 2 2|3 3 +Example 2 | 1 2 3 4 | +Negatives 1|-1 1 3 -1 3 1 -1 -1 |-1 -1|-1 -1|1 1|3 3 +Negatives 2|-1 1 3 -1 3 1 -1 -1 0 1| diff --git a/challenge-249/athanasius/perl/ch-2.pl b/challenge-249/athanasius/perl/ch-2.pl new file mode 100644 index 0000000000..7d770e5764 --- /dev/null +++ b/challenge-249/athanasius/perl/ch-2.pl @@ -0,0 +1,281 @@ +#!perl + +################################################################################ +=comment + +Perl Weekly Challenge 249 +========================= + +TASK #2 +------- +*DI String Match* + +Submitted by: Mohammad S Anwar + +You are given a string s, consisting of only the characters "D" and "I". + +Find a permutation of the integers [0 .. length(s)] such that for each character +s[i] in the string: + + s[i] == 'I' ⇒ perm[i] < perm[i + 1] + s[i] == 'D' ⇒ perm[i] > perm[i + 1] + +Example 1 + + Input: $str = "IDID" + Output: (0, 4, 1, 3, 2) + +Example 2 + + Input: $str = "III" + Output: (0, 1, 2, 3) + +Example 3 + + Input: $str = "DDI" + Output: (3, 2, 0, 1) + +=cut +################################################################################ + +#--------------------------------------# +# Copyright © 2023 PerlMonk Athanasius # +#--------------------------------------# + +#=============================================================================== +=comment + +Interface +--------- +1. Command-line arguments: + i. None: the test suite is run. + ii. A non-empty string s consisting of only the characters "D" and/or "I": + a solution is found for s. + iii. A single integer n > 0: an input string s of n characters is randomly + generated, then a solution is found for s. + +2. If $DEBUG is set to a true value, each solution is checked to verify that it + satisfies the given criteria. + +Algorithm +--------- +Let s be the input string + t be the tuple [0, 1, ..., length(s)] + p be a permutation of t which satisfies the two given criteria for s. + +1. Partition t into x, y, z where + -- x is a tuple of the smallest k elements of t where k is the count of "I" + characters in s + -- z is a tuple of the largest m elements of t where m is the count of "D" + characters in s + -- y is the only element of t not already included in x or z +2. Create an empty solution tuple p +3. FOR i = 0 to length(s) - 1 + IF s[i] = "I" THEN + p[i] := the smallest remaining element of x + Remove that element from x + ELSE + p[i] := the largest remaining element of z + Remove that element from z + ENDIF + ENDFOR +4. p[length(s)] := y +5. Return p + +=cut +#=============================================================================== + +use v5.32.1; # Enables strictures +use warnings; +use Const::Fast; +use Regexp::Common qw( number ); +use Test::More; + +const my $DEBUG => 1; +const my $USAGE => < + perl $0 + perl $0 + + Integer > 0: length of string to be generated + Non-empty string consisting of only the characters "D" and "I" +END + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + $| = 1; + print "\nChallenge 249, Task #2: DI String Match (Perl)\n\n"; +} + +#=============================================================================== +MAIN: +#=============================================================================== +{ + my $argc = scalar @ARGV; + + if ($argc == 0) + { + run_tests(); + } + elsif ($argc == 1) + { + my $str = parse_command_line(); + + print qq[Input: \$str = "$str"\n]; + + my $permutation = DI_string_match( $str ); + + if ($DEBUG && !verify( $str, $permutation )) + { + die sprintf qq[Permutation (%s) for "%s" failed verification], + join( ', ', @$permutation ), $str; + } + + printf "Output: (%s)\n", join ', ', @$permutation; + } + else + { + error( "Expected 1 or 0 parameters, found $argc" ); + } +} + +#------------------------------------------------------------------------------- +sub DI_string_match +#------------------------------------------------------------------------------- +{ + my ($str) = @_; + $str =~ / ^ [DI]+ $ /x + or die qq[DI_string_match(): invalid \$str argument "$str"]; + my @perm; + my $len = length $str; + my @ints = 0 .. $len; + + for my $i (0 .. $len - 1) + { + if (substr( $str, $i, 1 ) eq 'D') + { + $perm[ $i ] = pop @ints; + } + else + { + $perm[ $i ] = shift @ints; + } + } + + $perm[ $len ] = shift @ints; + + return \@perm; +} + +#------------------------------------------------------------------------------- +sub parse_command_line +#------------------------------------------------------------------------------- +{ + my $str = $ARGV[ 0 ]; + + if ($str =~ / ^ $RE{num}{int} $ /x && $str > 0) + { + $str = generate_string( $str ); + } + else + { + $str =~ / ^ [DI]+ $ /x + or error( qq[Invalid string argument "$str"] ); + } + + return $str; +} + +#------------------------------------------------------------------------------- +sub generate_string +#------------------------------------------------------------------------------- +{ + my ($len) = @_; + my $str = ''; + + for (1 .. $len) + { + my $char = int rand( 2 ) ? 'D' : 'I'; + + $str .= $char; + } + + return $str; +} + +#------------------------------------------------------------------------------- +sub verify +#------------------------------------------------------------------------------- +{ + my ($str, $perm) = @_; + + for my $i (0 .. length( $str ) - 1) + { + my $first = $perm->[ $i ]; + my $second = $perm->[ $i + 1 ]; + + if (substr( $str, $i, 1 ) eq 'D') + { + return 0 unless $first > $second; + } + else # 'I' + { + return 0 unless $first < $second; + } + } + + return 1; +} + +#------------------------------------------------------------------------------- +sub run_tests +#------------------------------------------------------------------------------- +{ + print "Running the test suite\n"; + + while (my $line = ) + { + chomp $line; + + my ($test_name, $str, $expected_str) = split / \| /x, $line; + + for ($test_name, $str, $expected_str) + { + s/ ^ \s+ //x; + s/ \s+ $ //x; + } + + my $permutation = DI_string_match( $str ); + my @expected = split / \s+ /x, $expected_str; + + is_deeply $permutation, \@expected, "$test_name: expected"; + + ok verify( $str, $permutation ), "$test_name: verified" if $DEBUG; + } + + done_testing; +} + +#------------------------------------------------------------------------------- +sub error +#------------------------------------------------------------------------------- +{ + my ($message) = @_; + + die "ERROR: $message\n$USAGE"; +} + +################################################################################ + +__DATA__ +Example 1 |IDID |0 4 1 3 2 +Example 2 |III |0 1 2 3 +Example 3 |DDI |3 2 0 1 +Long str 1|IIIDDIDIDIDIIIIDIII|0 1 2 19 18 3 17 4 16 5 15 6 7 8 9 14 10 11 12 13 +All Ds |DDDDDDD |7 6 5 4 3 2 1 0 +Single D |D |1 0 +Long str 2|DIDIIDDIIIIIIDDDDII|19 0 18 1 2 17 16 3 4 5 6 7 8 15 14 13 12 9 10 11 +Alternates|IDIDIDIDIDIDIDIDIDI|0 19 1 18 2 17 3 16 4 15 5 14 6 13 7 12 8 11 9 10 diff --git a/challenge-249/athanasius/raku/ch-1.raku b/challenge-249/athanasius/raku/ch-1.raku new file mode 100644 index 0000000000..9ce0cdc922 --- /dev/null +++ b/challenge-249/athanasius/raku/ch-1.raku @@ -0,0 +1,196 @@ +use v6d; + +################################################################################ +=begin comment + +Perl Weekly Challenge 249 +========================= + +TASK #1 +------- +*Equal Pairs* + +Submitted by: Mohammad S Anwar + +You are given an array of integers with even number of elements. + +Write a script to divide the given array into equal pairs such that: + + a) Each element belongs to exactly one pair. + b) The elements present in a pair are equal. + +Example 1 + + Input: @ints = (3, 2, 3, 2, 2, 2) + Output: (2, 2), (3, 3), (2, 2) + + There are 6 elements in @ints. + They should be divided into 6 / 2 = 3 pairs. + @ints is divided into the pairs (2, 2), (3, 3), and (2, 2) satisfying all the + conditions. + +Example 2 + + Input: @ints = (1, 2, 3, 4) + Output: () + + There is no way to divide @ints 2 pairs such that the pairs satisfy every + condition. + +=end comment +################################################################################ + +#--------------------------------------# +# Copyright © 2023 PerlMonk Athanasius # +#--------------------------------------# + +#=============================================================================== +=begin comment + +Interface +--------- +1. If no command-line arguments are given, the test suite is run. Otherwise: +2. If the first command-line argument is negative, it must be preceded by "--" + to distinguish it from a command-line switch. + +Algorithm +--------- + + +=end comment +#=============================================================================== + +use Test; + +subset IntPair of List where (Int, Int); + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + "\nChallenge 249, Task #1: Equal Pairs (Raku)\n".put; +} + +#=============================================================================== +multi sub MAIN +( + #| A non-empty, even-numbered list of integers + + *@ints where { .elems > 0 && .elems %% 2 && .all ~~ Int:D } +) +#=============================================================================== +{ + "Input: \@ints = (%s)\n".printf: @ints.join: ', '; + + my IntPair @pairs = find-equal-pairs( @ints ); + + "Output: %s\n".printf: + @pairs ?? @pairs.map( { '(' ~ .join( ', ' ) ~ ')' } ).join: ', ' + !! '()'; +} + +#=============================================================================== +multi sub MAIN() # No input: run the test suite +#=============================================================================== +{ + run-tests(); +} + +#------------------------------------------------------------------------------- +sub find-equal-pairs +( + List:D[Int:D] $ints where { .elems %% 2 } # Even-numbered list of integers +--> List:D[IntPair:D] # Equal pairs (may be empty) +) +#------------------------------------------------------------------------------- +{ + my IntPair @pairs; + + # Change from IntStr to Int, then sort (numerical ascending) + + my Int @sorted = $ints.map( { .Int } ).sort; + + while @sorted + { + my IntPair $pair = [ @sorted.shift, @sorted.shift ]; + + if $pair[ 0 ] == $pair[ 1 ] + { + @pairs.push: $pair; + } + else # No solution is possible + { + @pairs = (); + last; + } + } + + return @pairs; +} + +#------------------------------------------------------------------------------- +sub run-tests() +#------------------------------------------------------------------------------- +{ + 'Running the test suite'.put; + + for test-data.lines -> Str $line + { + my Str ($test-name, $ints-str, @exp-pair-strs) = $line.split: / \| /; + + for $test-name, $ints-str, |@exp-pair-strs + { + s/ ^ \s+ //; + s/ \s+ $ //; + } + + my Int @ints = $ints-str.split( / \s+ / ).map: { .Int }; + my IntPair @pairs = find-equal-pairs( @ints ); + my IntPair @expected; + + for @exp-pair-strs + { + @expected.push: [ .split( / \s+ / ).map: { .Int } ] if $_; + } + + is-deeply @pairs, @expected, $test-name; + } + + done-testing; +} + +#------------------------------------------------------------------------------- +sub error( Str:D $message ) +#------------------------------------------------------------------------------- +{ + "ERROR: $message".put; + + USAGE(); + + exit 0; +} + +#------------------------------------------------------------------------------- +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 | 3 2 3 2 2 2 | 2 2| 2 2|3 3 + Example 2 | 1 2 3 4 | + Negatives 1|-1 1 3 -1 3 1 -1 -1 |-1 -1|-1 -1|1 1|3 3 + Negatives 2|-1 1 3 -1 3 1 -1 -1 0 1| + END +} + +################################################################################ diff --git a/challenge-249/athanasius/raku/ch-2.raku b/challenge-249/athanasius/raku/ch-2.raku new file mode 100644 index 0000000000..ffc2b2b93c --- /dev/null +++ b/challenge-249/athanasius/raku/ch-2.raku @@ -0,0 +1,274 @@ +use v6d; + +################################################################################ +=begin comment + +Perl Weekly Challenge 249 +========================= + +TASK #2 +------- +*DI String Match* + +Submitted by: Mohammad S Anwar + +You are given a string s, consisting of only the characters "D" and "I". + +Find a permutation of the integers [0 .. length(s)] such that for each character +s[i] in the string: + + s[i] == 'I' ⇒ perm[i] < perm[i + 1] + s[i] == 'D' ⇒ perm[i] > perm[i + 1] + +Example 1 + + Input: $str = "IDID" + Output: (0, 4, 1, 3, 2) + +Example 2 + + Input: $str = "III" + Output: (0, 1, 2, 3) + +Example 3 + + Input: $str = "DDI" + Output: (3, 2, 0, 1) + +=end comment +################################################################################ + +#--------------------------------------# +# Copyright © 2023 PerlMonk Athanasius # +#--------------------------------------# + +#=============================================================================== +=begin comment + +Interface +--------- +1. Command-line arguments: + i. None: the test suite is run. + ii. A non-empty string s consisting of only the characters "D" and/or "I": + a solution is found for s. + iii. A single integer n > 0: an input string s of n characters is randomly + generated, then a solution is found for s. + +2. If DEBUG is set to True, each solution is checked to verify that it satisfies + the given criteria. + +Algorithm +--------- +Let s be the input string + t be the tuple [0, 1, ..., length(s)] + p be a permutation of t which satisfies the two given criteria for s. + +1. Partition t into x, y, z where + -- x is a tuple of the smallest k elements of t where k is the count of "I" + characters in s + -- z is a tuple of the largest m elements of t where m is the count of "D" + characters in s + -- y is the only element of t not already included in x or z +2. Create an empty solution tuple p +3. FOR i = 0 to length(s) - 1 + IF s[i] = "I" THEN + p[i] := the smallest remaining element of x + Remove that element from x + ELSE + p[i] := the largest remaining element of z + Remove that element from z + ENDIF + ENDFOR +4. p[length(s)] := y +5. Return p + +=end comment +#=============================================================================== + +use Test; + +my Bool constant DEBUG = True; + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + "\nChallenge 249, Task #2: DI String Match (Raku)\n".put; +} + +#=============================================================================== +multi sub MAIN +( + Int:D $len where * > 0 #= Integer > 0: length of string to be generated +) +#=============================================================================== +{ + my Str $str = ''; + + for 1 .. $len + { + my $char = (^2).pick ?? 'D' !! 'I'; + + $str ~= $char; + } + + qq[Input: \$str = "$str"].put; + + my UInt @permutation = DI-string-match( $str ); + + if DEBUG && !verify( $str, @permutation ) + { + die qq[Permutation (%s) for "%s" failed verification].sprintf: + @permutation.join: ', ', $str; + } + + "Output: (%s)\n".printf: @permutation.join: ', '; +} + +#=============================================================================== +multi sub MAIN +( + #| Non-empty string consisting of only the characters "D" and "I" + + Str:D $str where / ^ <[DI]>+ $ / +) +#=============================================================================== +{ + qq[Input: \$str = "$str"].put; + + my UInt @permutation = DI-string-match( $str ); + + if DEBUG && !verify( $str, @permutation ) + { + die qq[Permutation (%s) for "%s" failed verification].sprintf: + @permutation.join: ', ', $str; + } + + "Output: (%s)\n".printf: @permutation.join: ', '; +} + +#=============================================================================== +multi sub MAIN() # No input: run the test suite +#=============================================================================== +{ + run-tests(); +} + +#------------------------------------------------------------------------------- +sub DI-string-match( Str:D $str where / ^ <[DI]>+ $ / --> List:D[UInt:D] ) +#------------------------------------------------------------------------------- +{ + my UInt @perm; + my UInt $len = $str.chars; + my UInt @ints = 0 .. $len; + + for 0 .. $len - 1 -> UInt $i + { + if $str.substr( $i, 1 ) eq 'D' + { + @perm[ $i ] = @ints.pop; + } + else + { + @perm[ $i ] = @ints.shift; + } + } + + @perm[ $len ] = @ints.shift; + + return @perm; +} + +#------------------------------------------------------------------------------- +sub verify +( + Str:D $str where / ^ <[DI]>+ $ /, + List:D[UInt:D] $perm where $perm.elems == $str.chars + 1 +--> Bool:D +) +#------------------------------------------------------------------------------- +{ + for 0 .. $str.chars - 1 -> UInt $i + { + my $first = $perm[ $i ]; + my $second = $perm[ $i + 1 ]; + + if $str.substr( $i, 1 ) eq 'D' + { + return False unless $first > $second; + } + else # 'I' + { + return False unless $first < $second; + } + } + + return True; +} + +#------------------------------------------------------------------------------- +sub run-tests() +#------------------------------------------------------------------------------- +{ + 'Running the test suite'.put; + + for test-data.lines -> Str $line + { + my Str ($test-name, $str, $expected-str) = $line.split: / \| /; + + for $test-name, $str, $expected-str + { + s/ ^ \s+ //; + s/ \s+ $ //; + } + + my UInt @permutation = DI-string-match( $str ); + my UInt @expected = $expected-str.split( / \s+ / ).map: { .Int }; + + is-deeply @permutation, @expected, "$test-name: expected"; + + ok verify( $str, @permutation ), "$test-name: verified" if DEBUG; + } + + done-testing; +} + +#------------------------------------------------------------------------------- +sub error( Str:D $message ) +#------------------------------------------------------------------------------- +{ + "ERROR: $message".put; + + USAGE(); + + exit 0; +} + +#------------------------------------------------------------------------------- +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 |IDID |0 4 1 3 2 +Example 2 |III |0 1 2 3 +Example 3 |DDI |3 2 0 1 +Long str 1|IIIDDIDIDIDIIIIDIII|0 1 2 19 18 3 17 4 16 5 15 6 7 8 9 14 10 11 12 13 +All Ds |DDDDDDD |7 6 5 4 3 2 1 0 +Single D |D |1 0 +Long str 2|DIDIIDDIIIIIIDDDDII|19 0 18 1 2 17 16 3 4 5 6 7 8 15 14 13 12 9 10 11 +Alternates|IDIDIDIDIDIDIDIDIDI|0 19 1 18 2 17 3 16 4 15 5 14 6 13 7 12 8 11 9 10 +END +} + +################################################################################ -- cgit