diff options
| -rw-r--r-- | challenge-215/athanasius/perl/ch-1.pl | 215 | ||||
| -rw-r--r-- | challenge-215/athanasius/perl/ch-2.pl | 214 | ||||
| -rw-r--r-- | challenge-215/athanasius/raku/ch-1.raku | 198 | ||||
| -rw-r--r-- | challenge-215/athanasius/raku/ch-2.raku | 192 |
4 files changed, 819 insertions, 0 deletions
diff --git a/challenge-215/athanasius/perl/ch-1.pl b/challenge-215/athanasius/perl/ch-1.pl new file mode 100644 index 0000000000..8a86b41ea9 --- /dev/null +++ b/challenge-215/athanasius/perl/ch-1.pl @@ -0,0 +1,215 @@ +#!perl + +################################################################################ +=comment + +Perl Weekly Challenge 215 +========================= + +TASK #1 +------- +*Odd One Out* + +Submitted by: Mohammad S Anwar + +You are given a list of words (alphabetic characters only) of same size. + +Write a script to remove all words not sorted alphabetically and print the +number of words in the list that are not alphabetically sorted. + +Example 1 + + Input: @words = ('abc', 'xyz', 'tsu') + Output: 1 + + The words 'abc' and 'xyz' are sorted and can't be removed. + The word 'tsu' is not sorted and hence can be removed. + +Example 2 + + Input: @words = ('rat', 'cab', 'dad') + Output: 3 + + None of the words in the given list are sorted. + Therefore all three needs to be removed. + +Example 3 + + Input: @words = ('x', 'y', 'z') + Output: 0 + +=cut +################################################################################ + +#--------------------------------------# +# Copyright © 2023 PerlMonk Athanasius # +#--------------------------------------# + +#=============================================================================== +=comment + +Interface +--------- +1. If no command-line arguments are given, the test suite is run. Otherwise: +2. If $VERBOSE is set to a true value (the default), the output is followed by a + breakdown of the sorted and unsorted words. + +Assumptions +----------- +1. "Alphabetic characters" are A-Z and a-z only. +2. "Sorted alphabetically" means sorted in monotonically ascending alphabetical + order. +3. Treatment of uppercase letters: + a. If the constant $ASCIIBETICAL is set to a true value, uppercase letters + rank below lowercase letters; so, e.g., "Bade" IS alphabetically sorted. + b. Otherwise (the default), each uppercase letter is considered identical to + its lowercase counterpart; so, "Bade" is equivalent to "bade", which is + NOT alphabetically sorted. + +=cut +#=============================================================================== + +use strict; +use warnings; +use Const::Fast; +use Test::More; + +const my $ASCIIBETICAL => 0; +const my $VERBOSE => 1; +const my $USAGE => +"Usage: + perl $0 [<words> ...] + perl $0 + + [<words> ...] Non-empty list of same-size words (chars A-Z and a-z only) +"; + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + $| = 1; + print "\nChallenge 215, Task #1: Odd One Out (Perl)\n\n"; +} + +#=============================================================================== +MAIN: +#=============================================================================== +{ + if (scalar @ARGV == 0) + { + run_tests(); + } + else + { + my $words = parse_command_line(); + + printf "Input: \@words = (%s)\n", join ', ', @$words; + + my ($sorted, $unsorted) = partition( $words ); + + print "Sorting ASCIIbetically...\n" if $ASCIIBETICAL; + + printf "Output: %d\n", scalar @$unsorted; + + if ($VERBOSE) + { + printf "\nSorted: (%s)\n", join ', ', map { qq['$_'] } @$sorted; + printf "Unsorted: (%s)\n", join ', ', map { qq['$_'] } @$unsorted; + } + } +} + +#------------------------------------------------------------------------------- +sub partition +#------------------------------------------------------------------------------- +{ + my ($words) = @_; + my (@sorted, @unsorted); + + for my $word (@$words) + { + my $sorted = 1; + my $previous = ''; + + for (split //, $word) + { + my $letter = $ASCIIBETICAL ? $_ : lc; + + if ($letter lt $previous) + { + $sorted = 0; + last; + } + + $previous = $letter; + } + + push @{ $sorted ? \@sorted : \@unsorted }, $word; + } + + return (\@sorted, \@unsorted); +} + +#------------------------------------------------------------------------------- +sub parse_command_line +#------------------------------------------------------------------------------- +{ + my $first = $ARGV[ 0 ]; + + for (@ARGV) + { + length == length $first + or error( 'The input words are not all of the same size' ); + } + + return \@ARGV; +} + +#------------------------------------------------------------------------------- +sub run_tests +#------------------------------------------------------------------------------- +{ + print "Running the test suite\n"; + + while (my $line = <DATA>) + { + chomp $line; + + my ($test_name, $words, $expected) = split / \| /x, $line; + + SKIP: + { + skip 'This test requires $ASCIIBETICAL to be False' + if $ASCIIBETICAL && $test_name =~ / case /x; + + s/ \s+ $ //x for $test_name, $words; # Trim whitespace + + my @words = split / , /x, $words; + my ($sorted, $unsorted) = partition( \@words ); + + is scalar( @$unsorted ), $expected, $test_name; + } + } + + done_testing; +} + +#------------------------------------------------------------------------------- +sub error +#------------------------------------------------------------------------------- +{ + my ($message) = @_; + + die "ERROR: $message\n$USAGE"; +} + +################################################################################ + +__DATA__ +Example 1 |abc,xyz,tsu |1 +Example 2 |rat,cab,dad |3 +Example 3 |x,y,z |0 +Repeats |beet,allow,abbot,boot,redder|1 +Capitals |ABC,XYZ,TSU |1 +Mixed case|Bade,abcd,Abcd |1 diff --git a/challenge-215/athanasius/perl/ch-2.pl b/challenge-215/athanasius/perl/ch-2.pl new file mode 100644 index 0000000000..5cf62d2090 --- /dev/null +++ b/challenge-215/athanasius/perl/ch-2.pl @@ -0,0 +1,214 @@ +#!perl + +################################################################################ +=comment + +Perl Weekly Challenge 215 +========================= + +TASK #2 +------- +*Number Placement* + +Submitted by: Mohammad S Anwar + +You are given a list of numbers having just 0 and 1. You are also given place- +ment count (>=1). + +Write a script to find out if it is possible to replace 0 with 1 in the given +list. The only condition is that you can only replace when there is no 1 on +either side. Print 1 if it is possible otherwise 0. + +Example 1: + + Input: @numbers = (1,0,0,0,1), $count = 1 + Output: 1 + + You are asked to replace only one 0 as given count is 1. + We can easily replace middle 0 in the list i.e. (1,0,1,0,1). + +Example 2: + + Input: @numbers = (1,0,0,0,1), $count = 2 + Output: 0 + + You are asked to replace two 0's as given count is 2. + It is impossible to replace two 0's. + +Example 3: + + Input: @numbers = (1,0,0,0,0,0,0,0,1), $count = 3 + Output: 1 + +=cut +################################################################################ + +#--------------------------------------# +# Copyright © 2023 PerlMonk Athanasius # +#--------------------------------------# + +#=============================================================================== +=comment + +Interface +--------- +1. If no command-line arguments are given, the test suite is run. Otherwise: +2. If $VERBOSE is set to a true value, an output of 1 is followed by a list + containing the required replacements. + +Assumption +---------- +The task description says: + + "...replace 0 with 1 in the given list.... you can only replace when there + is no 1 on either side." + +I assume this condition (re-)applies *as each replacement is made*. For example, +in the list: + + (1,0,0,0,0,1) + a b c d e f + +the middle two zeros (c and d) both satisfy the condition at the outset; but +once a single replacement is made, e.g. replace c: (1,0,1,0,0,1), the condition +no longer holds for d, so no further replacement is possible. + +=cut +#=============================================================================== + +use strict; +use warnings; +use Const::Fast; +use Regexp::Common qw( number ); +use Test::More; + +const my $VERBOSE => 1; +const my $USAGE => +"Usage: + perl $0 <numbers> <count> + perl $0 + + <numbers> Non-empty string of 0s and 1s + <count> Placement count (>= 1)\n"; + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + $| = 1; + print "\nChallenge 215, Task #2: Number Placement (Perl)\n\n"; +} + +#=============================================================================== +MAIN: +#=============================================================================== +{ + my $args = scalar @ARGV; + + if ($args == 0) + { + run_tests(); + } + elsif ($args == 2) + { + my ($numbers, $count) = parse_command_line(); + + printf "Input: \@numbers = (%s), \$count = %d\n", + join( ',', @$numbers ), $count; + + my $new_list = make_replacements( $numbers, $count ); + + printf "Output: %d\n", defined $new_list ? 1 : 0; + + if ($VERBOSE && defined $new_list) + { + printf "\nReplacement list: (%s)\n", join ',', @$new_list; + } + } + else + { + error( "Expected 0 or 2 command-line arguments, found $args" ); + } +} + +#------------------------------------------------------------------------------- +sub make_replacements +#------------------------------------------------------------------------------- +{ + my ($numbers, $count) = @_; + + for my $i (0 .. $#$numbers) + { + if (($i == 0 || $numbers->[ $i - 1 ] == 0) && + $numbers->[ $i ] == 0 && + ($i == $#$numbers || $numbers->[ $i + 1 ] == 0)) + { + $numbers->[ $i ] = 1; + + return $numbers if --$count == 0; + } + } + + return; +} + +#------------------------------------------------------------------------------- +sub parse_command_line +#------------------------------------------------------------------------------- +{ + my ($numbers, $count) = @ARGV; + + $numbers =~ / ^ [01]+ $ /x + or error( qq[Invalid <numbers> argument "$numbers"] ); + + my @numbers = split //, $numbers; + + $count =~ / ^ $RE{num}{int} $ /x && $count > 0 + or error( qq[Invalid <count> argument "$count"] ); + + return (\@numbers, $count); +} + +#------------------------------------------------------------------------------- +sub run_tests +#------------------------------------------------------------------------------- +{ + print "Running the test suite\n"; + + while (my $line = <DATA>) + { + chomp $line; + + my ($test_name, $numbers, $count, $expected) = split / \| /x, $line; + + s/ \s+ $ //x for $test_name, $numbers, $count; # Trim whitespace + + my @numbers = split //, $numbers; + my $new_list = make_replacements( \@numbers, $count ); + my $got = defined $new_list ? 1 : 0; + + is $got, $expected, $test_name; + } + + done_testing; +} + +#------------------------------------------------------------------------------- +sub error +#------------------------------------------------------------------------------- +{ + my ($message) = @_; + + die "ERROR: $message\n$USAGE"; +} + +################################################################################ + +__DATA__ +Example 1 |10001 |1|1 +Example 2 |10001 |2|0 +Example 3 |100000001 |3|1 +Beginning |0010000000010|4|1 +Ending |0100000000100|4|1 +Start and end|001100 |2|1 +One too many |0100000000100|5|0 diff --git a/challenge-215/athanasius/raku/ch-1.raku b/challenge-215/athanasius/raku/ch-1.raku new file mode 100644 index 0000000000..15597de134 --- /dev/null +++ b/challenge-215/athanasius/raku/ch-1.raku @@ -0,0 +1,198 @@ +use v6d; + +################################################################################ +=begin comment + +Perl Weekly Challenge 215 +========================= + +TASK #1 +------- +*Odd One Out* + +Submitted by: Mohammad S Anwar + +You are given a list of words (alphabetic characters only) of same size. + +Write a script to remove all words not sorted alphabetically and print the +number of words in the list that are not alphabetically sorted. + +Example 1 + + Input: @words = ('abc', 'xyz', 'tsu') + Output: 1 + + The words 'abc' and 'xyz' are sorted and can't be removed. + The word 'tsu' is not sorted and hence can be removed. + +Example 2 + + Input: @words = ('rat', 'cab', 'dad') + Output: 3 + + None of the words in the given list are sorted. + Therefore all three needs to be removed. + +Example 3 + + Input: @words = ('x', 'y', 'z') + Output: 0 + +=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 VERBOSE is set to True (the default), the output is followed by a break- + down of the sorted and unsorted words. + +Assumptions +----------- +1. "Alphabetic characters" are A-Z and a-z only. +2. "Sorted alphabetically" means sorted in monotonically ascending alphabetical + order. +3. Treatment of uppercase letters: + a. If the constant "ASCIIBETICAL" is set to True, uppercase letters rank + below lowercase letters; so, e.g., "Bade" IS alphabetically sorted. + b. Otherwise (the default), each uppercase letter is considered identical to + its lowercase counterpart; so, "Bade" is equivalent to "bade", which is + NOT alphabetically sorted. + +=end comment +#=============================================================================== + +use Test; + +my Bool constant ASCIIBETICAL = False; +my Bool constant VERBOSE = True; + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + "\nChallenge 215, Task #1: Odd One Out (Raku)\n".put; +} + +#=============================================================================== +multi sub MAIN +( + #| Non-empty list of same-size words (chars A-Z and a-z only) + + *@words where { .elems > 0 && @words[ 0 ].chars == .all.chars } +) +#=============================================================================== +{ + "Input: \@words = (%s)\n".printf: @words.map( { qq['$_'] } ).join: ', '; + + my Array[Str] ($sorted, $unsorted) = partition( @words ); + + 'Sorting ASCIIbetically...'.put if ASCIIBETICAL; + + "Output: %d\n"\.printf: $unsorted.elems; + + if VERBOSE + { + "\nSorted: (%s)\n".printf: $sorted.map( { qq['$_'] } ).join: ', '; + "Unsorted: (%s)\n".printf: $unsorted.map( { qq['$_'] } ).join: ', '; + } +} + +#=============================================================================== +multi sub MAIN() # No input: run the test suite +#=============================================================================== +{ + run-tests(); +} + +#------------------------------------------------------------------------------- +sub partition( Array:D[Str:D] $words --> List:D[List:D[Str:D], List:D[Str:D]] ) +#------------------------------------------------------------------------------- +{ + my Str (@sorted, @unsorted); + + for @$words -> Str $word + { + my Bool $sorted = True; + my Str $previous = ''; + + for $word.split: '', :skip-empty + { + my Str $letter = ASCIIBETICAL ?? $_ !! .lc; + + if $letter lt $previous + { + $sorted = False; + last; + } + + $previous = $letter; + } + + ($sorted ?? @sorted !! @unsorted).push: $word; + } + + return @sorted, @unsorted; +} + +#------------------------------------------------------------------------------- +sub run-tests() +#------------------------------------------------------------------------------- +{ + 'Running the test suite'.put; + + for test-data.lines -> Str $line + { + my Str ($test-name, $words, $expected) = $line.split: / \| /; + + if ASCIIBETICAL && $test-name ~~ / case / + { + skip 'This test requires "ASCIIBETICAL" to be False'; + } + else + { + s/ \s+ $ // for $test-name, $words; # Trim whitespace + + my Str @words = $words.split: ','; + my Array[Str] ($sorted, $unsorted) = partition( @words ); + + is $unsorted.elems, $expected.Int, $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,xyz,tsu |1 + Example 2 |rat,cab,dad |3 + Example 3 |x,y,z |0 + Repeats |beet,allow,abbot,boot,redder|1 + Capitals |ABC,XYZ,TSU |1 + Mixed case|Bade,abcd,Abcd |1 + END +} + +################################################################################ diff --git a/challenge-215/athanasius/raku/ch-2.raku b/challenge-215/athanasius/raku/ch-2.raku new file mode 100644 index 0000000000..77b90c8543 --- /dev/null +++ b/challenge-215/athanasius/raku/ch-2.raku @@ -0,0 +1,192 @@ +use v6d; + +################################################################################ +=begin comment + +Perl Weekly Challenge 215 +========================= + +TASK #2 +------- +*Number Placement* + +Submitted by: Mohammad S Anwar + +You are given a list of numbers having just 0 and 1. You are also given place- +ment count (>=1). + +Write a script to find out if it is possible to replace 0 with 1 in the given +list. The only condition is that you can only replace when there is no 1 on +either side. Print 1 if it is possible otherwise 0. + +Example 1: + + Input: @numbers = (1,0,0,0,1), $count = 1 + Output: 1 + + You are asked to replace only one 0 as given count is 1. + We can easily replace middle 0 in the list i.e. (1,0,1,0,1). + +Example 2: + + Input: @numbers = (1,0,0,0,1), $count = 2 + Output: 0 + + You are asked to replace two 0's as given count is 2. + It is impossible to replace two 0's. + +Example 3: + + Input: @numbers = (1,0,0,0,0,0,0,0,1), $count = 3 + Output: 1 + +=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 $VERBOSE is set to True, an output of 1 is followed by a list containing + the required replacements. + +Assumption +---------- +The task description says: + + "...replace 0 with 1 in the given list.... you can only replace when there + is no 1 on either side." + +I assume this condition (re-)applies *as each replacement is made*. For example, +in the list: + + (1,0,0,0,0,1) + a b c d e f + +the middle two zeros (c and d) both satisfy the condition at the outset; but +once a single replacement is made, e.g. replace c: (1,0,1,0,0,1), the condition +no longer holds for d, so no further replacement is possible. + +=end comment +#=============================================================================== + +my Bool constant $VERBOSE = True; + +subset Pos of Int where * > 0; +subset Bit of Int where 0|1; + +use Test; + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + "\nChallenge 215, Task #2: Number Placement (Raku)\n".put; +} + +#=============================================================================== +multi sub MAIN +( + Str:D $numbers where / ^ <[ 0 1 ]>+ $ /, #= Non-empty string of 0s and 1s + Pos:D $count #= Placement count (>= 1) +) +#=============================================================================== +{ + my Bit @numbers = $numbers.split( '', :skip-empty ).map: { .Int }; + + "Input: \@numbers = (%s), \$count = %d\n".printf: + @numbers.join( ',' ), $count; + + my Bit @new-list = make-replacements( @numbers, $count ); + + "Output: %d\n".printf: @new-list.elems ?? 1 !! 0; + + if ($VERBOSE && @new-list.elems) + { + printf "\nReplacement list: (%s)\n", join ',', @new-list; + } +} + +#=============================================================================== +multi sub MAIN() # No input: run the test suite +#=============================================================================== +{ + run-tests(); +} + +#------------------------------------------------------------------------------- +sub make-replacements( Array:D[Bit:D] $numbers, Pos:D $count --> List:D[Bit:D] ) +#------------------------------------------------------------------------------- +{ + my UInt $my-count = $count; + my Bit @my-numbers = |$numbers; + + for 0 .. $numbers.end -> UInt $i + { + if ($i == 0 || @my-numbers[ $i - 1 ] == 0) && + @my-numbers[ $i ] == 0 && + ($i == $numbers.end || @my-numbers[ $i + 1 ] == 0) + { + @my-numbers[ $i ] = 1; + + return @my-numbers if --$my-count == 0; + } + } + + return (); # Empty list +} + +#------------------------------------------------------------------------------- +sub run-tests() +#------------------------------------------------------------------------------- +{ + 'Running the test suite'.put; + + for test-data.lines -> Str $line + { + my Str ($test-name, $numbers, $count, $expected) = $line.split: / \| /; + + s/ \s+ $ // for $test-name, $numbers, $count; # Trim whitespace + + my Bit @numbers = $numbers.split( '', :skip-empty ).map: { .Int }; + my Bit @new-list = make-replacements( @numbers, $count.Int ); + + is @new-list.elems ?? 1 !! 0, $expected.Int, $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 |10001 |1|1 + Example 2 |10001 |2|0 + Example 3 |100000001 |3|1 + Beginning |0010000000010|4|1 + Ending |0100000000100|4|1 + Start and end|001100 |2|1 + One too many |0100000000100|5|0 + END +} + +################################################################################ |