diff options
| -rw-r--r-- | challenge-265/athanasius/perl/ch-1.pl | 175 | ||||
| -rw-r--r-- | challenge-265/athanasius/perl/ch-2.pl | 237 | ||||
| -rw-r--r-- | challenge-265/athanasius/raku/ch-1.raku | 170 | ||||
| -rw-r--r-- | challenge-265/athanasius/raku/ch-2.raku | 212 |
4 files changed, 794 insertions, 0 deletions
diff --git a/challenge-265/athanasius/perl/ch-1.pl b/challenge-265/athanasius/perl/ch-1.pl new file mode 100644 index 0000000000..da575aee89 --- /dev/null +++ b/challenge-265/athanasius/perl/ch-1.pl @@ -0,0 +1,175 @@ +#!perl + +################################################################################ +=comment + +Perl Weekly Challenge 265 +========================= + +TASK #1 +------- +*33% Appearance* + +Submitted by: Mohammad Sajid Anwar + +You are given an array of integers, @ints. + +Write a script to find an integer in the given array that appeared 33% or more. +If more than one found, return the smallest. If none found then return undef. + +Example 1 + + Input: @ints = (1,2,3,3,3,3,4,2) + Output: 3 + + 1 appeared 1 times. + 2 appeared 2 times. + 3 appeared 4 times. + + 3 appeared 50% (>33%) in the given array. + +Example 2 + + Input: @ints = (1,1) + Output: 1 + + 1 appeared 2 times. + + 1 appeared 100% (>33%) in the given array. + +Example 3 + + Input: @ints = (1,2,3) + Output: 1 + + 1 appeared 1 times. + 2 appeared 1 times. + 3 appeared 1 times. + + Since all three appeared 33.3% (>33%) in the given array. + We pick the smallest of all. + +=cut +################################################################################ + +#--------------------------------------# +# Copyright © 2024 PerlMonk Athanasius # +#--------------------------------------# + +#=============================================================================== +=comment + +Interface +--------- +1. If no command-line arguments are given, the test suite is run. Otherwise: +2. A list of one or more integers is given on the command-line. + +=cut +#=============================================================================== + +use v5.32.1; # Enables strictures +use warnings; +use Const::Fast; +use List::Util qw( min ); +use POSIX qw( ceil ); +use Regexp::Common qw( number ); +use Test::More; + +const my $THRESHOLD => 0.33; +const my $USAGE => <<END; +Usage: + perl $0 [<ints> ...] + perl $0 + + [<ints> ...] A non-empty list of integers +END + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + $| = 1; + print "\nChallenge 265, Task #1: 33% Appearance (Perl)\n\n"; +} + +#=============================================================================== +MAIN: +#=============================================================================== +{ + if (scalar @ARGV == 0) + { + run_tests(); + } + else + { + my @ints = @ARGV; + + / ^ $RE{num}{int} $ /x or error( qq["$_" is not a valid integer] ) + for @ints; + + printf "Input: \@ints = (%s)\n", join ',', @ints; + + my $solution = solve( \@ints ); + + printf "Output: %s\n", defined $solution ? $solution : 'undef (= none)'; + } +} + +#------------------------------------------------------------------------------- +sub solve +#------------------------------------------------------------------------------- +{ + my ($ints) = @_; + my $target = ceil( scalar( @$ints ) * $THRESHOLD ); + my %count; + ++$count{ $_ } for @$ints; + my @candidates = grep { $count{ $_ } >= $target } keys %count; + + return scalar @candidates > 0 ? min( @candidates ) : undef; +} + +#------------------------------------------------------------------------------- +sub run_tests +#------------------------------------------------------------------------------- +{ + print "Running the test suite\n"; + + while (my $line = <DATA>) + { + chomp $line; + + my ($test_name, $ints_str, $expected_str) = split / \| /x, $line; + + for ($test_name, $ints_str, $expected_str) + { + s/ ^ \s+ //x; + s/ \s+ $ //x; + } + + my @ints = split / \s+ /x, $ints_str; + my $solution = solve( \@ints ); + my $expected = length $expected_str > 0 ? $expected_str : undef; + + is $solution, $expected, $test_name; + } + + done_testing; +} + +#------------------------------------------------------------------------------- +sub error +#------------------------------------------------------------------------------- +{ + my ($message) = @_; + + die "ERROR: $message\n$USAGE"; +} + +################################################################################ + +__DATA__ +Example 1| 1 2 3 3 3 3 4 2| 3 +Example 2| 1 1 | 1 +Example 3| 1 2 3 | 1 +None | 1 2 3 4 | +Negatives|-1 0 -2 1 -2 -1 |-2 diff --git a/challenge-265/athanasius/perl/ch-2.pl b/challenge-265/athanasius/perl/ch-2.pl new file mode 100644 index 0000000000..f4624c8ed4 --- /dev/null +++ b/challenge-265/athanasius/perl/ch-2.pl @@ -0,0 +1,237 @@ +#!perl + +################################################################################ +=comment + +Perl Weekly Challenge 265 +========================= + +TASK #2 +------- +*Completing Word* + +Submitted by: Mohammad Sajid Anwar + +You are given a string, $str containing alphnumeric characters and array of +strings (alphabetic characters only), @str. + +Write a script to find the shortest completing word. If none found return empty +string. + + A completing word is a word that contains all the letters in the given + string, ignoring space and number. If a letter appeared more than once in + the given string then it must appear the same number or more in the word. + +Example 1 + + Input: $str = 'aBc 11c' + @str = ('accbbb', 'abc', 'abbc') + Output: 'accbbb' + + The given string contains following, ignoring case and number: + a 1 times + b 1 times + c 2 times + + The only string in the given array that satisfies the condition is 'accbbb'. + +Example 2 + + Input: $str = 'Da2 abc' + @str = ('abcm', 'baacd', 'abaadc') + Output: 'baacd' + + The given string contains following, ignoring case and number: + a 2 times + b 1 times + c 1 times + d 1 times + + The are 2 strings in the given array that satisfies the condition: + 'baacd' and 'abaadc'. + + Shortest of the two is 'baacd' + +Example 3 + + Input: $str = 'JB 007' + @str = ('jj', 'bb', 'bjb') + Output: 'bjb' + + The given string contains following, ignoring case and number: + j 1 times + b 1 times + + The only string in the given array that satisfies the condition is 'bjb'. + +=cut +################################################################################ + +#--------------------------------------# +# Copyright © 2024 PerlMonk Athanasius # +#--------------------------------------# + +#=============================================================================== +=comment + +Interface +--------- +1. If no command-line arguments are given, the test suite is run. Otherwise: +2. The string $str is entered as a named argument on the command-line. +3. Strings of the list @str are entered as unnamed arguments on the command- + line. + +Assumptions +----------- +1. From the Examples, it appears that case is ignored when searching for a com- + pleting word. +2. If there are two or more shortest completing words, choose the first (lowest) + by ascending alphabetical order. + +=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 [--str=<Str>] [<strs> ...] + perl $0 + + --str=<Str> String of alphnumeric chars and/or whitespace + [<strs> ...] List of strings of alphabetic characters only +END + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + $| = 1; + print "\nChallenge 265, Task #2: Completing Word (Perl)\n\n"; +} + +#=============================================================================== +MAIN: +#=============================================================================== +{ + if (scalar @ARGV == 0) + { + run_tests(); + } + else + { + my ($str, $strs) = parse_command_line(); + + print "Input: \$str = '$str'\n"; + printf " \@strs = (%s)\n", join ', ', map { "'$_'" } @$strs; + + my $word = find_completing_word( $str, $strs ); + + print "Output: '$word'\n"; + } +} + +#------------------------------------------------------------------------------- +sub find_completing_word +#------------------------------------------------------------------------------- +{ + my ($str, $strings) = @_; + my %required; + + for my $char (split //, $str) + { + ++$required{ lc $char } if $char =~ / ^ [[:alpha:]] $ /x; + } + + my @candidates; + + L_STRINGS: for my $string (@$strings) + { + my %chars; + ++$chars{ lc() } for split //, $string; + + for my $key (keys %required) + { + next L_STRINGS unless exists $chars{ $key } && + $chars{ $key } >= $required{ $key }; + } + + push @candidates, $string; + } + + @candidates = sort { length $a <=> length $b || $a cmp $b } @candidates; + + return scalar @candidates > 0 ? $candidates[ 0 ] : ''; +} + +#------------------------------------------------------------------------------- +sub parse_command_line +#------------------------------------------------------------------------------- +{ + my ($str); + + GetOptions + ( + 'str=s' => \$str, + ) or error( 'Invalid command-line arguments' ); + + $str // error( 'Missing $str' ); + $str =~ / ^ [A-Za-z0-9\s]* $ /x + or error( qq["$str" is not a valid \$str] ); + + my @strs = @ARGV; + + / ^ [A-Za-z]* $ /x or error( qq["$_" is not a valid value for \@strs] ) + for @strs; + + return ($str, \@strs); +} + +#------------------------------------------------------------------------------- +sub run_tests +#------------------------------------------------------------------------------- +{ + print "Running the test suite\n"; + + while (my $line = <DATA>) + { + chomp $line; + + my ($test_name, $str, $strs_str, $expected) = split / \| /x, $line; + + for ($test_name, $str, $strs_str, $expected) + { + s/ ^ \s+ //x; + s/ \s+ $ //x; + } + + my @str = split / \s+ /x, $strs_str; + my $word = find_completing_word( $str, \@str ); + + is $word, $expected, $test_name; + } + + done_testing; +} + +#------------------------------------------------------------------------------- +sub error +#------------------------------------------------------------------------------- +{ + my ($message) = @_; + + die "ERROR: $message\n$USAGE"; +} + +################################################################################ + +__DATA__ +Example 1|aBc 11c|accbbb abc abbc |accbbb +Example 2|Da2 abc|abcm baacd abaadc|baacd +Example 3|JB 007 |jj bb bjb |bjb +Sort |Da2 abc|abcm baacdf baacde|baacde +None |Abcd 4f|abc df acf | diff --git a/challenge-265/athanasius/raku/ch-1.raku b/challenge-265/athanasius/raku/ch-1.raku new file mode 100644 index 0000000000..08fed70d94 --- /dev/null +++ b/challenge-265/athanasius/raku/ch-1.raku @@ -0,0 +1,170 @@ +use v6d; + +################################################################################ +=begin comment + +Perl Weekly Challenge 265 +========================= + +TASK #1 +------- +*33% Appearance* + +Submitted by: Mohammad Sajid Anwar + +You are given an array of integers, @ints. + +Write a script to find an integer in the given array that appeared 33% or more. +If more than one found, return the smallest. If none found then return undef. + +Example 1 + + Input: @ints = (1,2,3,3,3,3,4,2) + Output: 3 + + 1 appeared 1 times. + 2 appeared 2 times. + 3 appeared 4 times. + + 3 appeared 50% (>33%) in the given array. + +Example 2 + + Input: @ints = (1,1) + Output: 1 + + 1 appeared 2 times. + + 1 appeared 100% (>33%) in the given array. + +Example 3 + + Input: @ints = (1,2,3) + Output: 1 + + 1 appeared 1 times. + 2 appeared 1 times. + 3 appeared 1 times. + + Since all three appeared 33.3% (>33%) in the given array. + We pick the smallest of all. + +=end comment +################################################################################ + +#--------------------------------------# +# Copyright © 2024 PerlMonk Athanasius # +#--------------------------------------# + +#=============================================================================== +=begin comment + +Interface +--------- +1. If no command-line arguments are given, the test suite is run. Otherwise: +2. A list of one or more integers is given on the command-line. +3. If the first integer is negative, it must be preceded by "--" to indicate + that it is not a command-line flag. + +=end comment +#=============================================================================== + +use Test; + +my Rat constant THRESHOLD = 0.33; + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + "\nChallenge 265, Task #1: 33% Appearance (Raku)\n".put; +} + +#=============================================================================== +multi sub MAIN +( + #| A non-empty list of integers + + *@ints where { .elems > 0 && .all ~~ Int:D } +) +#=============================================================================== +{ + "Input: \@ints = (%s)\n".printf: @ints.join: ','; + + my Int $solution = solve( @ints ); + + "Output: %s\n".printf: $solution.defined ?? $solution !! 'undef (= none)'; +} + +#=============================================================================== +multi sub MAIN() # No input: run the test suite +#=============================================================================== +{ + run-tests(); +} + +#------------------------------------------------------------------------------- +sub solve( List:D[Int:D] $ints --> Int ) +#------------------------------------------------------------------------------- +{ + my UInt $target = ($ints.elems * THRESHOLD).ceiling; + my Int %count; + ++%count{ $_ } for @$ints; + my Int @candidates = %count<>:k.grep( { %count{ $_ } >= $target } )\ + .map: { .Int }; + + return @candidates.elems > 0 ?? @candidates.min !! Int; +} + +#------------------------------------------------------------------------------- +sub run-tests() +#------------------------------------------------------------------------------- +{ + 'Running the test suite'.put; + + for test-data.lines -> Str $line + { + my Str ($test-name, $ints-str, $expected-str) = $line.split: / \| /; + + for $test-name, $ints-str, $expected-str + { + s/ ^ \s+ //; + s/ \s+ $ //; + } + + my Int @ints = $ints-str.split( / \s+ /, :skip-empty )\ + .map: { .Int }; + my Int $solution = solve( @ints ); + my Int $expected = $expected-str.chars > 0 ?? $expected-str.Int !! Int; + + is $solution, $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 ) +#------------------------------------------------------------------------------- +{ + return q:to/END/; + Example 1| 1 2 3 3 3 3 4 2| 3 + Example 2| 1 1 | 1 + Example 3| 1 2 3 | 1 + None | 1 2 3 4 | + Negatives|-1 0 -2 1 -2 -1 |-2 + END +} + +################################################################################ diff --git a/challenge-265/athanasius/raku/ch-2.raku b/challenge-265/athanasius/raku/ch-2.raku new file mode 100644 index 0000000000..ff332ea237 --- /dev/null +++ b/challenge-265/athanasius/raku/ch-2.raku @@ -0,0 +1,212 @@ +use v6d; + +################################################################################ +=begin comment + +Perl Weekly Challenge 265 +========================= + +TASK #2 +------- +*Completing Word* + +Submitted by: Mohammad Sajid Anwar + +You are given a string, $str containing alphnumeric characters and array of +strings (alphabetic characters only), @str. + +Write a script to find the shortest completing word. If none found return empty +string. + + A completing word is a word that contains all the letters in the given + string, ignoring space and number. If a letter appeared more than once in + the given string then it must appear the same number or more in the word. + +Example 1 + + Input: $str = 'aBc 11c' + @str = ('accbbb', 'abc', 'abbc') + Output: 'accbbb' + + The given string contains following, ignoring case and number: + a 1 times + b 1 times + c 2 times + + The only string in the given array that satisfies the condition is 'accbbb'. + +Example 2 + + Input: $str = 'Da2 abc' + @str = ('abcm', 'baacd', 'abaadc') + Output: 'baacd' + + The given string contains following, ignoring case and number: + a 2 times + b 1 times + c 1 times + d 1 times + + The are 2 strings in the given array that satisfies the condition: + 'baacd' and 'abaadc'. + + Shortest of the two is 'baacd' + +Example 3 + + Input: $str = 'JB 007' + @str = ('jj', 'bb', 'bjb') + Output: 'bjb' + + The given string contains following, ignoring case and number: + j 1 times + b 1 times + + The only string in the given array that satisfies the condition is 'bjb'. + +=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 string $str is entered as a named argument on the command-line. +3. Strings of the list @str are entered as unnamed arguments on the command- + line. + +Assumptions +----------- +1. From the Examples, it appears that case is ignored when searching for a com- + pleting word. +2. If there are two or more shortest completing words, choose the first (lowest) + by ascending alphabetical order. + +=end comment +#=============================================================================== + +use Test; + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + "\nChallenge 265, Task #2: Completing Word (Raku)\n".put; +} + +#=============================================================================== +multi sub MAIN +( + #| String of alphnumeric chars and/or whitespace + + Str:D :$str where { $str ~~ / ^ <[ \w \s ] - [ _ ]>* $ / }, + + #| List of strings of alphabetic characters only + + *@strs where { .all ~~ / ^ <[ a .. z A .. Z ]>* $ / } +) +#=============================================================================== +{ + "Input: \$str = '$str'".put; + " \@strs = (%s)\n".printf: @strs.map( { "'$_'" } ).join: ', '; + + my Str $word = find-completing-word( $str, @strs ); + + "Output: '$word'".put; +} + +#=============================================================================== +multi sub MAIN() # No input: run the test suite +#=============================================================================== +{ + run-tests(); +} + +#------------------------------------------------------------------------------- +sub find-completing-word( Str:D $str, List:D[Str:D] $strings --> Str:D ) +#------------------------------------------------------------------------------- +{ + my UInt %required; + + for $str.split( '', :skip-empty ) -> Str $char + { + ++%required{ $char.lc } if $char ~~ / ^ <.alpha> $ /; + } + + my Str @candidates; + + L-STRINGS: for @$strings -> Str $string + { + my UInt %chars; + ++%chars{ .lc } for $string.split: '', :skip-empty; + + for %required<>:k -> Str $key + { + next L-STRINGS unless %chars{ $key }:exists && + %chars{ $key } >= %required{ $key }; + } + + @candidates.push: $string; + } + + @candidates .= sort: { .chars, .Str }; + + return @candidates.elems > 0 ?? @candidates[ 0 ] !! ''; +} + +#------------------------------------------------------------------------------- +sub run-tests() +#------------------------------------------------------------------------------- +{ + 'Running the test suite'.put; + + for test-data.lines -> Str $line + { + my Str ($test-name, $str, $strs-str, $expected) = $line.split: / \| /; + + for $test-name, $str, $strs-str, $expected + { + s/ ^ \s+ //; + s/ \s+ $ //; + } + + my Str @str = $strs-str.split: / \s+ /, :skip-empty; + my Str $word = find-completing-word( $str, @str ); + + is $word, $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 ) +#------------------------------------------------------------------------------- +{ + return q:to/END/; + Example 1|aBc 11c|accbbb abc abbc |accbbb + Example 2|Da2 abc|abcm baacd abaadc|baacd + Example 3|JB 007 |jj bb bjb |bjb + Sort |Da2 abc|abcm baacdf baacde|baacde + None |Abcd 4f|abc df acf | + END +} + +################################################################################ |