From 4b0c8227c579c1663c339846a177b7567c923f8a Mon Sep 17 00:00:00 2001 From: PerlMonk-Athanasius Date: Tue, 23 Jul 2024 23:00:55 +1000 Subject: Perl & Raku solutions to Tasks 1 & 2 for Week 279 --- challenge-279/athanasius/perl/ch-1.pl | 219 ++++++++++++++++++++++++++++ challenge-279/athanasius/perl/ch-2.pl | 246 ++++++++++++++++++++++++++++++++ challenge-279/athanasius/raku/ch-1.raku | 218 ++++++++++++++++++++++++++++ challenge-279/athanasius/raku/ch-2.raku | 244 +++++++++++++++++++++++++++++++ 4 files changed, 927 insertions(+) create mode 100644 challenge-279/athanasius/perl/ch-1.pl create mode 100644 challenge-279/athanasius/perl/ch-2.pl create mode 100644 challenge-279/athanasius/raku/ch-1.raku create mode 100644 challenge-279/athanasius/raku/ch-2.raku diff --git a/challenge-279/athanasius/perl/ch-1.pl b/challenge-279/athanasius/perl/ch-1.pl new file mode 100644 index 0000000000..f3a6fdf715 --- /dev/null +++ b/challenge-279/athanasius/perl/ch-1.pl @@ -0,0 +1,219 @@ +#!perl + +################################################################################ +=comment + +Perl Weekly Challenge 279 +========================= + +TASK #1 +------- +*Sort Letters* + +Submitted by: Mohammad Sajid Anwar + +You are given two arrays, @letters and @weights. + +Write a script to sort the given array @letters based on the @weights. + +Example 1 + + Input: @letters = ('R', 'E', 'P', 'L') + @weights = (3, 2, 1, 4) + Output: PERL + +Example 2 + + Input: @letters = ('A', 'U', 'R', 'K') + @weights = (2, 4, 1, 3) + Output: RAKU + +Example 3 + + Input: @letters = ('O', 'H', 'Y', 'N', 'P', 'T') + @weights = (5, 4, 2, 6, 1, 3) + Output: PYTHON + +=cut +################################################################################ + +#--------------------------------------# +# Copyright © 2024 PerlMonk Athanasius # +#--------------------------------------# + +#=============================================================================== +=comment + +Interface +--------- +1. If no command-line arguments are given, the test suite is run. Otherwise: +2. The input lists are entered as two strings on the command-line. The first + string contains only letters; the second string contains positive (non-zero) + integers separated by whitespace. + +=cut +#=============================================================================== + +use v5.32; # Enables strictures +use warnings; +use Const::Fast; +use Regexp::Common qw( number ); +use Test::More; + +const my $USAGE => < + perl $0 + + A string of letters + A string of whitespace-separated positive integers +END + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + $| = 1; + print "\nChallenge 279, Task #1: Sort Letters (Perl)\n\n"; +} + +#=============================================================================== +MAIN: +#=============================================================================== +{ + my $argc = scalar @ARGV; + + if ($argc == 0) + { + run_tests(); + } + elsif ($argc == 2) + { + my $letters = parse_letters( $ARGV[ 0 ] ); + my $weights = parse_weights( $ARGV[ 1 ], scalar @$letters ); + + printf "Input: \@letters = (%s)\n", + join ', ', map { "'$_'" } @$letters; + + printf " \@weights = (%s)\n", join ', ', @$weights; + + my $sorted = sort_letters( $letters, $weights ); + + print "Output: $sorted\n"; + } + else + { + error( "Expected 0 or 2 command-line arguments, found $argc" ); + } +} + +#------------------------------------------------------------------------------- +sub sort_letters +#------------------------------------------------------------------------------- +{ + my ($letters, $weights) = @_; + my @sorted; + + for my $i (0 .. $#$letters) + { + $sorted[ $weights->[ $i ] - 1 ] = $letters->[ $i ]; + } + + return join '', @sorted; +} + +#------------------------------------------------------------------------------- +sub parse_letters +#------------------------------------------------------------------------------- +{ + my ($letters_str) = @_; + + my @chars = split //, $letters_str; + my @letters; + + for my $char (@chars) + { + $char =~ / ^ [A-Z] $ /ix or error( qq[Invalid letter "$char"] ); + + push @letters, $char; + } + + return \@letters; +} + +#------------------------------------------------------------------------------- +sub parse_weights +#------------------------------------------------------------------------------- +{ + my ($weights_str, $count) = @_; + + my @nums = split / \s+ /x, $weights_str; + my @weights; + + for my $weight (@nums) + { + $weight =~ / ^ $RE{num}{int} $ /x + or error( qq[Invalid weight "$weight"] ); + $weight > 0 or error( "Weight $weight is too small" ); + $weight <= $count or error( "Weight $weight is too large" ); + + push @weights, $weight; + } + + scalar @weights == $count or error( 'The number of weights does not ' . + 'match the number of letters' ); + my %dict; + ++$dict{ $_ } for @weights; + + for my $weight (keys %dict) + { + $dict{ $weight } > 1 and error( "Duplicate weight $weight" ); + } + + return \@weights; +} + +#------------------------------------------------------------------------------- +sub run_tests +#------------------------------------------------------------------------------- +{ + print "Running the test suite\n"; + + while (my $line = ) + { + chomp $line; + + my ($test_name, $letters_str, $weights_str, $expected) = + split / \| /x, $line; + + for ($test_name, $letters_str, $weights_str, $expected) + { + s/ ^ \s+ //x; + s/ \s+ $ //x; + } + + my $letters = parse_letters( $letters_str ); + my $weights = parse_weights( $weights_str, scalar @$letters ); + my $sorted = sort_letters ( $letters, $weights ); + + is $sorted, $expected, $test_name; + } + + done_testing; +} + +#------------------------------------------------------------------------------- +sub error +#------------------------------------------------------------------------------- +{ + my ($message) = @_; + + die "ERROR: $message\n$USAGE"; +} + +################################################################################ + +__DATA__ +Example 1|REPL |3 2 1 4 |PERL +Example 2|AURK |2 4 1 3 |RAKU +Example 3|OHYNPT|5 4 2 6 1 3|PYTHON diff --git a/challenge-279/athanasius/perl/ch-2.pl b/challenge-279/athanasius/perl/ch-2.pl new file mode 100644 index 0000000000..ed76cd7c1e --- /dev/null +++ b/challenge-279/athanasius/perl/ch-2.pl @@ -0,0 +1,246 @@ +#!perl + +################################################################################ +=comment + +Perl Weekly Challenge 279 +========================= + +TASK #2 +------- +*Split String* + +Submitted by: Mohammad Sajid Anwar + +You are given a string, $str. + +Write a script to split the given string into two containing exactly same number +of vowels and return true if you can otherwise false. + +Example 1 + + Input: $str = "perl" + Output: false + +Example 2 + + Input: $str = "book" + Output: true + + Two possible strings "bo" and "ok" containing exactly one vowel each. + +Example 3 + + Input: $str = "good morning" + Output: true + + Two possible strings "good " and "morning" containing two vowels each or + "good m" and "orning" containing two vowels each. + +=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 (i.e., one possible solution) is wanted, + "--verbose" is entered as a command-line flag. +3. A single string is given as the last entry on the command-line. + +=cut +#=============================================================================== + +use v5.36; # Enables strictures and warnings +no warnings qw( experimental::builtin ); +use builtin qw( true false floor ceil trim ); +use Const::Fast; +use Getopt::Long; +use Test::More; + +const my $NON_VOWEL => qr/ [^AEIOU] /ix; +const my $VOWEL => qr/ [AEIOU] /ix; +const my $USAGE => < + perl $0 + + A string + --verbose Explain the output? [default: False] +END + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + $| = 1; + print "\nChallenge 279, Task #2: Split String (Perl)\n\n"; +} + +#=============================================================================== +MAIN: +#=============================================================================== +{ + if (scalar @ARGV == 0) + { + run_tests(); + } + else + { + my ($str, $verbose) = parse_command_line(); + + print qq[Input: \$str = "$str"\n]; + + my ($can_split, $lhs, $rhs, $vowels) = split_string( $str, $verbose ); + + printf "Output: %s\n", $can_split ? 'true' : 'false'; + + if ($verbose && $can_split) + { + print "\nThis is a solution:\n"; + printf qq["%s" and "%s" each contain %d vowel%s\n], + $lhs, $rhs, $vowels, $vowels == 1 ? '' : 's'; + } + } +} + +#------------------------------------------------------------------------------- +sub split_string +#------------------------------------------------------------------------------- +{ + my ($str, $verbose) = @_; + my $can_split = false; + my $lhs = ''; + my $rhs = ''; + my $vowel_str = $str =~ s/ $NON_VOWEL //grx; + my $n_vowels = length $vowel_str; + my $target = 0; + + if ($n_vowels % 2 == 0) + { + $can_split = true; + + if ($verbose) + { + if ($n_vowels == 0) + { + my $i = ceil( length( $str ) / 2 ); + + $lhs = substr $str, 0, $i; + $rhs = substr $str, $i; + } + else + { + ($lhs, $rhs, $target) = perform_split( $str, $n_vowels ); + } + } + } + + return $can_split, $lhs, $rhs, $target; +} + +#------------------------------------------------------------------------------- +sub perform_split +#------------------------------------------------------------------------------- +{ + my ($str, $n_vowels) = @_; + my $target = floor( $n_vowels / 2 ); + my @chars = split //, $str; + my $lhs = ''; + my $rhs = ''; + my $v = 0; + + for my $i (0 .. $#chars) + { + if ($chars[ $i ] =~ / $VOWEL /x && ++$v == $target) + { + $lhs = join '', @chars[ 0 .. $i ]; + $rhs = join '', @chars[ $i + 1 .. $#chars ]; + last; + } + } + + $rhs =~ / ^ ( $NON_VOWEL* ) /x; + my $w = ceil( length( $1 ) / 2 ); + $lhs .= substr $rhs, 0, $w; + substr $rhs, 0, $w, ''; + + return $lhs, $rhs, $target; +} + +#------------------------------------------------------------------------------- +sub parse_command_line +#------------------------------------------------------------------------------- +{ + my $verbose = 0; + + GetOptions + ( + verbose => \$verbose + + ) or error( 'Error in command line arguments' ); + + my $argc = scalar @ARGV; + + $argc == 1 or error( "Expected 1 command-line argument, found $argc" ); + + return $ARGV[ 0 ], $verbose; +} + +#------------------------------------------------------------------------------- +sub run_tests +#------------------------------------------------------------------------------- +{ + print "Running the test suite\n"; + + while (my $line = ) + { + chomp $line; + + my ($test_name, $str, $exp_can, $exp_lhs, $exp_rhs) = split /\|/, $line; + + $_ = trim $_ for $test_name, $str, $exp_can, $exp_lhs, $exp_rhs; + s/_/ /g for $str, $exp_lhs, $exp_rhs; + + my ($can_split, $lhs, $rhs) = split_string( $str, true ); + + is $can_split, $exp_can, $test_name; + + if ($can_split) + { + is $lhs, $exp_lhs, $test_name; + is $rhs, $exp_rhs, $test_name; + } + } + + done_testing; +} + +#------------------------------------------------------------------------------- +sub error +#------------------------------------------------------------------------------- +{ + my ($message) = @_; + + die "ERROR: $message\n$USAGE"; +} + +################################################################################ + +# An initial or trailing space in the input and output strings is represented by +# an underscore (e.g., "good_ " represents "good ") + +__DATA__ +Example 1 |perl | | | +Example 2 |book |1|bo |ok +Example 3 |good morning|1|good_ |morning +No vowels 1|BcdfghJklmnp|1|Bcdfgh|Jklmnp +No vowels 2|BcdfghJklmn |1|Bcdfgh|Jklmn +All vowels |aeiouAEIOU |1|aeiou |AEIOU +Empty | |1| | diff --git a/challenge-279/athanasius/raku/ch-1.raku b/challenge-279/athanasius/raku/ch-1.raku new file mode 100644 index 0000000000..29c75b8fb5 --- /dev/null +++ b/challenge-279/athanasius/raku/ch-1.raku @@ -0,0 +1,218 @@ +use v6d; + +################################################################################ +=begin comment + +Perl Weekly Challenge 279 +========================= + +TASK #1 +------- +*Sort Letters* + +Submitted by: Mohammad Sajid Anwar + +You are given two arrays, @letters and @weights. + +Write a script to sort the given array @letters based on the @weights. + +Example 1 + + Input: @letters = ('R', 'E', 'P', 'L') + @weights = (3, 2, 1, 4) + Output: PERL + +Example 2 + + Input: @letters = ('A', 'U', 'R', 'K') + @weights = (2, 4, 1, 3) + Output: RAKU + +Example 3 + + Input: @letters = ('O', 'H', 'Y', 'N', 'P', 'T') + @weights = (5, 4, 2, 6, 1, 3) + Output: PYTHON + +=end comment +################################################################################ + +#--------------------------------------# +# Copyright © 2024 PerlMonk Athanasius # +#--------------------------------------# + +#=============================================================================== +=begin comment + +Interface +--------- +1. If no command-line arguments are given, the test suite is run. Otherwise: +2. The input lists are entered as two strings on the command-line. The first + string contains only letters; the second string contains positive (non-zero) + integers separated by whitespace. + +=end comment +#=============================================================================== + +use Test; + +subset Letter of Str where m:i/ ^ <[ A .. Z ]> $ /; +subset Pos of Int where * > 0; + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + "\nChallenge 279, Task #1: Sort Letters (Raku)\n".put; +} + +#=============================================================================== +multi sub MAIN +( + Str:D $letters, #= A string of letters + Str:D $weights #= A string of whitespace-separated positive integers +) +#=============================================================================== +{ + my Letter @letters = parse-letters( $letters ); + my Pos @weights = parse-weights( $weights, @letters.elems ); + + "Input: \@letters = (%s)\n".printf: @letters.map( { "'$_'" } ).join: ', '; + " \@weights = (%s)\n".printf: @weights.join: ', '; + + my Str $sorted = sort-letters( @letters, @weights ); + + "Output: $sorted".put; +} + +#=============================================================================== +multi sub MAIN() # No input: run the test suite +#=============================================================================== +{ + run-tests(); +} + +#------------------------------------------------------------------------------- +sub sort-letters( List:D[Letter:D] $letters, List:D[Pos:D] $weights --> Str:D ) +#------------------------------------------------------------------------------- +{ + my Letter @sorted; + + for 0 .. $letters.end -> UInt $i + { + @sorted[ $weights[ $i ] - 1 ] = $letters[ $i ]; + } + + return @sorted.join; +} + +#------------------------------------------------------------------------------- +sub parse-letters( Str:D $letters --> List:D[Letter:D] ) +#------------------------------------------------------------------------------- +{ + my Str @chars = $letters.split: '', :skip-empty; + my Letter @letters; + + for @chars -> Str $char + { + $char ~~ Letter or error( qq[Invalid letter "$char"] ); + + @letters.push: $char; + } + + return @letters; +} + +#------------------------------------------------------------------------------- +sub parse-weights( Str:D $weights, UInt:D $count --> List:D[Pos:D] ) +#------------------------------------------------------------------------------- +{ + my Str @nums = $weights.split: / \s+ /, :skip-empty; + my Pos @weights; + + for @nums -> Str $num + { + +$num ~~ Pos or error( qq[Invalid weight "$num"] ); + + my Pos $weight = +$num; + + $weight <= $count or error( "Weight $weight is too large" ); + + @weights.push: $weight; + } + + @weights.elems == $count or error( 'The number of weights does not ' ~ + 'match the number of letters' ); + + my UInt %dict{Pos}; + ++%dict{ $_ } for @weights; + + for %dict.keys -> Pos $weight + { + %dict{ $weight } > 1 and error( "Duplicate weight $weight" ); + } + + return @weights; +} + +#------------------------------------------------------------------------------- +sub run-tests() +#------------------------------------------------------------------------------- +{ + 'Running the test suite'.put; + + for test-data.lines -> Str $line + { + my Str ($test-name, $letters, $weights, $expected) = + $line.split: / \| /; + + for $test-name, $letters, $weights, $expected + { + s/ ^ \s+ //; + s/ \s+ $ //; + } + + my Letter @letters = parse-letters( $letters ); + my Pos @weights = parse-weights( $weights, @letters.elems ); + my Str $sorted = sort-letters\( @letters, @weights ); + + is $sorted, $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|REPL |3 2 1 4 |PERL + Example 2|AURK |2 4 1 3 |RAKU + Example 3|OHYNPT|5 4 2 6 1 3|PYTHON + END +} + +################################################################################ diff --git a/challenge-279/athanasius/raku/ch-2.raku b/challenge-279/athanasius/raku/ch-2.raku new file mode 100644 index 0000000000..65f48b16cc --- /dev/null +++ b/challenge-279/athanasius/raku/ch-2.raku @@ -0,0 +1,244 @@ +use v6d; + +################################################################################ +=begin comment + +Perl Weekly Challenge 279 +========================= + +TASK #2 +------- +*Split String* + +Submitted by: Mohammad Sajid Anwar + +You are given a string, $str. + +Write a script to split the given string into two containing exactly same number +of vowels and return true if you can otherwise false. + +Example 1 + + Input: $str = "perl" + Output: false + +Example 2 + + Input: $str = "book" + Output: true + + Two possible strings "bo" and "ok" containing exactly one vowel each. + +Example 3 + + Input: $str = "good morning" + Output: true + + Two possible strings "good " and "morning" containing two vowels each or + "good m" and "orning" containing two vowels each. + +=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 (i.e., one possible solution) is wanted, + "--verbose" is entered as a command-line flag. +3. A single string is given as the last entry on the command-line. + +=end comment +#=============================================================================== + +use Test; + +subset Result of List where (Bool, Str, Str, UInt); + +my regex Vowel { :i <+[ A E I O U ]> }; +my regex NonVowel { :i <-[ A E I O U ]> }; + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + "\nChallenge 279, Task #2: Split String (Raku)\n".put; +} + +#=============================================================================== +multi sub MAIN +( + Str:D $str, #= A string + Bool:D :$verbose = False #= Explain the output? +) +#=============================================================================== +{ + qq[Input: \$str = "$str"].put; + + my (Bool $can-split, Str $lhs, Str $rhs, UInt $vowels) = + split-string( $str, $verbose ); + + "Output: %s\n".printf: $can-split ?? 'true' !! 'false'; + + if $verbose && $can-split + { + "\nThis is a solution:".put; + qq["%s" and "%s" each contain %d vowel%s\n].printf: + $lhs, $rhs, $vowels, $vowels == 1 ?? '' !! 's'; + } +} + +#=============================================================================== +multi sub MAIN() # No input: run the test suite +#=============================================================================== +{ + run-tests(); +} + +#------------------------------------------------------------------------------- +sub split-string( Str:D $str, Bool:D $verbose = True --> Result:D ) +#------------------------------------------------------------------------------- +{ + my Bool $can-split = False; + my Str $lhs = ''; + my Str $rhs = ''; + my Str $vowel-str = S:g/ // with $str; + my UInt $n-vowels = $vowel-str.chars; + my UInt $target = 0; + + if $n-vowels %% 2 + { + $can-split = True; + + if $verbose + { + if $n-vowels == 0 + { + my UInt $i = ($str.chars / 2).ceiling; + + $lhs = $str.substr: 0 .. $i - 1; + $rhs = $str.substr: $i .. *; + } + else + { + ($can-split, $lhs, $rhs, $target) = + perform-split( $str, $n-vowels ); + } + } + } + + return $can-split, $lhs, $rhs, $target; +} + +#------------------------------------------------------------------------------- +sub perform-split( Str:D $str, UInt:D $n-vowels --> Result:D ) +#------------------------------------------------------------------------------- +{ + my UInt $target = ($n-vowels / 2).floor; + my Str @chars = $str.split: '', :skip-empty; + my Str $lhs = ''; + my Str $rhs = ''; + my UInt $v = 0; + + for 0 .. @chars.end -> UInt $i + { + if @chars[ $i ] ~~ / / && ++$v == $target + { + $lhs = @chars[ 0 .. $i ].join; + $rhs = @chars[ $i + 1 .. * ].join; + last; + } + } + + $rhs ~~ / ^ ( * ) /; + + my UInt $w = ((~$0).chars / 2).ceiling; + + $lhs ~= $rhs.substr: 0, $w; + + $rhs.substr-rw( 0, $w ) = ''; + + return True, $lhs, $rhs, $target; +} + +#------------------------------------------------------------------------------- +sub run-tests() +#------------------------------------------------------------------------------- +{ + 'Running the test suite'.put; + + for test-data.lines -> Str $line + { + my Str ($test-name, $str, $exp-split-str, $exp-lhs, $exp-rhs) = + $line.split: / \| /; + + for $test-name, $str, $exp-split-str, $exp-lhs, $exp-rhs + { + s/ ^ \s+ //; + s/ \s+ $ //; + } + + s:g/_/ / for $str, $exp-lhs, $exp-rhs; + + my (Bool $can-split, Str $lhs, Str $rhs) = split-string( $str ); + my Bool $exp-split = $exp-split-str eq 'true'; + + is $can-split, $exp-split, $test-name; + + if $can-split + { + is $lhs, $exp-lhs, $test-name; + is $rhs, $exp-rhs, $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 ) +#------------------------------------------------------------------------------- +{ + # An initial or trailing space in the input and output strings is represent- + # ed by an underscore (e.g., "good_ " represents "good ") + + return q:to/END/; + Example 1 |perl |false| | + Example 2 |book |true |bo |ok + Example 3 |good morning|true |good_ |morning + No vowels 1|BcdfghJklmnp|true |Bcdfgh|Jklmnp + No vowels 2|BcdfghJklmn |true |Bcdfgh|Jklmn + All vowels |aeiouAEIOU |true |aeiou |AEIOU + Empty | |true | | + END +} + +################################################################################ -- cgit