diff options
| -rw-r--r-- | challenge-197/athanasius/perl/ch-1.pl | 165 | ||||
| -rw-r--r-- | challenge-197/athanasius/perl/ch-2.pl | 227 | ||||
| -rw-r--r-- | challenge-197/athanasius/raku/ch-1.raku | 178 | ||||
| -rw-r--r-- | challenge-197/athanasius/raku/ch-2.raku | 239 |
4 files changed, 809 insertions, 0 deletions
diff --git a/challenge-197/athanasius/perl/ch-1.pl b/challenge-197/athanasius/perl/ch-1.pl new file mode 100644 index 0000000000..4241711df6 --- /dev/null +++ b/challenge-197/athanasius/perl/ch-1.pl @@ -0,0 +1,165 @@ +#!perl + +############################################################################### +=comment + +Perl Weekly Challenge 197 +========================= + +TASK #1 +------- +*Move Zero* + +Submitted by: Mohammad S Anwar + +You are given a list of integers, @list. + +Write a script to move all zero, if exists, to the end while maintaining the +relative order of non-zero elements. + +Example 1 + + Input: @list = (1, 0, 3, 0, 0, 5) + Output: (1, 3, 5, 0, 0, 0) + +Example 2 + + Input: @list = (1, 6, 4) + Output: (1, 6, 4) + +Example 3 + + Input: @list = (0, 1, 0, 2, 0) + Output: (1, 2, 0, 0, 0) + +=cut +############################################################################### + +#--------------------------------------# +# Copyright © 2023 PerlMonk Athanasius # +#--------------------------------------# + +#============================================================================== +=comment + +Interface +--------- +If no command-line arguments are given, the test suite is run. + +Algorithm +--------- +1. Traverse the input list, counting zero values but copying non-zero values to + the output list. +2. Append the number of zero values encountered in the input list to the end of + the output list. + -- The repetition operator 'x' in list context "returns a list consisting of + the left operand list repeated the number of times specified by the right + operand" (https://perldoc.perl.org/perlop#Multiplicative-Operators). + +=cut +#============================================================================== + +use strict; +use warnings; +use Const::Fast; +use Regexp::Common qw( number ); +use Test::More; + +const my $TEST_FIELDS => 3; +const my $USAGE => +"Usage: + perl $0 [<list> ...] + perl $0 + + [<list> ...] A list of 1 or more integers\n"; + +#------------------------------------------------------------------------------ +BEGIN +#------------------------------------------------------------------------------ +{ + $| = 1; + print "\nChallenge 197, Task #1: Move Zero (Perl)\n\n"; +} + +#============================================================================== +MAIN: +#============================================================================== +{ + my $args = scalar @ARGV; + + if ($args == 0) + { + run_tests(); + } + else + { + my @list = @ARGV; + + for (@list) + { + / ^ $RE{num}{int} $ /x + or die qq[ERROR: "$_" is not a valid integer\n$USAGE]; + } + + printf "Input: \@list = (%s)\n", join ', ', @list; + printf "Output: (%s)\n", join ', ', move_zero( @list ); + } +} + +#------------------------------------------------------------------------------ +sub move_zero +#------------------------------------------------------------------------------ +{ + my @list = @_; + my $count = 0; + my @moved; + + for my $n (@list) + { + if ($n == 0) + { + ++$count; + } + else + { + push @moved, $n; + } + } + + push @moved, (0) x $count; + + return @moved; +} + +#------------------------------------------------------------------------------ +sub run_tests +#------------------------------------------------------------------------------ +{ + print "Running the test suite\n"; + + while (my $line = <DATA>) + { + chomp $line; + + my ($test_name, $input, $expected) = split /\|/, $line, $TEST_FIELDS; + + $input =~ s/ ^ \s* (.+?) \s* $ /$1/x; # Trim whitespace + $expected =~ s/ ^ \s* (.+?) \s* $ /$1/x; + $expected =~ s/ \s+ / /gx; + + my @list = split / , \s+ /x, $input; + my $got = join ', ', move_zero( @list ); + + is $got, $expected, $test_name; + } + + done_testing; +} + +############################################################################### + +__DATA__ +Example 1| 1, 0, 3, 0, 0, 5 | 1, 3, 5, 0, 0, 0 +Example 2| 1, 6, 4 | 1, 6, 4 +Example 3| 0, 1, 0, 2, 0 | 1, 2, 0, 0, 0 +Negatives|-1, 0, -2, -3, 0, 0, -4|-1, -2, -3, -4, 0, 0, 0 diff --git a/challenge-197/athanasius/perl/ch-2.pl b/challenge-197/athanasius/perl/ch-2.pl new file mode 100644 index 0000000000..729783ca11 --- /dev/null +++ b/challenge-197/athanasius/perl/ch-2.pl @@ -0,0 +1,227 @@ +#!perl + +############################################################################### +=comment + +Perl Weekly Challenge 197 +========================= + +TASK #2 +------- +*Wiggle Sort* + +Submitted by: Mohammad S Anwar + +You are given a list of integers, @list. + +Write a script to perform Wiggle Sort on the given list. + + + Wiggle sort would be such as list[0] < list[1] > list[2] < list[3]…. + + +Example 1 + + Input: @list = (1,5,1,1,6,4) + Output: (1,6,1,5,1,4) + +Example 2 + + Input: @list = (1,3,2,2,3,1) + Output: (2,3,1,3,1,2) + +=cut +############################################################################### + +#--------------------------------------# +# Copyright © 2023 PerlMonk Athanasius # +#--------------------------------------# + +#============================================================================== +=comment + +Interface +--------- +If no command-line arguments are given, the test suite is run. + +Notes +----- +1. 'Wiggle sort' is also known as 'wave sort'. +2. If no solution is possible for a given input, the output is '()', which + represents the empty list. +3. The solution algorithm is described in [1]. +4. The algorithm for determining whether a given input list is wiggle-sortable + (by counting "medians") is given in [1], corrected in [2]. + +References +---------- +[1] John L., Answer to "How to wiggle sort an array in linear time complex- + ity?", Computer Science Stack Exchange (8 May, 2020), https://cs.stack + exchange.com/questions/125372/how-to-wiggle-sort-an-array-in-linear-time- + complexity + +[2] John L, Answer to "How to find wiggle sortable arrays? Did I misunderstand + John L.s' answer?" Computer Science Stack Exchange (25 April, 2022), + https://cs.stackexchange.com/questions/150886/how-to-find-wiggle-sortable- + arrays-did-i-misunderstand-john-l-s-answer + +=cut +#============================================================================== + +use strict; +use warnings; +use Const::Fast; +use POSIX qw( ceil ); +use Regexp::Common qw( number ); +use Test::More; + +const my $TEST_FIELDS => 3; +const my $USAGE => +"Usage: + perl $0 [<list> ...] + perl $0 + + [<list> ...] A list of 1 or more integers\n"; + +#------------------------------------------------------------------------------ +BEGIN +#------------------------------------------------------------------------------ +{ + $| = 1; + print "\nChallenge 197, Task #2: Wiggle Sort (Perl)\n\n"; +} + +#============================================================================== +MAIN: +#============================================================================== +{ + if (scalar @ARGV == 0) + { + run_tests(); + } + else + { + my @list = @ARGV; + + for (@list) + { + / ^ $RE{num}{int} $ /x + or die qq[ERROR: "$_" is not a valid integer\n$USAGE]; + } + + printf "Input: \@list = (%s)\n", join ', ', @list; + printf "Output: (%s)\n", join ', ', wiggle_sort( @list ); + } +} + +#------------------------------------------------------------------------------ +sub wiggle_sort +#------------------------------------------------------------------------------ +{ + my @list = @_; + my @sorted = (); + + if (is_wiggle_sortable( @list )) + { + @list = sort { $a <=> $b } @list; + + my $max_i = $#list; + + for my $i (1 .. $max_i) + { + next if $i % 2 == 0; + $sorted[ $i ] = pop @list; + } + + for my $j (0 .. $max_i) + { + next if $j % 2 == 1; + $sorted[ $j ] = pop @list; + } + + is_wiggle_sorted( @sorted ) or die 'Wiggle sort failed'; + } + + return @sorted; +} + +#------------------------------------------------------------------------------ +sub is_wiggle_sortable +#------------------------------------------------------------------------------ +{ + # Count "medians" (see [1] as corrected in [2]) + + my @list = sort { $a <=> $b } @_; # 1. Sort the list + my $n = scalar @list; # 2. Find m, the ⌈n/2⌉-th entry + my $n2 = ceil( $n / 2 ); + my $m = $list[ $n2 - 1 ]; + my $count = 0; # 3. Count entries equal to m + $_ == $m && ++$count for @list; + + # 4. "The number of medians of A is no more than ⌈n/2⌉. Furthermore, if n + # is odd and the number of medians is ⌈n/2⌉, the median must be the + # smallest number of A." -- [2], with typo corrected + + return ($count > $n2) ? 0 : + ($count < $n2) ? 1 : + ($n % 2 == 1) ? ($m == $list[ 0 ]) : 1; +} + +#------------------------------------------------------------------------------ +sub is_wiggle_sorted +#------------------------------------------------------------------------------ +{ + my @list = @_; + + for my $i (0 .. $#list - 1) + { + if ($i % 2 == 0) + { + return 0 unless $list[ $i ] < $list[ $i + 1 ]; + } + else + { + return 0 unless $list[ $i ] > $list[ $i + 1 ]; + } + } + + return 1; +} + +#------------------------------------------------------------------------------ +sub run_tests +#------------------------------------------------------------------------------ +{ + print "Running the test suite\n"; + + while (my $line = <DATA>) + { + chomp $line; + + my ($test_name, $input, $expected) = + split / \| /x, $line, $TEST_FIELDS; + + s/ ^ \s* (.+?) \s* $ /$1/x # Trim whitespace + for $test_name, $input, $expected; + + my @list = split / , /x, $input; + my @sorted = wiggle_sort( @list ); + my $got = join ',', @sorted; + + ok( is_wiggle_sorted( @sorted ), $test_name ) if $expected; + is( $got, $expected, $test_name ); + } + + done_testing; +} + +############################################################################### + +__DATA__ +Example 1 |1,5,1,1,6,4|1,6,1,5,1,4 +Example 2 |1,3,2,2,3,1|2,3,1,3,1,2 +Short |2,1,1 |1,2,1 +Not sortable|1,2,2 | +Distinct |5,4,3,2,1,0|2,5,1,4,0,3 +Single |42 |42 +Negatives |-1,-2,-3,-4|-3,-1,-4,-2 diff --git a/challenge-197/athanasius/raku/ch-1.raku b/challenge-197/athanasius/raku/ch-1.raku new file mode 100644 index 0000000000..669ed140bb --- /dev/null +++ b/challenge-197/athanasius/raku/ch-1.raku @@ -0,0 +1,178 @@ +use v6d; + +############################################################################### +=begin comment + +Perl Weekly Challenge 197 +========================= + +TASK #1 +------- +*Move Zero* + +Submitted by: Mohammad S Anwar + +You are given a list of integers, @list. + +Write a script to move all zero, if exists, to the end while maintaining the +relative order of non-zero elements. + +Example 1 + + Input: @list = (1, 0, 3, 0, 0, 5) + Output: (1, 3, 5, 0, 0, 0) + +Example 2 + + Input: @list = (1, 6, 4) + Output: (1, 6, 4) + +Example 3 + + Input: @list = (0, 1, 0, 2, 0) + Output: (1, 2, 0, 0, 0) + +=end comment +############################################################################### + +#--------------------------------------# +# Copyright © 2023 PerlMonk Athanasius # +#--------------------------------------# + +#============================================================================== +=begin comment + +Interface +--------- +1. If no command-line arguments are given, the test suite is run. +2. If the first argument is negative, it must be preceded by "--" to distin- + guish it from a command-line flag. + +Algorithm +--------- +1. Traverse the input list, counting zero values but copying non-zero values to + the output list. +2. Append the number of zero values encountered in the input list to the end of + the output list. + -- The list repetition operator 'xx' "returns a Sequence of $a [LHS] repeat- + ed and evaluated $b [RHS] times" (https://docs.raku.org/routine/xx). + +=end comment +#============================================================================== + +use Test; + +my UInt constant $TEST-FIELDS = 3; + +#------------------------------------------------------------------------------ +BEGIN +#------------------------------------------------------------------------------ +{ + "\nChallenge 197, Task #1: Move Zero (Raku)\n".put; +} + +#============================================================================== +multi sub MAIN +( + #| A list of 1 or more integers + + *@list where { .elems >= 1 && .all ~~ Int:D } +) +#============================================================================== +{ + "Input: \@list = (%s)\n".printf: @list .join: ', '; + + "Output: (%s)\n" .printf: move-zero( @list ).join: ', '; +} + +#============================================================================== +multi sub MAIN() # No input: run the test suite +#============================================================================== +{ + run-tests(); +} + +#------------------------------------------------------------------------------ +sub move-zero( List:D[Int:D] $list --> List:D[Int:D] ) +#------------------------------------------------------------------------------ +{ + my Int @moved; + my UInt $count = 0; + + for @$list -> Int $n + { + if $n == 0 + { + ++$count; + } + else + { + @moved.push: $n; + } + } + + @moved.push: |(0 xx $count); + + return @moved; +} + +#------------------------------------------------------------------------------ +sub run-tests() +#------------------------------------------------------------------------------ +{ + 'Running the test suite'.put; + + for test-data.lines -> Str $line + { + my Str ($test-name, $input, $expected) = + $line.split: / \| /, $TEST-FIELDS; + + $input ~~ s/ ^ \s* (.+?) \s* $ /$0/; # Trim whitespace + $expected ~~ s/ ^ \s* (.+?) \s* $ /$0/; + $expected ~~ s:g/ \s+ / /; + + my Int @list = $input.split( / \, \s* / ).map: { .Int }; + + my Str $got = move-zero( @list ).join: ', '; + + is $got, $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| 1, 0, 3, 0, 0, 5 | 1, 3, 5, 0, 0, 0 + Example 2| 1, 6, 4 | 1, 6, 4 + Example 3| 0, 1, 0, 2, 0 | 1, 2, 0, 0, 0 + Negatives|-1, 0, -2, -3, 0, 0, -4|-1, -2, -3, -4, 0, 0, 0 + END +} + +############################################################################### diff --git a/challenge-197/athanasius/raku/ch-2.raku b/challenge-197/athanasius/raku/ch-2.raku new file mode 100644 index 0000000000..ef2ad78ec8 --- /dev/null +++ b/challenge-197/athanasius/raku/ch-2.raku @@ -0,0 +1,239 @@ +use v6d; + +############################################################################### +=begin comment + +Perl Weekly Challenge 197 +========================= + +TASK #2 +------- +*Wiggle Sort* + +Submitted by: Mohammad S Anwar + +You are given a list of integers, @list. + +Write a script to perform Wiggle Sort on the given list. + + + Wiggle sort would be such as list[0] < list[1] > list[2] < list[3]…. + + +Example 1 + + Input: @list = (1,5,1,1,6,4) + Output: (1,6,1,5,1,4) + +Example 2 + + Input: @list = (1,3,2,2,3,1) + Output: (2,3,1,3,1,2) + +=end comment +############################################################################### + +#--------------------------------------# +# Copyright © 2023 PerlMonk Athanasius # +#--------------------------------------# + +#============================================================================== +=begin comment + +Interface +--------- +1. If no command-line arguments are given, the test suite is run. +2. If the first argument is negative, it must be preceded by "--" to distin- + guish it from a command-line flag. + +Notes +----- +1. 'Wiggle sort' is also known as 'wave sort'. +2. If no solution is possible for a given input, the output is '()', which + represents the empty list. +3. The solution algorithm is described in [1]. +4. The algorithm for determining whether a given input list is wiggle-sortable + (by counting "medians") is given in [1], corrected in [2]. + +References +---------- +[1] John L., Answer to "How to wiggle sort an array in linear time complex- + ity?", Computer Science Stack Exchange (8 May, 2020), https://cs.stack + exchange.com/questions/125372/how-to-wiggle-sort-an-array-in-linear-time- + complexity + +[2] John L, Answer to "How to find wiggle sortable arrays? Did I misunderstand + John L.s' answer?" Computer Science Stack Exchange (25 April, 2022), + https://cs.stackexchange.com/questions/150886/how-to-find-wiggle-sortable- + arrays-did-i-misunderstand-john-l-s-answer + +=end comment +#============================================================================== + +use Test; + +my UInt constant $TEST-FIELDS = 3; + +#------------------------------------------------------------------------------ +BEGIN +#------------------------------------------------------------------------------ +{ + "\nChallenge 197, Task #2: Wiggle Sort (Raku)\n".put; +} + +#============================================================================== +multi sub MAIN +( + #| A list of 1 or more integers + + *@list where { .elems >= 1 && .all ~~ Int:D } +) +#============================================================================== +{ + "Input: \@list = (%s)\n".printf: @list .join: ', '; + + "Output: (%s)\n" .printf: wiggle-sort( @list ).join: ', '; +} + +#============================================================================== +multi sub MAIN() # Run the test suite +#============================================================================== +{ + run-tests(); +} + +#------------------------------------------------------------------------------ +sub wiggle-sort( List:D[Int:D] $list --> List:D[Int:D] ) +#------------------------------------------------------------------------------ +{ + my Int @list = @$list; + my Int @sorted; + + if is-wiggle-sortable( @list ) + { + @list.=sort; + + my UInt $max-i = @list.end; + + for 1 .. $max-i -> UInt $i + { + next if $i %% 2; + @sorted[ $i ] = @list.pop; + } + + for 0 .. $max-i -> UInt $j + { + next if $j % 2 == 1; + @sorted[ $j ] = @list.pop; + } + + is-wiggle-sorted( @sorted ) or die 'Wiggle sort failed'; + } + + return @sorted; +} + +#------------------------------------------------------------------------------ +sub is-wiggle-sortable( List:D[Int:D] $list --> Bool:D ) +#------------------------------------------------------------------------------ +{ + # Count "medians" (see [1] as corrected in [2]) + + my Int @sorted = $list.sort; # 1. Sort the list + my UInt $n = @sorted.elems; # 2. Find m, the ⌈n/2⌉-th entry + my UInt $n2 = ($n / 2).ceiling; + my Int $m = @sorted[ $n2 - 1 ]; + my UInt $count = 0; # 3. Count entries equal to m + $_ == $m && ++$count for @sorted; + + # 4. "The number of medians of A is no more than ⌈n/2⌉. Furthermore, if n + # is odd and the number of medians is ⌈n/2⌉, the median must be the + # smallest number of A." -- [2], with typo corrected + + return ($count > $n2) ?? False !! + ($count < $n2) ?? True !! + ($n % 2 == 1) ?? ($m == @sorted[ 0 ]) !! True; +} + +#------------------------------------------------------------------------------ +sub is-wiggle-sorted( List:D[Int:D] $list --> Bool:D ) +#------------------------------------------------------------------------------ +{ + for 0 .. $list.end - 1 -> UInt $i + { + if $i %% 2 + { + return False unless $list[ $i ] < $list[ $i + 1 ]; + } + else + { + return False unless $list[ $i ] > $list[ $i + 1 ]; + } + } + + return True; +} + +#------------------------------------------------------------------------------ +sub run-tests() +#------------------------------------------------------------------------------ +{ + 'Running the test suite'.put; + + for test-data.lines -> Str $line + { + my Str ($test-name, $input, $expected) = + $line.split: / \| /, $TEST-FIELDS; + + s/ ^ \s* (.+?) \s* $ /$0/ # Trim whitespace + for $test-name, $input, $expected; + + my Int @list = $input.split( / \, /, :skip-empty ).map: { .Int }; + my Int @sorted = wiggle-sort( @list ); + my Str $got = @sorted.join: ','; + + ok( is-wiggle-sorted( @sorted ), $test-name ) if $expected; + is $got, $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 |1,5,1,1,6,4|1,6,1,5,1,4 + Example 2 |1,3,2,2,3,1|2,3,1,3,1,2 + Short |2,1,1 |1,2,1 + Not sortable|1,2,2 | + Distinct |5,4,3,2,1,0|2,5,1,4,0,3 + Single |42 |42 + Negatives |-1,-2,-3,-4|-3,-1,-4,-2 + END +} + +############################################################################### |