diff options
| -rw-r--r-- | challenge-184/athanasius/perl/ch-1.pl | 177 | ||||
| -rw-r--r-- | challenge-184/athanasius/perl/ch-2.pl | 171 | ||||
| -rw-r--r-- | challenge-184/athanasius/raku/ch-1.raku | 153 | ||||
| -rw-r--r-- | challenge-184/athanasius/raku/ch-2.raku | 174 |
4 files changed, 675 insertions, 0 deletions
diff --git a/challenge-184/athanasius/perl/ch-1.pl b/challenge-184/athanasius/perl/ch-1.pl new file mode 100644 index 0000000000..0c44cac80c --- /dev/null +++ b/challenge-184/athanasius/perl/ch-1.pl @@ -0,0 +1,177 @@ +#!perl + +############################################################################### +=comment + +Perl Weekly Challenge 184 +========================= + +TASK #1 +------- +*Sequence Number* + +Submitted by: Mohammad S Anwar + +You are given list of strings in the format aa9999 i.e. first 2 characters can +be anything 'a-z' followed by 4 digits '0-9'. + +Write a script to replace the first two characters with sequence starting with +'00', '01', '02' etc. + +Example 1 + + Input: @list = ( 'ab1234', 'cd5678', 'ef1342') + Output: ('001234', '015678', '021342') + +Example 2 + + Input: @list = ( 'pq1122', 'rs3334') + Output: ('001122', '013334') + +=cut +############################################################################### + +#--------------------------------------# +# Copyright © 2022 PerlMonk Athanasius # +#--------------------------------------# + +#============================================================================== +=comment + +Assumptions +----------- +1. From the wording of the question combined with the two Examples, I assume + that sequence numbers are to be assigned in the order in which strings + appear in the input list, regardless of the contents of their 2-letter pre- + fixes. +2. If more than 100 strings are given as input, the prefixes simply increment + to 3 digits. + +Interface +--------- +If no arguments are given on the command line, the test suite is run. + +Implementation +-------------- +Uses Perl's built-in (postfix) ++ operator: "If ... the variable has been used +in only string contexts since it was set, and has a value that is not the empty +string and matches the pattern /^[a-zA-Z]*[0-9]*\z/, the increment is done as a +string, preserving each character within its range, with carry" [1]. + +References +---------- +[1] https://perldoc.perl.org/perlop#Auto-increment-and-Auto-decrement + +=cut +#============================================================================== + +use strict; +use warnings; +use Const::Fast; +use Test::More; + +const my $USAGE => +"Usage: + perl $0 [<list> ...] + perl $0 + + [<list> ...] List of strings, format SSNNNN where S is a-z, N is 0-9\n"; + +#------------------------------------------------------------------------------ +BEGIN +#------------------------------------------------------------------------------ +{ + $| = 1; + print "\nChallenge 184, Task #1: Sequence Number (Perl)\n\n"; +} + +#============================================================================== +MAIN: +#============================================================================== +{ + if (scalar @ARGV == 0) + { + run_tests(); + } + else + { + my @list = parse_command_line(); + + printf "Input: \@list = ( %s )\n", format_list( \@list ); + printf "Output: ( %s )\n", format_list( replace( @list ) ); + } +} + +#------------------------------------------------------------------------------ +sub replace +#------------------------------------------------------------------------------ +{ + my @list = @_; + my $prefix = '00'; + my @replaced; + + for my $string (@list) + { + push @replaced, $prefix++ . substr $string, 2, 4; + } + + return \@replaced; +} + +#------------------------------------------------------------------------------ +sub format_list +#------------------------------------------------------------------------------ +{ + my ($list) = @_; + + return join ', ', map { "'$_'" } @$list; +} + +#------------------------------------------------------------------------------ +sub parse_command_line +#------------------------------------------------------------------------------ +{ + for my $item (@ARGV) + { + $item =~ / ^ [a-z]{2} [0-9]{4} $ /x + or error( qq[Invalid string "$item"] ); + } + + return @ARGV; +} + +#------------------------------------------------------------------------------ +sub error +#------------------------------------------------------------------------------ +{ + my ($message) = @_; + + die "ERROR: $message\n$USAGE"; +} + +#------------------------------------------------------------------------------ +sub run_tests +#------------------------------------------------------------------------------ +{ + print "Running the test suite\n"; + + while (my $line = <DATA>) + { + chomp $line; + + my ($name, $in, $exp) = split / , \s* /x, $line, 3; + my $replaced = replace( split / \s+ /x, $in ); + + is join( ' ', @$replaced ), $exp, $name; + } + + done_testing; +} + +############################################################################### + +__DATA__ +Example 1, ab1234 cd5678 ef1342, 001234 015678 021342 +Example 2, pq1122 rs3334, 001122 013334 +Same nums, zz9876 yy9876 xx9876, 009876 019876 029876 +Same letters, aa2468 aa3579 aa1680, 002468 013579 021680 diff --git a/challenge-184/athanasius/perl/ch-2.pl b/challenge-184/athanasius/perl/ch-2.pl new file mode 100644 index 0000000000..b645412a05 --- /dev/null +++ b/challenge-184/athanasius/perl/ch-2.pl @@ -0,0 +1,171 @@ +#!perl + +############################################################################### +=comment + +Perl Weekly Challenge 184 +========================= + +TASK #2 +------- +*Split Array* + +Submitted by: Mohammad S Anwar + +You are given list of strings containing 0-9 and a-z separated by space only. + +Write a script to split the data into two arrays, one for integers and one for +alphabets only. + +Example 1 + + Input: @list = ( 'a 1 2 b 0', '3 c 4 d') + Output: [[1,2,0], [3,4]] and [['a','b'], ['c','d']] + +Example 2 + + Input: @list = ( '1 2', 'p q r', 's 3', '4 5 t') + Output: [[1,2], [3], [4,5]] and [['p','q','r'], ['s'], ['t']] + +=cut +############################################################################### + +#--------------------------------------# +# Copyright © 2022 PerlMonk Athanasius # +#--------------------------------------# + +#============================================================================== +=comment + +Assumption +---------- +From Example 2 it appears that empty arrays should be omitted from the output. + +Implementation +-------------- +For convenience, identification of valid digit and letter characters is imple- +mented using the CPAN module Set::Tiny. + +=cut +#============================================================================== + +use strict; +use warnings; +use Const::Fast; +use Set::Tiny; + +const my $VALID_DIGITS => Set::Tiny->new( '0' .. '9' ); +const my $VALID_LETTERS => Set::Tiny->new( 'a' .. 'z' ); +const my $VALID_CHARS => $VALID_DIGITS->union( $VALID_LETTERS ); +const my $USAGE => +"Usage: + perl $0 [<list> ...] + + [<list> ...] List of strings: single chars (0-9, a-z), space-separated\n"; + +#------------------------------------------------------------------------------ +BEGIN +#------------------------------------------------------------------------------ +{ + $| = 1; + print "\nChallenge 184, Task #2: Split Array (Perl)\n\n"; +} + +#============================================================================== +MAIN: +#============================================================================== +{ + my @strings = parse_command_line(); + + printf "Input: \@list = ( %s )\n", join ', ', map { "'@$_'" } @strings; + + my (@digits, @letters); + + for my $chars (@strings) + { + my ($digits, $letters) = split_array( $chars ); + + push @digits, $digits if @$digits; + push @letters, $letters if @$letters; + } + + printf "Output: [%s] and [%s]\n", fmt_int( \@digits ), + fmt_str( \@letters ); +} + +#------------------------------------------------------------------------------ +sub split_array +#------------------------------------------------------------------------------ +{ + my ($chars) = @_; + my (@digits, @letters); + + for my $char (@$chars) + { + if (defined $VALID_DIGITS->element( $char )) + { + push @digits, $char; + } + else + { + push @letters, $char; + } + } + + return (\@digits, \@letters); +} + +#------------------------------------------------------------------------------ +sub parse_command_line +#------------------------------------------------------------------------------ +{ + scalar @ARGV > 0 or error( 'No command-line arguments found' ); + + my @strings; + + for my $string (@ARGV) + { + my @chars = split /\s+/, $string; + + for my $char (@chars) + { + defined $VALID_CHARS->element( $char ) + or error( qq[Invalid string element "$char"] ); + } + + push @strings, [ @chars ]; + } + + return @strings; +} + +#------------------------------------------------------------------------------ +sub fmt_int +#------------------------------------------------------------------------------ +{ + my ($list) = @_; + + return join ', ', + map { '[' . join( ',', @$_ ) . ']' } @$list; +} + +#------------------------------------------------------------------------------ +sub fmt_str +#------------------------------------------------------------------------------ +{ + my ($list) = @_; + + return join ', ', + map { '[' . join( ',', map { "'$_'" } @$_ ) . ']' } @$list; +} + +#------------------------------------------------------------------------------ +sub error +#------------------------------------------------------------------------------ +{ + my ($message) = @_; + + die "ERROR: $message\n$USAGE"; +} + +############################################################################### diff --git a/challenge-184/athanasius/raku/ch-1.raku b/challenge-184/athanasius/raku/ch-1.raku new file mode 100644 index 0000000000..8dfeec605f --- /dev/null +++ b/challenge-184/athanasius/raku/ch-1.raku @@ -0,0 +1,153 @@ +use v6d; + +############################################################################### +=begin comment + +Perl Weekly Challenge 184 +========================= + +TASK #1 +------- +*Sequence Number* + +Submitted by: Mohammad S Anwar + +You are given list of strings in the format aa9999 i.e. first 2 characters can +be anything 'a-z' followed by 4 digits '0-9'. + +Write a script to replace the first two characters with sequence starting with +'00', '01', '02' etc. + +Example 1 + + Input: @list = ( 'ab1234', 'cd5678', 'ef1342') + Output: ('001234', '015678', '021342') + +Example 2 + + Input: @list = ( 'pq1122', 'rs3334') + Output: ('001122', '013334') + +=end comment +############################################################################### + +#--------------------------------------# +# Copyright © 2022 PerlMonk Athanasius # +#--------------------------------------# + +#============================================================================== +=begin comment + +Assumptions +----------- +1. From the wording of the question combined with the two Examples, I assume + that sequence numbers are to be assigned in the order in which strings + appear in the input list, regardless of the contents of theie 2-letter pre- + fixes. +2. If more than 100 strings are given as input, the prefixes simply increment + to 3 digits. + +Interface +--------- +If no arguments are given on the command line, the test suite is run. + +Implementation +-------------- +Uses Raku's built-in (postfix) ++ operator, which "[i]ncrements its argument by +one and returns the original value." [1] The increment is performed by the +built-in method succ(), which, given a string, "searches for the last alpha- +numeric sequence that is not preceded by a dot, and increments it." [2] + +References +---------- +[1] https://docs.raku.org/language/operators#index-entry-postfix_++-++ +[2] https://docs.raku.org/routine/succ + +=end comment +#============================================================================== + +use Test; + +#------------------------------------------------------------------------------ +BEGIN +#------------------------------------------------------------------------------ +{ + "\nChallenge 184, Task #1: Sequence Number (Raku)\n".put; +} + +#============================================================================== +multi sub MAIN +( + #| List of strings, format $$#### where $ is a-z, # is 0-9 + + *@list where { .all ~~ / ^ <[ a .. z ]> ** 2 <[ 0 .. 9 ]> ** 4 $ / } +) +#============================================================================== +{ + "Input: @list = ( %s )\n".printf: format-list( @list ); + "Output: ( %s )\n".printf: format-list( replace( @list ) ); +} + +#============================================================================== +multi sub MAIN() # Run the test suite +#============================================================================== +{ + 'Running the test suite'.put; + + for test-data.lines -> Str $line + { + my Str $test = $line.chomp; + my Str ($name, $in, $exp) = $test.split: / \, \s* /, 3, :skip-empty; + + is replace( $in.split( / \s+ / ).list ), $exp, $name; + } + + done-testing; +} + +#------------------------------------------------------------------------------ +sub replace( List:D[Str:D] $list --> List:D[Str:D] ) +#------------------------------------------------------------------------------ +{ + my Str @replaced; + my Str $prefix = '00'; + + for @$list -> Str $string + { + @replaced.push: $prefix++ ~ $string.substr: 2 .. 5; + } + + return @replaced; +} + +#------------------------------------------------------------------------------ +sub format-list( List:D[Str:D] $list --> Str:D ) +#------------------------------------------------------------------------------ +{ + return $list.map( { "'$_'" } ).join: ', '; +} + +#------------------------------------------------------------------------------ +sub test-data() +#------------------------------------------------------------------------------ +{ + return q:to/END/; + Example 1, ab1234 cd5678 ef1342, 001234 015678 021342 + Example 2, pq1122 rs3334, 001122 013334 + Same nums, zz9876 yy9876 xx9876, 009876 019876 029876 + Same letters, aa2468 aa3579 aa1680, 002468 013579 021680 + END +} + +#------------------------------------------------------------------------------ +sub USAGE() +#------------------------------------------------------------------------------ +{ + my Str $usage = $*USAGE; + + $usage ~~ s:g/ ($*PROGRAM-NAME) /raku $0/; + + $usage.put; +} + +############################################################################### diff --git a/challenge-184/athanasius/raku/ch-2.raku b/challenge-184/athanasius/raku/ch-2.raku new file mode 100644 index 0000000000..5e568d310e --- /dev/null +++ b/challenge-184/athanasius/raku/ch-2.raku @@ -0,0 +1,174 @@ +use v6d; + +############################################################################### +=begin comment + +Perl Weekly Challenge 184 +========================= + +TASK #2 +------- +*Split Array* + +Submitted by: Mohammad S Anwar + +You are given list of strings containing 0-9 and a-z separated by space only. + +Write a script to split the data into two arrays, one for integers and one for +alphabets only. + +Example 1 + + Input: @list = ( 'a 1 2 b 0', '3 c 4 d') + Output: [[1,2,0], [3,4]] and [['a','b'], ['c','d']] + +Example 2 + + Input: @list = ( '1 2', 'p q r', 's 3', '4 5 t') + Output: [[1,2], [3], [4,5]] and [['p','q','r'], ['s'], ['t']] + +=end comment +############################################################################### + +#--------------------------------------# +# Copyright © 2022 PerlMonk Athanasius # +#--------------------------------------# + +#============================================================================== +=begin comment + +Assumption +---------- +From Example 2 it appears that empty arrays should be omitted from the output. + +Implementation +-------------- +For convenience, identification of valid digit and letter characters is imple- +mented using Raku's in-built Set class. + +=end comment +#============================================================================== + +subset Split of List where (Array[UInt], Array[Str]); + +my Set[Str] constant $VALID-DIGITS = Set[Str].new: '0' .. '9'; +my Set[Str] constant $VALID-LETTERS = Set[Str].new: 'a' .. 'z'; +my Set[Str] constant $VALID-CHARS = $VALID-DIGITS ∪ $VALID-LETTERS; + +#------------------------------------------------------------------------------ +BEGIN +#------------------------------------------------------------------------------ +{ + "\nChallenge 184, Task #2: Split Array (Raku)\n".put; +} + +#============================================================================== +sub MAIN +( + #| List of strings: single chars (0-9, a-z), space-separated + + *@list where { .elems > 0 } +) +#============================================================================== +{ + my Array[Str] @string-arrays = parse-command-line( @list ); + + "Input: @list = ( %s )\n".printf: + @string-arrays.map( { "'$_'" } ).join: ', '; + + my Array[UInt] @digits; + my Array[Str] @letters; + + for @string-arrays -> Array[Str] $chars + { + my (Array[UInt] $digits, Array[Str] $letters) = split-array( $chars ); + + @digits\.push: $digits if $digits; + @letters.push: $letters if $letters; + } + + "Output: [%s] and [%s]\n".printf: fmt-int( @digits ), fmt-str( @letters ); +} + +#------------------------------------------------------------------------------ +sub split-array( Array:D[Str:D] $chars --> Split:D ) +#------------------------------------------------------------------------------ +{ + my UInt @digits; + my Str @letters; + + for @$chars -> Str $char + { + if $char ∈ $VALID-DIGITS + { + @digits\.push: $char.Int; + } + else + { + @letters.push: $char; + } + } + + return @digits, @letters; +} + +#------------------------------------------------------------------------------ +sub parse-command-line( List:D[Str:D] $list --> List:D[List:D[Str:D]] ) +#------------------------------------------------------------------------------ +{ + my Array[Str] @strings; + + for @$list -> Str $string + { + my Str @chars = $string.split: / \s+ /, :skip-empty; + + for @chars -> Str $char + { + $char ∈ $VALID-CHARS + or error( qq[Invalid string element "$char"] ); + } + + @strings.push: @chars; + } + + return @strings; +} + +#------------------------------------------------------------------------------ +sub fmt-int( List:D[UInt:D] $list --> Str:D ) +#------------------------------------------------------------------------------ +{ + return $list.map( { '[' ~ .join( ',' ) ~ ']' } ).join( ', ' ); +} + +#------------------------------------------------------------------------------ +sub fmt-str( List:D[Str:D] $list --> Str:D ) +#------------------------------------------------------------------------------ +{ + return $list.map( { '[' ~ .map( { "'$_'" } ).join( ',' ) ~ ']' } )\ + .join( ', ' ); +} + +#------------------------------------------------------------------------------ +sub error( Str:D $message ) +#------------------------------------------------------------------------------ +{ + "ERROR: $message".put; + + USAGE(); + + exit 0; +} + +#------------------------------------------------------------------------------ +sub USAGE() +#------------------------------------------------------------------------------ +{ + my Str $usage = $*USAGE; + + $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/; + + $usage.put; +} + +############################################################################### |