From 78ad9bd4f1cdbe64a7e933be8ecee27eb9273391 Mon Sep 17 00:00:00 2001 From: PerlMonk-Athanasius Date: Sat, 27 Apr 2024 23:44:19 +1000 Subject: Perl & Raku solutions to Tasks 1 & 2 for Week 266 --- challenge-266/athanasius/perl/ch-1.pl | 203 +++++++++++++++++++++++ challenge-266/athanasius/perl/ch-2.pl | 267 ++++++++++++++++++++++++++++++ challenge-266/athanasius/raku/ch-1.raku | 193 ++++++++++++++++++++++ challenge-266/athanasius/raku/ch-2.raku | 277 ++++++++++++++++++++++++++++++++ 4 files changed, 940 insertions(+) create mode 100644 challenge-266/athanasius/perl/ch-1.pl create mode 100644 challenge-266/athanasius/perl/ch-2.pl create mode 100644 challenge-266/athanasius/raku/ch-1.raku create mode 100644 challenge-266/athanasius/raku/ch-2.raku diff --git a/challenge-266/athanasius/perl/ch-1.pl b/challenge-266/athanasius/perl/ch-1.pl new file mode 100644 index 0000000000..b417c1e6b6 --- /dev/null +++ b/challenge-266/athanasius/perl/ch-1.pl @@ -0,0 +1,203 @@ +#!perl + +################################################################################ +=comment + +Perl Weekly Challenge 266 +========================= + +TASK #1 +------- +*Uncommon Words* + +Submitted by: Mohammad Sajid Anwar + +You are given two sentences, $line1 and $line2. + +Write a script to find all uncommmon words in any order in the given two sen- +tences. Return ('') if none found. + + A word is uncommon if it appears exactly once in one of the sentences and + doesn't appear in other sentence. + +Example 1 + + Input: $line1 = 'Mango is sweet' + $line2 = 'Mango is sour' + Output: ('sweet', 'sour') + +Example 2 + + Input: $line1 = 'Mango Mango' + $line2 = 'Orange' + Output: ('Orange') + +Example 3 + + Input: $line1 = 'Mango is Mango' + $line2 = 'Orange is Orange' + Output: ('') + +=cut +################################################################################ + +#--------------------------------------# +# Copyright © 2024 PerlMonk Athanasius # +#--------------------------------------# + +#=============================================================================== +=comment + +Assumptions +----------- +1. Word-matching within and between sentences is case-insensitive. +2. Singular and plural forms are treated as distinct words. +3. Two or more hyphens together are treated as a word-separating dash. +4. A single hyphen is assumed to be "hard" and is retained within a word. +5. The possessive forms ending in "'s" or "'" are ignored when matching words. +6. Other punctuation symbols (commas, full stops, colons, semicolons, question + marks, exclamation marks, single quotes, and double quotes) are treated as + word-separators but otherwise ignored. + +Interface +--------- +1. If no command-line arguments are given, the test suite is run. Otherwise: +2. The input sentences are entered as two strings on the command-line. + +=cut +#=============================================================================== + +use v5.32.1; # Enables strictures +use warnings; +use Const::Fast; +use Test::More; + +const my $USAGE => < + perl $0 + + The first sentence + The second sentence +END + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + $| = 1; + print "\nChallenge 266, Task #1: Uncommon Words (Perl)\n\n"; +} + +#=============================================================================== +MAIN: +#=============================================================================== +{ + my $argc = scalar @ARGV; + + if ($argc == 0) + { + run_tests(); + } + elsif ($argc == 2) + { + my ($line1, $line2) = @ARGV; + + print "Input: \$line1 = '$line1'\n"; + print " \$line2 = '$line2'\n"; + + my $uncommon_words = find_uncommon_words( $line1, $line2 ); + + printf "Output: (%s)\n", scalar @$uncommon_words == 0 ? "''" : + join ', ', map { "'$_'" } @$uncommon_words; + } + else + { + error( "Expected 0 or 2 command-line arguments, found $argc" ); + } +} + +#------------------------------------------------------------------------------- +sub find_uncommon_words +#------------------------------------------------------------------------------- +{ + my ($line1, $line2) = @_; + + my @words = filter_words( $line1 ); + push @words, filter_words( $line2 ); + + my %dict; + ++$dict{ $_ } for map { lc() } @words; + + my @uncommon; + + for my $word (@words) + { + push @uncommon, $word if $dict{ lc $word } == 1; + } + + return \@uncommon; +} + +#------------------------------------------------------------------------------- +sub filter_words +#------------------------------------------------------------------------------- +{ + my ($line) = @_; + + $line =~ s{ \-{2,} }{ }gx; # Convert dashes to spaces + $line =~ s{ (?<= \w) \' s? }{}gx; # Remove possessive markers + $line =~ s{ [.,;:!?'"] }{ }gx; # Convert punctuation to spaces + + return grep { / \S /x } split / \s+ /x, $line; # Find (non-empty) words +} + +#------------------------------------------------------------------------------- +sub run_tests +#------------------------------------------------------------------------------- +{ + print "Running the test suite\n"; + + while (my $line = ) + { + chomp $line; + + my ($test_name, $line1, $line2, $expected_str) = split / \| /x, $line; + + for ($test_name, $line1, $line2, $expected_str) + { + s/ ^ \s+ //x; + s/ \s+ $ //x; + } + + my $uncommon_words = find_uncommon_words( $line1, $line2 ); + my @expected_words = split / \s+ /x, $expected_str; + + is_deeply $uncommon_words, \@expected_words, $test_name; + } + + done_testing; +} + +#------------------------------------------------------------------------------- +sub error +#------------------------------------------------------------------------------- +{ + my ($message) = @_; + + die "ERROR: $message\n$USAGE"; +} + +################################################################################ + +__DATA__ +Example 1 |Mango is sweet |Mango is sour |sweet sour +Example 2 |Mango Mango |Orange |Orange +Example 3 |Mango is Mango |Orange is Orange | +Case |The cat is on the mat|A dog is on a log |cat mat dog log +Plurals |This dog likes dogs |This dog likes cats |dogs cats +Possessives|Pete is my son's son |Pete is my grandson |grandson +Dash |Sue--my favourite. |Is Sue my favourite? |Is +Hyphen |Implement: egg-beater|Egg implement |egg-beater Egg +Punctuation|Sue has a book. |Does Sue have a book?|has Does have +Quotes |"Mango" is sweet |Mango is 'sour' |sweet sour diff --git a/challenge-266/athanasius/perl/ch-2.pl b/challenge-266/athanasius/perl/ch-2.pl new file mode 100644 index 0000000000..ecb2f6567d --- /dev/null +++ b/challenge-266/athanasius/perl/ch-2.pl @@ -0,0 +1,267 @@ +#!perl + +################################################################################ +=comment + +Perl Weekly Challenge 266 +========================= + +TASK #2 +------- +*X Matrix* + +Submitted by: Mohammad Sajid Anwar + +You are given a square matrix, $matrix. + +Write a script to find if the given matrix is X Matrix. + + A square matrix is an X Matrix if all the elements on the main diagonal and + antidiagonal are non-zero and everything else are zero. + +Example 1 + + Input: $matrix = [ [1, 0, 0, 2], + [0, 3, 4, 0], + [0, 5, 6, 0], + [7, 0, 0, 1], + ] + Output: true + +Example 2 + + Input: $matrix = [ [1, 2, 3], + [4, 5, 6], + [7, 8, 9], + ] + Output: false + +Example 3 + + Input: $matrix = [ [1, 0, 2], + [0, 3, 0], + [4, 0, 5], + ] + Output: true + +=cut +################################################################################ + +#--------------------------------------# +# Copyright © 2024 PerlMonk Athanasius # +#--------------------------------------# + +#=============================================================================== +=comment + +Assumption +---------- +Matrix elements are integers. + +Interface +--------- +1. If no command-line arguments are given, the test suite is run. Otherwise: +2. The input matrix is entered on the command-line as a non-empty list of + strings (the matrix rows) containing elements separated by whitespace. For + example, the matrix: + + [ 1 1 0 ] + [ 0 1 0 ] + [ 0 0 0 ] + + is entered as: >perl ch-2.pl "1 1 0" "0 1 0" "0 0 1" + +Note +---- +Matrix-handling code is adapted from the solutions to Task 2 for Week 248 and +Task 2 for Week 257. + +=cut +#=============================================================================== + +use v5.32.1; # Enables strictures +use warnings; +use Const::Fast; +use Regexp::Common qw( number ); +use Test::More; + +const my $USAGE => < ...] + perl $0 + + [ ...] A square and non-empty integer matrix +END + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + $| = 1; + print "\nChallenge 266, Task #2: X Matrix (Perl)\n\n"; +} + +#=============================================================================== +MAIN: +#=============================================================================== +{ + if (scalar @ARGV == 0) + { + run_tests(); + } + else + { + my $matrix = parse_matrix( \@ARGV ); + + print_matrix( 'Input: $matrix = ', $matrix ); + + my $x_matrix = is_x_matrix( $matrix ); + + printf "Output: %s\n", $x_matrix ? 'true' : 'false'; + } +} + +#------------------------------------------------------------------------------- +sub is_x_matrix +#------------------------------------------------------------------------------- +{ + my ($matrix) = @_; + my $end = $#$matrix; + + for my $row (0 .. $end) + { + for my $col (0 .. $end) + { + if ($row == $col || # On the main diagonal + $row + $col == $end) # On the antidiagonal + { + return 0 if $matrix->[ $row ][ $col ] == 0; + } + else + { + return 0 unless $matrix->[ $row ][ $col ] == 0; + } + } + } + + return 1; +} + +#------------------------------------------------------------------------------- +sub parse_matrix +#------------------------------------------------------------------------------- +{ + my ($rows) = @_; + my (@matrix, $cols); + + for my $row_str (@$rows) + { + my @row; + + for my $elem (grep { / \S /x } split / \s+ /x, $row_str) + { + if ($elem =~ / ^ $RE{num}{int} $ /x) + { + push @row, $elem; + } + else + { + error( qq[Element "$elem" is not a valid integer] ); + } + } + + scalar @row > 0 or error( 'Empty row' ); + push @matrix, \@row; + + if (defined $cols) + { + scalar @row == $cols or error( 'The input matrix is ragged' ); + } + else # Initialize $cols + { + $cols = scalar @row; + $cols == scalar @$rows or error( 'The input matrix is not square' ); + } + } + + return \@matrix; +} + +#------------------------------------------------------------------------------- +sub print_matrix +#------------------------------------------------------------------------------- +{ + my ($prefix, $matrix) = @_; + my $tab = ' ' x length $prefix; + my @width = (1) x scalar @{ $matrix->[ 0 ] }; + + for my $row (@$matrix) + { + for my $i (0 .. $#$row) + { + my $w = length $row->[ $i ]; + + $width[ $i ] = $w if $w > $width[ $i ]; + } + } + + print "$prefix\[\n"; + + for my $row (@$matrix) + { + my @row_str; + + for my $i (0 .. $#$row) + { + push @row_str, sprintf '%*d', $width[ $i ], $row->[ $i ]; + } + + printf "%s [%s]\n", $tab, join ', ', @row_str; + } + + print "$tab]\n"; +} + +#------------------------------------------------------------------------------- +sub run_tests +#------------------------------------------------------------------------------- +{ + print "Running the test suite\n"; + + while (my $line = ) + { + chomp $line; + + my ($test_name, $matrix_str, $expected) = split / \| /x, $line; + + for ($test_name, $matrix_str, $expected) + { + s/ ^ \s+ //x; + s/ \s+ $ //x; + } + + my @rows = split / \; /x, $matrix_str; + my $matrix = parse_matrix( \@rows ); + my $x_matrix = is_x_matrix( $matrix ); + + is $x_matrix, $expected, $test_name; + } + + done_testing; +} + +#------------------------------------------------------------------------------- +sub error +#------------------------------------------------------------------------------- +{ + my ($message) = @_; + + die "ERROR: $message\n$USAGE"; +} + +################################################################################ + +__DATA__ +Example 1|1 0 0 2; 0 3 4 0; 0 5 6 0; 7 0 0 1|1 +Example 2|1 2 3 ; 4 5 6 ; 7 8 9 |0 +Example 3|1 0 2 ; 0 3 0 ; 4 0 5 |1 diff --git a/challenge-266/athanasius/raku/ch-1.raku b/challenge-266/athanasius/raku/ch-1.raku new file mode 100644 index 0000000000..74effc2d83 --- /dev/null +++ b/challenge-266/athanasius/raku/ch-1.raku @@ -0,0 +1,193 @@ +use v6d; + +################################################################################ +=begin comment + +Perl Weekly Challenge 266 +========================= + +TASK #1 +------- +*Uncommon Words* + +Submitted by: Mohammad Sajid Anwar + +You are given two sentences, $line1 and $line2. + +Write a script to find all uncommmon words in any order in the given two sen- +tences. Return ('') if none found. + + A word is uncommon if it appears exactly once in one of the sentences and + doesn't appear in other sentence. + +Example 1 + + Input: $line1 = 'Mango is sweet' + $line2 = 'Mango is sour' + Output: ('sweet', 'sour') + +Example 2 + + Input: $line1 = 'Mango Mango' + $line2 = 'Orange' + Output: ('Orange') + +Example 3 + + Input: $line1 = 'Mango is Mango' + $line2 = 'Orange is Orange' + Output: ('') + +=end comment +################################################################################ + +#--------------------------------------# +# Copyright © 2024 PerlMonk Athanasius # +#--------------------------------------# + +#=============================================================================== +=begin comment + +Assumptions +----------- +1. Word-matching within and between sentences is case-insensitive. +2. Singular and plural forms are treated as distinct words. +3. Two or more hyphens together are treated as a word-separating dash. +4. A single hyphen is assumed to be "hard" and is retained within a word. +5. The possessive forms ending in "'s" or "'" are ignored when matching words. +6. Other punctuation symbols (commas, full stops, colons, semicolons, question + marks, exclamation marks, single quotes, and double quotes) are treated as + word-separators but otherwise ignored. + +Interface +--------- +1. If no command-line arguments are given, the test suite is run. Otherwise: +2. The input sentences are entered as two strings on the command-line. + +=end comment +#=============================================================================== + +use Test; + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + "\nChallenge 266, Task #1: Uncommon Words (Raku)\n".put; +} + +#=============================================================================== +multi sub MAIN +( + Str:D $line1, #= The first sentence + Str:D $line2 #= The second sentence +) +#=============================================================================== +{ + "Input: \$line1 = '$line1'".put; + " \$line2 = '$line2'".put; + + my Str @uncommon-words = find-uncommon-words( $line1, $line2 ); + + "Output: (%s)\n".printf: @uncommon-words.elems == 0 ?? "''" !! + @uncommon-words.map( { "'$_'" } ).join: ', '; +} + +#=============================================================================== +multi sub MAIN() # No input: run the test suite +#=============================================================================== +{ + run-tests(); +} + +#------------------------------------------------------------------------------- +sub find-uncommon-words( Str:D $line1, Str:D $line2 --> List:D[Str:D] ) +#------------------------------------------------------------------------------- +{ + my Str @words = filter-words( $line1 ); + @words.push: |filter-words( $line2 ); + + my UInt %dict; + ++%dict{ $_ } for @words.map: { .lc }; + + my Str @uncommon; + + for @words -> Str $word + { + @uncommon.push: $word if %dict{ $word.lc } == 1; + } + + return @uncommon; +} + +#------------------------------------------------------------------------------- +sub filter-words( Str:D $line --> List:D[Str:D] ) +#------------------------------------------------------------------------------- +{ + my Str $l = $line; # Make a local copy + + $l ~~ s:g/ \- ** 2..* / /; # Convert dashes to spaces + $l ~~ s:g/ \' s? //; # Remove possessive markers + $l ~~ s:g/ <[.,;:!?'"]> / /; # Convert punctuation to spaces + + my Str @words = $l.split: / \s+ /, :skip-empty; # Find (non-empty) words + + return @words; +} + +#------------------------------------------------------------------------------- +sub run-tests() +#------------------------------------------------------------------------------- +{ + 'Running the test suite'.put; + + for test-data.lines -> Str $line + { + my Str ($test-name, $line1, $line2, $expected-str) = + $line.split: / \| /; + + for $test-name, $line1, $line2, $expected-str + { + s/ ^ \s+ //; + s/ \s+ $ //; + } + + my Str @uncommon-words = find-uncommon-words( $line1, $line2 ); + my Str @expected-words = $expected-str.split: / \s+ /, :skip-empty; + + is-deeply @uncommon-words, @expected-words, $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 |Mango is sweet |Mango is sour |sweet sour + Example 2 |Mango Mango |Orange |Orange + Example 3 |Mango is Mango |Orange is Orange | + Case |The cat is on the mat|A dog is on a log |cat mat dog log + Plurals |This dog likes dogs |This dog likes cats |dogs cats + Possessives|Pete is my son's son |Pete is my grandson |grandson + Dash |Sue--my favourite. |Is Sue my favourite? |Is + Hyphen |Implement: egg-beater|Egg implement |egg-beater Egg + Punctuation|Sue has a book. |Does Sue have a book?|has Does have + Quotes |"Mango" is sweet |Mango is 'sour' |sweet sour + END +} + +################################################################################ diff --git a/challenge-266/athanasius/raku/ch-2.raku b/challenge-266/athanasius/raku/ch-2.raku new file mode 100644 index 0000000000..80ff3acd0e --- /dev/null +++ b/challenge-266/athanasius/raku/ch-2.raku @@ -0,0 +1,277 @@ +use v6d; + +################################################################################ +=begin comment + +Perl Weekly Challenge 266 +========================= + +TASK #2 +------- +*X Matrix* + +Submitted by: Mohammad Sajid Anwar + +You are given a square matrix, $matrix. + +Write a script to find if the given matrix is X Matrix. + + A square matrix is an X Matrix if all the elements on the main diagonal and + antidiagonal are non-zero and everything else are zero. + +Example 1 + + Input: $matrix = [ [1, 0, 0, 2], + [0, 3, 4, 0], + [0, 5, 6, 0], + [7, 0, 0, 1], + ] + Output: true + +Example 2 + + Input: $matrix = [ [1, 2, 3], + [4, 5, 6], + [7, 8, 9], + ] + Output: false + +Example 3 + + Input: $matrix = [ [1, 0, 2], + [0, 3, 0], + [4, 0, 5], + ] + Output: true + +=end comment +################################################################################ + +#--------------------------------------# +# Copyright © 2024 PerlMonk Athanasius # +#--------------------------------------# + +#=============================================================================== +=begin comment + +Assumption +---------- +Matrix elements are integers. + +Interface +--------- +1. If no command-line arguments are given, the test suite is run. Otherwise: +2. The input matrix is entered on the command-line as a non-empty list of + strings (the matrix rows) containing elements separated by whitespace. For + example, the matrix: + + [ 1 1 0 ] + [ 0 1 0 ] + [ 0 0 0 ] + + is entered as: >raku ch-2.raku "1 1 0" "0 1 0" "0 0 1" + +Note +---- +Matrix-handling code is adapted from the solutions to Task 2 for Week 248 and +Task 2 for Week 257. + +=end comment +#=============================================================================== + +use Test; + +subset Matrix of Array where * ~~ Array[Array[Int]]; + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + "\nChallenge 266, Task #2: X Matrix (Raku)\n".put; +} + +#=============================================================================== +multi sub MAIN +( + #| A square and non-empty integer matrix + + *@matrix where { .all ~~ Str:D && .elems > 0 } +) +#=============================================================================== +{ + my Matrix $matrix = parse-matrix( @matrix ); + + print-matrix( 'Input: $matrix = ', $matrix ); + + my Bool $x-matrix = is-x-matrix( $matrix ); + + "Output: %s\n".printf: $x-matrix ?? 'true' !! 'false'; +} + +#=============================================================================== +multi sub MAIN() # No input: run the test suite +#=============================================================================== +{ + run-tests(); +} + +#------------------------------------------------------------------------------- +sub is-x-matrix( Matrix:D $matrix --> Bool:D ) +#------------------------------------------------------------------------------- +{ + my UInt $end = $matrix.end; + + for 0 .. $end -> UInt $row + { + for 0 .. $end -> UInt $col + { + if $row == $col || # On the main diagonal + $row + $col == $end # On the antidiagonal + { + return False if $matrix[ $row; $col ] == 0; + } + else + { + return False unless $matrix[ $row; $col ] == 0; + } + } + } + + return True; +} + +#------------------------------------------------------------------------------- +sub parse-matrix( List:D[Str:D] $rows --> Matrix:D ) +#------------------------------------------------------------------------------- +{ + my Matrix $matrix = Array[Array[Int]].new; + my UInt $cols; + + for @$rows -> Str $row-str + { + my Int @row; + + for $row-str.split( / \s+ /, :skip-empty ) -> Str $elem + { + if +$elem ~~ Int:D + { + @row.push: +$elem; + } + else + { + error( qq[Element "$elem" is not a valid integer] ); + } + } + + @row.elems > 0 or error( 'Empty row' ); + $matrix.push: @row; + + if $cols.defined + { + @row.elems == $cols or error( 'The input matrix is ragged' ); + } + else # Initialize $cols + { + $cols = @row.elems; + $cols == $rows.elems or error( 'The input matrix is not square' ); + } + } + + return $matrix; +} + +#------------------------------------------------------------------------------- +sub print-matrix( Str:D $prefix, Matrix:D $matrix ) +#------------------------------------------------------------------------------- +{ + my Str $tab = ' ' x $prefix.chars; + my UInt @width = 1 xx $matrix[ 0 ].elems; + + for @$matrix -> Int @row + { + for 0 .. @row.end -> UInt $i + { + my UInt $w = @row[ $i ].chars; + + @width[ $i ] = $w if $w > @width[ $i ]; + } + } + + "$prefix\[".put; + + for @$matrix -> Int @row + { + my Str @row-str; + + for 0 .. @row.end -> UInt $i + { + @row-str.push: '%*d'.sprintf: @width[ $i ], @row[ $i ]; + } + + "%s [%s]\n".printf: $tab, @row-str.join: ', '; + } + + "$tab]".put; +} + +#------------------------------------------------------------------------------- +sub run-tests() +#------------------------------------------------------------------------------- +{ + 'Running the test suite'.put; + + for test-data.lines -> Str $line + { + my Str ($test-name, $matrix-str, $exp-str) = $line.split: / \| /; + + for $test-name, $matrix-str, $exp-str + { + s/ ^ \s+ //; + s/ \s+ $ //; + } + + my Str @rows = $matrix-str.split: / \; /, :skip-empty; + my Matrix $matrix = parse-matrix( @rows ); + my Bool $x-matrix = is-x-matrix( $matrix ); + my Bool $expected = $exp-str eq '1'; + + is $x-matrix, $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 0 2; 0 3 4 0; 0 5 6 0; 7 0 0 1|1 + Example 2|1 2 3 ; 4 5 6 ; 7 8 9 |0 + Example 3|1 0 2 ; 0 3 0 ; 4 0 5 |1 + END +} + +################################################################################ -- cgit