diff options
83 files changed, 11090 insertions, 1730 deletions
diff --git a/challenge-274/kjetillll/perl/ch-1.pl b/challenge-274/kjetillll/perl/ch-1.pl new file mode 100644 index 0000000000..2de85ac6f4 --- /dev/null +++ b/challenge-274/kjetillll/perl/ch-1.pl @@ -0,0 +1,30 @@ +use strict; use warnings; + +sub f { + my $end = ''; + shift() + =~ s{ (\S) (\S*) } + { + my( $first, $rest ) = ($1,$2); + $end .= 'a'; + $first =~ /[aeiou]/i + ? $first . $rest . 'ma' . $end + : $rest . $first . 'ma' . $end + }exgr +} + + +use Test::More tests => 3; +is f( $$_{input} ), $$_{output} for +{ + input => 'I love Perl', + output => 'Imaa ovelmaaa erlPmaaaa' +}, +{ + input => 'Perl and Raku are friends', + output => 'erlPmaa andmaaa akuRmaaaa aremaaaaa riendsfmaaaaaa' +}, +{ + input => 'The Weekly Challenge', + output => 'heTmaa eeklyWmaaa hallengeCmaaaa' +} diff --git a/challenge-274/kjetillll/perl/ch-2.pl b/challenge-274/kjetillll/perl/ch-2.pl new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/challenge-274/kjetillll/perl/ch-2.pl 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 => <<END; +Usage: + perl $0 <letters> <weights> + perl $0 + + <letters> A string of letters + <weights> 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 = <DATA>) + { + 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 => <<END; +Usage: + perl $0 [--verbose] <str> + perl $0 + + <str> 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 |