diff options
| -rw-r--r-- | challenge-140/athanasius/perl/BinUInt.pm | 95 | ||||
| -rw-r--r-- | challenge-140/athanasius/perl/ch-1.pl | 121 | ||||
| -rw-r--r-- | challenge-140/athanasius/perl/ch-2.pl | 222 | ||||
| -rw-r--r-- | challenge-140/athanasius/raku/BinUInt.rakumod | 106 | ||||
| -rw-r--r-- | challenge-140/athanasius/raku/ch-1.raku | 111 | ||||
| -rw-r--r-- | challenge-140/athanasius/raku/ch-2.raku | 195 |
6 files changed, 850 insertions, 0 deletions
diff --git a/challenge-140/athanasius/perl/BinUInt.pm b/challenge-140/athanasius/perl/BinUInt.pm new file mode 100644 index 0000000000..438475910a --- /dev/null +++ b/challenge-140/athanasius/perl/BinUInt.pm @@ -0,0 +1,95 @@ +#!perl + +############################################################################### +=comment + +Perl Weekly Challenge 140, TASK #1: Add Binary + +=cut +############################################################################### + +#--------------------------------------# +# Copyright © 2021 PerlMonk Athanasius # +#--------------------------------------# + +#============================================================================== +=comment + +The "+" operator is overloaded via the _binary_add() subroutine, which adds two +binary numbers digit-by-digit, moving from the least significant digits to the +most significant digits. (Leading zeros are first added to the smaller of the +two binary numbers to simplify the implementation logic.) + +=cut +#============================================================================== + +use strict; +use warnings; + +#============================================================================== +package BinUInt; +#============================================================================== + +use overload '+' => \&_binary_add; # Binary addition +use overload '""' => sub { $_[ 0 ]->{ value } }; # Stringification + +#------------------------------------------------------------------------------ +sub new # Constructor +#------------------------------------------------------------------------------ +{ + my ($class, $str) = @_; + + $str =~ / ^ [01]+ $ /x + or die qq["$str" is not a valid binary number\n]; + + $str =~ s/ ^ 0+ (?=[01]) //x; # Trim leading zeros + + my $self = { value => $str }; + + return bless $self, $class; +} + +#------------------------------------------------------------------------------ +sub _binary_add +#------------------------------------------------------------------------------ +{ + my ($self, $other, $swap) = @_; + my $lhs_len = length $self ->{ value }; + my $rhs_len = length $other->{ value }; + my $max_len = $lhs_len >= $rhs_len ? $lhs_len : $rhs_len; + my $carry = 0; + my @lhs = reverse split //, $self ->{ value }; + my @rhs = reverse split //, $other->{ value }; + my @sum; + push @lhs, '0' while scalar( @lhs ) < $max_len; + push @rhs, '0' while scalar( @rhs ) < $max_len; + + for my $i (0 .. $max_len - 1) + { + my $subtotal = $lhs[ $i ] + $rhs[ $i ] + $carry; + + if ($subtotal == 3) + { + $sum[ $i ] = 1; + $carry = 1; + } + elsif ($subtotal == 2) + { + $sum[ $i ] = 0; + $carry = 1; + } + else # 1 or 0 + { + $sum[ $i ] = $subtotal; + $carry = 0; + } + } + + push @sum, 1 if $carry; + + return BinUInt->new( join '', reverse @sum ); +} + +############################################################################### +1; +############################################################################### diff --git a/challenge-140/athanasius/perl/ch-1.pl b/challenge-140/athanasius/perl/ch-1.pl new file mode 100644 index 0000000000..6859838934 --- /dev/null +++ b/challenge-140/athanasius/perl/ch-1.pl @@ -0,0 +1,121 @@ +#!perl + +############################################################################### +=comment + +Perl Weekly Challenge 140 +========================= + +TASK #1 +------- +*Add Binary* + +Submitted by: Mohammad S Anwar + +You are given two decimal-coded binary numbers, $a and $b. + +Write a script to simulate the addition of the given binary numbers. + + The script should simulate something like $a + $b. (operator overloading) + +Example 1 + + Input: $a = 11; $b = 1; + Output: 100 + +Example 2 + + Input: $a = 101; $b = 1; + Output: 110 + +Example 3 + + Input: $a = 100; $b = 11; + Output: 111 + +=cut +############################################################################### + +#--------------------------------------# +# Copyright © 2021 PerlMonk Athanasius # +#--------------------------------------# + +#============================================================================== +=comment + +Assumptions +----------- +- "Decimal-coded binary numbers" are just binary numbers +- These binary numbers are restricted to non-negative integers +- Leading zeros are allowed, but will be trimmed + +Solution +-------- +The file BinUInt.pm contains the implementation of BinUInt, a class which +comprises a constructor and two overloaded operators: stringification (trivial) +and addition. The latter performs binary addition using the same logic that a +human would use to add two binary numbers together manually. + +=cut +#============================================================================== + +use strict; +use warnings; +use Const::Fast; +use Try::Tiny; +use lib qw( . ); +use BinUInt; + +const my $USAGE => +"Usage: + perl $0 <a> <b> + + <a> A non-negative integer in binary + <b> A non-negative integer in binary\n"; + +#------------------------------------------------------------------------------ +BEGIN +#------------------------------------------------------------------------------ +{ + $| = 1; + print "\nChallenge 140, Task #1: Add Binary (Perl)\n\n"; +} + +#============================================================================== +MAIN: +#============================================================================== +{ + my $args = scalar @ARGV; + $args == 2 + or error( "Expected 2 command line arguments, found $args\n" ); + + my ($a_str, $b_str) = @ARGV; + my ($a_obj, $b_obj); + + try + { + $a_obj = BinUInt->new( $a_str ); + $b_obj = BinUInt->new( $b_str ); + } + catch + { + error( $_ ); + }; + + print "Input: \$a = $a_obj; \$b = $b_obj\n"; + + my $sum_obj = $a_obj + $b_obj; # Use operator overloading + + print "Output: $sum_obj\n"; +} + +#------------------------------------------------------------------------------ +sub error +#------------------------------------------------------------------------------ +{ + my ($message) = @_; + + die "ERROR: $message$USAGE"; +} + +############################################################################### diff --git a/challenge-140/athanasius/perl/ch-2.pl b/challenge-140/athanasius/perl/ch-2.pl new file mode 100644 index 0000000000..3dcd1abcbf --- /dev/null +++ b/challenge-140/athanasius/perl/ch-2.pl @@ -0,0 +1,222 @@ +#!perl + +############################################################################### +=comment + +Perl Weekly Challenge 140 +========================= + +TASK #2 +------- +*Multiplication Table* + +Submitted by: Mohammad S Anwar + +You are given 3 positive integers, $i, $j and $k. + +Write a script to print the $kth element in the sorted multiplication table of +$i and $j. + +Example 1 + + Input: $i = 2; $j = 3; $k = 4 + Output: 3 + + Since the multiplication of 2 x 3 is as below: + + 1 2 3 + 2 4 6 + + The sorted multiplication table: + + 1 2 2 3 4 6 + + Now the 4th element in the table is "3". + +Example 2 + + Input: $i = 3; $j = 3; $k = 6 + Output: 4 + + Since the multiplication of 3 x 3 is as below: + + 1 2 3 + 2 4 6 + 3 6 9 + + The sorted multiplication table: + + 1 2 2 3 3 4 6 6 9 + + Now the 6th element in the table is "4". + +=cut +############################################################################### + +#--------------------------------------# +# Copyright © 2021 PerlMonk Athanasius # +#--------------------------------------# + +#============================================================================== +=comment + +Assumption +---------- +A "positive integer" is an integer greater than or equal to one. + +Configuration +------------- +Set $VERBOSE to a true value (the default) to display an explanation of the +output like that in the Examples. Set it to a false value to remove the explan- +ation. + +Algorithm +--------- +(Straightforward:) construct the multiplication table; sort it in ascending +numerical order; then index it to obtain the desired output. + +=cut +#============================================================================== + +use strict; +use warnings; +use Const::Fast; +use Regexp::Common qw( number ); + +const my $VERBOSE => 1; +const my $USAGE => +"Usage: + perl $0 <i> <j> <k> + + <i> Positive integer: maximum multiplier for the table + <j> Positive integer: maximum multiplicand for the table + <k> Positive integer: 1-based index into the sorted table\n"; + +#------------------------------------------------------------------------------ +BEGIN +#------------------------------------------------------------------------------ +{ + $| = 1; + print "\nChallenge 140, Task #2: Multiplication Table (Perl)\n\n"; +} + +#============================================================================== +MAIN: +#============================================================================== +{ + my ($i, $j, $k) = parse_command_line(); + + print "Input: \$i = $i; \$j = $j; \$k = $k\n"; + + my @table; + + for my $row (1 .. $i) # Construct the table + { + for my $col (1 .. $j) + { + push @table, $col * $row; + } + } + + my @sorted = sort { $a <=> $b } @table; # Sort the table + my $element = $sorted[ $k - 1 ]; # Index the sorted table + + print "Output: $element\n"; + + explain( $i, $j, $k, \@table, \@sorted, $element ) if $VERBOSE; +} + +#------------------------------------------------------------------------------ +sub explain +#------------------------------------------------------------------------------ +{ + my ($i, $j, $k, $table, $sorted, $element) = @_; + + print "\nSince the multiplication of $i x $j is as below:\n"; + + # (1) Pre-compute table column widths + + my @widths; + + for my $idx (($i - 1) * $j .. $i * $j - 1) + { + push @widths, length $table->[ $idx ]; + } + + # (2) Print the table + + for my $row (0 .. $i - 1) + { + print ' '; + + for my $idx ($row * $j .. ($row + 1) * $j - 1) + { + printf ' %*d', $widths[ $idx % $j ], $table->[ $idx ]; + } + + print "\n"; + } + + # (3) Print the contents of the sorted table + + printf "\nThe sorted multiplication table:\n\n %s\n", + join ' ', @$sorted; + + # (4) Explain the output + + printf qq[\nNow the %s element in the table is "%d".\n], + ordinal( $k ), $element; +} + +#------------------------------------------------------------------------------ +sub ordinal +#------------------------------------------------------------------------------ +{ + my ($n) = @_; + my $suffix = 'th'; + my $digit0 = substr $n, -1, 1; + + if (length $n < 2 || substr( $n, -2, 1 ) ne '1') + { + $suffix = $digit0 eq '1' ? 'st' : + $digit0 eq '2' ? 'nd' : + $digit0 eq '3' ? 'rd' : 'th'; + } + + return $n . $suffix; +} + +#------------------------------------------------------------------------------ +sub parse_command_line +#------------------------------------------------------------------------------ +{ + my $args = scalar @ARGV; + $args == 3 or error( "Expected 3 command line arguments, found $args" ); + + my ($i, $j, $k) = @ARGV; + + for my $n ($i, $j, $k) + { + $n =~ / ^ $RE{num}{int} $ /x + or error( qq["$n" is not a valid integer] ); + + $n > 0 or error( qq["$n" is not positive] ); + } + + # Check that $k is a valid index + + $k <= $i * $j or error( "\$k = $k is too large" ); + + return ($i, $j, $k); +} + +#------------------------------------------------------------------------------ +sub error +#------------------------------------------------------------------------------ +{ + my ($message) = @_; + + die "ERROR: $message\n$USAGE"; +} + +############################################################################### diff --git a/challenge-140/athanasius/raku/BinUInt.rakumod b/challenge-140/athanasius/raku/BinUInt.rakumod new file mode 100644 index 0000000000..325962d811 --- /dev/null +++ b/challenge-140/athanasius/raku/BinUInt.rakumod @@ -0,0 +1,106 @@ +use v6d; + +############################################################################### +=begin comment + +Perl Weekly Challenge 140, TASK #1: Add Binary + +=end comment +############################################################################### + +#--------------------------------------# +# Copyright © 2021 PerlMonk Athanasius # +#--------------------------------------# + +#============================================================================== +=begin comment + +The "+" operator is overloaded for BinUInt objects. It adds two binary numbers +digit-by-digit, moving from the least significant digits to the most signifi- +cant digits. (Leading zeros are first added to the smaller of the two binary +numbers to simplify the implementation logic.) + +=end comment +#============================================================================== + +class X::BinUInt::Invalid { ... } # Forward declaration + +#============================================================================== +class BinUInt +#============================================================================== +{ + has Str $.value; + + #-------------------------------------------------------------------------- + submethod BUILD( Str:D :$!value ) + #-------------------------------------------------------------------------- + { + $!value ~~ / ^ <[01]>+ $ / + or X::BinUInt::Invalid.new( value => $!value ).throw; + + $!value ~~ s/ ^ 0+ <?[01]> //; # Trim leading zeros + } +} + +#============================================================================== +multi sub infix:<+>( BinUInt:D $a, BinUInt:D $b --> BinUInt:D ) is export +#============================================================================== +{ + my UInt $lhs-len = $a.value.chars; + my UInt $rhs-len = $b.value.chars; + my UInt $max-len = $lhs-len >= $rhs-len ?? $lhs-len !! $rhs-len; + my UInt $carry = 0; + my Str @lhs = $a.value.split( '', :skip-empty ).reverse; + my Str @rhs = $b.value.split( '', :skip-empty ).reverse; + my UInt @sum; + + @lhs.push: '0' while @lhs.elems < $max-len; + @rhs.push: '0' while @rhs.elems < $max-len; + + for 0 .. $max-len - 1 -> UInt $i + { + my UInt $subtotal = @lhs[ $i ] + @rhs[ $i ] + $carry; + + if $subtotal == 3 + { + @sum[ $i ] = 1; + $carry = 1; + } + elsif $subtotal == 2 + { + @sum[ $i ] = 0; + $carry = 1; + } + else # 1 or 0 + { + @sum[ $i ] = $subtotal; + $carry = 0; + } + } + + @sum.push: 1 if $carry; + + return BinUInt.new: value => @sum.reverse.join; +} + +#============================================================================== +class X::BinUInt::Invalid is Exception +#============================================================================== +{ + has Str $!value; + + #-------------------------------------------------------------------------- + submethod BUILD( Str:D :$!value ) + #-------------------------------------------------------------------------- + { + } + + #-------------------------------------------------------------------------- + method message( --> Str:D ) + #-------------------------------------------------------------------------- + { + return qq["$!value" is not a valid binary number]; + } +} + +############################################################################## diff --git a/challenge-140/athanasius/raku/ch-1.raku b/challenge-140/athanasius/raku/ch-1.raku new file mode 100644 index 0000000000..bff6af2421 --- /dev/null +++ b/challenge-140/athanasius/raku/ch-1.raku @@ -0,0 +1,111 @@ +use v6d; + +############################################################################### +=begin comment + +Perl Weekly Challenge 140 +========================= + +TASK #1 +------- +*Add Binary* + +Submitted by: Mohammad S Anwar + +You are given two decimal-coded binary numbers, $a and $b. + +Write a script to simulate the addition of the given binary numbers. + + The script should simulate something like $a + $b. (operator overloading) + +Example 1 + + Input: $a = 11; $b = 1; + Output: 100 + +Example 2 + + Input: $a = 101; $b = 1; + Output: 110 + +Example 3 + + Input: $a = 100; $b = 11; + Output: 111 + +=end comment +############################################################################### + +#--------------------------------------# +# Copyright © 2021 PerlMonk Athanasius # +#--------------------------------------# + +#============================================================================== +=begin comment + +Assumptions +----------- +- "Decimal-coded binary numbers" are just binary numbers +- These binary numbers are restricted to non-negative integers +- Leading zeros are allowed, but will be trimmed. + +Solution +-------- +The file BinUInt.rakumod contains the implementation of classes BinUInt (for +representing binary numbers) and X::BinUInt::Invalid (for error-reporting). +Binary addition is performed by sub infix:<+>, which is overloaded for BinUInt +objects. This overloaded + operator performs binary addition using the same +logic that a human would use to add two binary numbers together manually. + +=end comment +#============================================================================== + +use lib < . >; +use BinUInt; + +#------------------------------------------------------------------------------ +BEGIN +#------------------------------------------------------------------------------ +{ + "\nChallenge 140, Task #1: Add Binary (Raku)\n".put; +} + +#============================================================================== +sub MAIN +( + Str:D $a, #= A non-negative binary integer + Str:D $b #= A non-negative binary integer +) +#============================================================================== +{ + my BinUInt $a-obj = BinUInt.new: value => $a; + my BinUInt $b-obj = BinUInt.new: value => $b; + + "Input: \$a = %s; \$b = %s\n".printf: $a-obj.value, $b-obj.value; + + my BinUInt $sum-obj = $a-obj + $b-obj; # Use operator overloading + + "Output: %s\n".printf: $sum-obj.value; + + CATCH + { + when X::BinUInt::Invalid + { + ('ERROR: ' ~ .message).put; + USAGE; + } + } +} + +#------------------------------------------------------------------------------ +sub USAGE() +#------------------------------------------------------------------------------ +{ + my Str $usage = $*USAGE; + + $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/; + + $usage.put; +} + +############################################################################## diff --git a/challenge-140/athanasius/raku/ch-2.raku b/challenge-140/athanasius/raku/ch-2.raku new file mode 100644 index 0000000000..0de9d2c785 --- /dev/null +++ b/challenge-140/athanasius/raku/ch-2.raku @@ -0,0 +1,195 @@ +use v6d; + +############################################################################### +=begin comment + +Perl Weekly Challenge 140 +========================= + +TASK #2 +------- +*Multiplication Table* + +Submitted by: Mohammad S Anwar + +You are given 3 positive integers, $i, $j and $k. + +Write a script to print the $kth element in the sorted multiplication table of +$i and $j. + +Example 1 + + Input: $i = 2; $j = 3; $k = 4 + Output: 3 + + Since the multiplication of 2 x 3 is as below: + + 1 2 3 + 2 4 6 + + The sorted multiplication table: + + 1 2 2 3 4 6 + + Now the 4th element in the table is "3". + +Example 2 + + Input: $i = 3; $j = 3; $k = 6 + Output: 4 + + Since the multiplication of 3 x 3 is as below: + + 1 2 3 + 2 4 6 + 3 6 9 + + The sorted multiplication table: + + 1 2 2 3 3 4 6 6 9 + + Now the 6th element in the table is "4". + +=end comment +############################################################################### + +#--------------------------------------# +# Copyright © 2021 PerlMonk Athanasius # +#--------------------------------------# + +#============================================================================== +=begin comment + +Assumption +---------- +A "positive integer" is an integer greater than or equal to one. + +Configuration +------------- +Set $VERBOSE to True (the default) to display an explanation of the output like +that in the Examples. Set it to False to remove the explanation. + +Algorithm +--------- +(Straightforward:) Construct the multiplication table; sort it in ascending +numerical order; then index it to obtain the desired output. + +=end comment +#============================================================================== + +my Bool constant $VERBOSE = True; + +subset Positive of Int where * > 0; + +#------------------------------------------------------------------------------ +BEGIN +#------------------------------------------------------------------------------ +{ + "\nChallenge 140, Task #2: Multiplication Table (Raku)\n".put; +} + +#============================================================================== +sub MAIN +( + Positive:D $i, #= Positive integer: maximum multiplier for the table + Positive:D $j, #= Positive integer: maximum multiplicand for the table + Positive:D $k where * <= $i * $j + #= Positive integer: 1-based index into the sorted table +) +#============================================================================== +{ + "Input: \$i = $i; \$j = $j; \$k = $k".put; + + my Positive @table; + + for 1 .. $i -> Positive $row # Create the table + { + for 1 .. $j -> Positive $col + { + @table.push: $col * $row; + } + } + + my Positive @sorted = @table.sort; # Sort the table + my Positive $element = @sorted[ $k - 1 ]; # Index the sorted table + + "Output: $element".put; + + explain( $i, $j, $k, @table, @sorted, $element ) if $VERBOSE; +} + +#------------------------------------------------------------------------------ +sub explain +( + Positive:D $i, + Positive:D $j, + Positive:D $k where * <= $i * $j, + Array:D[Positive:D] $table, + Array:D[Positive:D] $sorted, + Positive:D $element +) +#------------------------------------------------------------------------------ +{ + "\nSince the multiplication of $i x $j is as below:\n".put; + + # (1) Pre-compute table column widths + + my Positive @widths; + + for ($i - 1) * $j .. $i * $j - 1 -> UInt $idx + { + @widths.push: $table[ $idx ].chars; + } + + # (2) Print the table + + for 0 .. $i - 1 -> UInt $row + { + ' '.print; + + for $row * $j .. ($row + 1) * $j - 1 -> UInt $idx + { + ' %*d'.printf: @widths[ $idx % $j ], $table[ $idx ]; + } + + put(); + } + + # (3) Print the contents of the sorted table + + "\nThe sorted multiplication table:\n\n %s\n".printf: $sorted.join: ' '; + + # (4) Explain the output + + qq[\nNow the %s element in the table is "%d".\n].printf: + ordinal( $k ), $element; +} + +#------------------------------------------------------------------------------ +sub ordinal( Positive:D $n --> Str:D ) +#------------------------------------------------------------------------------ +{ + my Str $suffix = 'th'; + my Str $digit0 = $n.substr: *-1, 1; + + if $n.chars < 2 || $n.substr( *-2, 1 ) ne '1' + { + $suffix = $digit0 eq '1' ?? 'st' !! + $digit0 eq '2' ?? 'nd' !! + $digit0 eq '3' ?? 'rd' !! 'th'; + } + + return $n ~ $suffix; +} + +#------------------------------------------------------------------------------ +sub USAGE() +#------------------------------------------------------------------------------ +{ + my Str $usage = $*USAGE; + + $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/; + $usage.put; +} + +############################################################################## |