From c1b21293aba69f308d11457ddec69213333bea67 Mon Sep 17 00:00:00 2001 From: rir Date: Sun, 26 Mar 2023 08:37:21 -0400 Subject: 209 --- challenge-209/0rir/raku/ch-1.raku | 136 ++++++++++++++++++++++++++++++++++++++ challenge-209/0rir/raku/ch-2.raku | 125 +++++++++++++++++++++++++++++++++++ 2 files changed, 261 insertions(+) create mode 100644 challenge-209/0rir/raku/ch-1.raku create mode 100644 challenge-209/0rir/raku/ch-2.raku (limited to 'challenge-209') diff --git a/challenge-209/0rir/raku/ch-1.raku b/challenge-209/0rir/raku/ch-1.raku new file mode 100644 index 0000000000..0cc411ea05 --- /dev/null +++ b/challenge-209/0rir/raku/ch-1.raku @@ -0,0 +1,136 @@ +#!/usr/bin/env raku +# :vim ft=raku sw=4 expandtab # 🦋 ∅∪∩∋∈∉ ≡ ≢ «␤ » ∴ +use v6.d; +use lib $?FILE.IO.parent(2).add("lib"); +use Test; + +=begin comment +209-1: Special Bit Characters Submitted by: Mohammad S Anwar +Given an array of binary bits that ends with 0. + +Valid sequences in the bit string are: +[0] -decodes-to-> "a" +[1, 0] -> "b" +[1, 1] -> "c" + +Write a script to print 1 if the last character is an “a” otherwise print 0. + +Example 1 +Input: @bits = (1, 0, 0) +Output: 1 + +The given array bits can be decoded as 2-bits character (10) followed by 1-bit character (0). +Example 2 + +Input: @bits = (1, 1, 1, 0) +Output: 0 + +Possible decode can be 2-bits character (11) followed by 2-bits character (10) i.e. the last character is not 1-bit character. + +=end comment + +=begin comment +A […,0,0] indicates a final 'a'. +A […,1,0] is ambiguous. That _one_ can be considered the end of a sequence of +ones. The sequence's length being odd or even, determines if the one belongs +to a final 'b' or a penultimate 'c'. +=end comment + +constant $V-end = 'a'; + +my @Data = do for 1..10000 { + my $w = .base(3); + ($w ~~ tr/0..2/a..c/).Str; +} + +# validate input word +sub abc-a-valid( $str --> Bool ) { + so $str ~~ / ^ <[abc]>* $V-end $/; +} + +# convert a test word to array of 1's and 0's +sub abc-encode( $str is copy --> Array ) { + $str.=subst( 'c', '11', :g); + $str.=subst( 'b', '10', :g); + $str.=subst( 'a', '0', :g); + $str.comb.Array; +} + +enum State ; + +# For empirical verification. Not the solution. +sub abc-decode ( @bit --> Str ) { + + # STATE vars + my $return; + my $idx = 0; + + my %transition = + SizeQ => -> { @bit[$idx] == 0 ?? "Small" !! "Large" }, # First state. + Small => -> { $return ~= 'a'; ++$idx; "DoneQ" }, + Large => -> { + $return ~= @bit[$idx+1] == 0 ?? 'b' !! 'c'; + die 'ilformed input' if $idx > @bit.end; + $idx += 2; + 'DoneQ'; + }, + DoneQ => -> { if $idx ≤ @bit.end { "SizeQ" } else { 'Done' }}, + Done => "End marker for the state machine.", + ; + + my $state = 'SizeQ'; + while $state ne 'Done' { + $state = %transition{$state}(); + } + $return; +} + +# calc correct answer +sub abc-expect( $str --> Bool) { + when $str ~~ / a $/ { True } + False; +} + +multi sub ends-with-a( @bit where @bit.end < 3 --> Bool ) { + given @bit { + # a, aa, ba, aaa, ca + when [[0], [0,0], [1,0,0], [0,0,0], [1,1,0],].any { True } + # b, c, ab, a,c + when [[1,0], [1,1], [0,1,0], [0,1,1], ].any { False } + # splat + when [ [], [1], [0,1], [0,0,1], [1,0,1], [1,1,1],].any { fail } + } +} + +multi sub ends-with-a( @bit --> Bool ) { + + fail if @bit.tail ≠ 0; + + return True if @bit[*-2] == 0; + + return so ( + @bit.end - 1 + - + ( @bit[0..*-2].first( * !~~ 1, :k, :end) // -1) + ) %% 2; +} + +my @Test = @Data.grep: * ~~ / a $ /; + +plan 2 × @Test; + +for @Test -> $in { + my $exp = abc-expect( $in); + my @bit = abc-encode( $in); + my $uncode = abc-decode( @bit); + is $uncode, $in, "$in to bits and back"; + is ends-with-a(@bit), $exp, "$uncode -> @bit[] -> $exp"; +} +done-testing; + +my @bit = 1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1, 0; + +say "\nInput: @bits = @bit[]\nOutput: ", &ends-with-a( @bit) ?? 1 !! 0; + +exit; + diff --git a/challenge-209/0rir/raku/ch-2.raku b/challenge-209/0rir/raku/ch-2.raku new file mode 100644 index 0000000000..90b9cae440 --- /dev/null +++ b/challenge-209/0rir/raku/ch-2.raku @@ -0,0 +1,125 @@ +#!/usr/bin/env raku +# :vim ft=raku sw=4 expandtab # 🦋 ∅∪∩∋∈∉ ≡ ≢ «␤ » ∴ +use v6.d; +use Test; + +=begin comment +209-Task 2: Merge Account Submitted by: Mohammad S Anwar +Given an array of accounts i.e. name with list of email addresses, +merge the accounts where possible. Accounts can only be merged if +they have at least one email address in common. + +Example 1: + +Input: @accounts = [ ["A", "a1@a.com", "a2@a.com"], + ["B", "b1@b.com"], + ["A", "a3@a.com", "a1@a.com"] ] + ] + +Output: [ ["A", "a1@a.com", "a2@a.com", "a3@a.com"], + ["B", "b1@b.com"] ] +Example 2: + +Input: @accounts = [ ["A", "a1@a.com", "a2@a.com"], + ["B", "b1@b.com"], + ["A", "a3@a.com"], + ["B"m "b2@b.com", "b1@b.com"] ] + +Output: [ ["A", "a1@a.com", "a2@a.com"], + ["A", "a3@a.com"], + ["B", "b1@b.com", "b2@b.com"] ] + +=end comment + + +subset Accno of Any where m/ ^ <:Lu> \d \d $ /; +subset Addr of Any where m/^ (<:Ll> \d ** 3) | (<:Lu> ** 4) $/; + +sub dsay(*@a ) {;}; + +my @Data = + # a/c addr ... + [< A01 a010 a011 CCCC >], + [< A02 a020 a022 BBBB >], + [< A03 a030 >], + [ 'A04', ], + [< A07 BBBB >], + [< A08 a070 a071 >], + [< A09 a080 a081 CCCC>], + [< A10 a101 >], + [< A11 a111 CCCC>], +; + +sub MAIN () { + say "Input: @accounts = ["; + say " ", $_.raku for @Data; + say " ]"; + say "Output: ["; + say " ", $_.raku for combine-accounts( @Data); + say " ]"; +} + +# Combine all possible a/c. +sub combine-accounts( @database --> Array ) { + + my (%by-ac, %by-addr, %ac2expand, %ac2drop); + + # Hash each a/c. + for @database -> @d { + %by-ac{@d.head} = [ @d.tail(*-1)]; # XXX Simpler put all in values. + } + + # Invert a/c to key by address. + %by-addr.append: %by-ac.invert; + + for %by-addr.keys -> $k { + when %by-addr{ $k} ~~ Str { # Address has only one acct so + %by-addr{$k}:delete; # no work. + } + + my $key = choose-ac-to-expand( %by-addr{$k}); + %ac2expand{$key} = %by-addr{$k}.values.grep(* !~~ $key).Array; + + for %by-addr{$k}.values.grep(* !~~ $key).Array { + %ac2drop{ $_ }++ ; + } } + + my @expanded = merge-acs( %ac2expand, %by-ac); + for @expanded -> ( :key($k), :value($v) ) { + %by-ac{$k} = $v; + } + for %ac2drop.keys -> $k { + %by-ac{$k}:delete; + } + + my @new; + for %by-ac.keys.sort -> $k { + @new.push: [$k, |%by-ac{$k}] ; # | %by-ac{$k} ]; + } + return @new; +} + +# Merge all accts that need combining. +sub merge-acs( %keepers, %by-ac --> Array ) { + my @updated; + for %keepers.pairs -> $kp { + @updated.push: expand-ac( $kp, %by-ac); + } + return @updated; +} + +# Merge accounts into the a/c indicated by the Pair $keep. +sub expand-ac( $keep, %by-ac --> Pair ) { + my $key = $keep.key; + my @value = $keep.value.Array ; + + for [$key, | $keep.value] -> $pack-me { + @value.push: | %by-ac{$pack-me}; + } + $key => @value.unique.Array; +} + +# Choose which a/c to expand vs. consume. +sub choose-ac-to-expand( @ac --> Accno) { @ac.min( :by( &[leg])); } + + -- cgit From 1ef702c4a43a5b297c39479c040d2c00311ae971 Mon Sep 17 00:00:00 2001 From: PerlMonk-Athanasius Date: Sun, 26 Mar 2023 23:21:01 +1000 Subject: Perl & Raku solutions to Task 1, and Perl solution to Task 2, for Week 209 --- challenge-209/athanasius/perl/Example_1.txt | 3 + challenge-209/athanasius/perl/Example_1_answer.txt | 2 + challenge-209/athanasius/perl/Example_2.txt | 4 + challenge-209/athanasius/perl/Example_2_answer.txt | 3 + challenge-209/athanasius/perl/Transitive.txt | 7 + .../athanasius/perl/Transitive_answer.txt | 2 + challenge-209/athanasius/perl/ch-1.pl | 187 ++++++++++++++++ challenge-209/athanasius/perl/ch-2.pl | 247 +++++++++++++++++++++ challenge-209/athanasius/raku/ch-1.raku | 181 +++++++++++++++ 9 files changed, 636 insertions(+) create mode 100644 challenge-209/athanasius/perl/Example_1.txt create mode 100644 challenge-209/athanasius/perl/Example_1_answer.txt create mode 100644 challenge-209/athanasius/perl/Example_2.txt create mode 100644 challenge-209/athanasius/perl/Example_2_answer.txt create mode 100644 challenge-209/athanasius/perl/Transitive.txt create mode 100644 challenge-209/athanasius/perl/Transitive_answer.txt create mode 100644 challenge-209/athanasius/perl/ch-1.pl create mode 100644 challenge-209/athanasius/perl/ch-2.pl create mode 100644 challenge-209/athanasius/raku/ch-1.raku (limited to 'challenge-209') diff --git a/challenge-209/athanasius/perl/Example_1.txt b/challenge-209/athanasius/perl/Example_1.txt new file mode 100644 index 0000000000..2cc2ad4af9 --- /dev/null +++ b/challenge-209/athanasius/perl/Example_1.txt @@ -0,0 +1,3 @@ +"A","a1@a.com","a2@a.com" +"B","b1@b.com" +"A","a3@a.com","a1@a.com" diff --git a/challenge-209/athanasius/perl/Example_1_answer.txt b/challenge-209/athanasius/perl/Example_1_answer.txt new file mode 100644 index 0000000000..b5f95b0c63 --- /dev/null +++ b/challenge-209/athanasius/perl/Example_1_answer.txt @@ -0,0 +1,2 @@ +"A","a1@a.com","a2@a.com","a3@a.com" +"B","b1@b.com" diff --git a/challenge-209/athanasius/perl/Example_2.txt b/challenge-209/athanasius/perl/Example_2.txt new file mode 100644 index 0000000000..50751d8755 --- /dev/null +++ b/challenge-209/athanasius/perl/Example_2.txt @@ -0,0 +1,4 @@ +"A","a1@a.com","a2@a.com" +"B","b1@b.com" +"A","a3@a.com" +"B","b2@b.com","b1@b.com" diff --git a/challenge-209/athanasius/perl/Example_2_answer.txt b/challenge-209/athanasius/perl/Example_2_answer.txt new file mode 100644 index 0000000000..1123c1be79 --- /dev/null +++ b/challenge-209/athanasius/perl/Example_2_answer.txt @@ -0,0 +1,3 @@ +"A","a1@a.com","a2@a.com" +"A","a3@a.com" +"B","b1@b.com","b2@b.com" diff --git a/challenge-209/athanasius/perl/Transitive.txt b/challenge-209/athanasius/perl/Transitive.txt new file mode 100644 index 0000000000..b830322e4b --- /dev/null +++ b/challenge-209/athanasius/perl/Transitive.txt @@ -0,0 +1,7 @@ +"A","a1@a.com","a2@a.com" +"B","b1@b.com" +"A","a3@a.com","a4@a.com" +"B","b2@b.com","b3@b.com" +"A","a4@a.com","a5@a.com" +"B","b2@b.com","b1@b.com" +"A","a5@a.com","a1@a.com" diff --git a/challenge-209/athanasius/perl/Transitive_answer.txt b/challenge-209/athanasius/perl/Transitive_answer.txt new file mode 100644 index 0000000000..ba7b303db9 --- /dev/null +++ b/challenge-209/athanasius/perl/Transitive_answer.txt @@ -0,0 +1,2 @@ +"A","a1@a.com","a2@a.com","a3@a.com","a4@a.com","a5@a.com" +"B","b1@b.com","b2@b.com","b3@b.com" diff --git a/challenge-209/athanasius/perl/ch-1.pl b/challenge-209/athanasius/perl/ch-1.pl new file mode 100644 index 0000000000..7f88a063be --- /dev/null +++ b/challenge-209/athanasius/perl/ch-1.pl @@ -0,0 +1,187 @@ +#!perl + +################################################################################ +=comment + +Perl Weekly Challenge 209 +========================= + +TASK #1 +------- +*Special Bit Characters* + +Submitted by: Mohammad S Anwar + +You are given an array of binary bits that ends with 0. + +Valid sequences in the bit string are: + + [0] -decodes-to-> "a" + [1, 0] -> "b" + [1, 1] -> "c" + +Write a script to print 1 if the last character is an “a” otherwise print 0. + +Example 1 + + Input: @bits = (1, 0, 0) + Output: 1 + + The given array bits can be decoded as 2-bits character (10) followed by 1-bit + character (0). + +Example 2 + + Input: @bits = (1, 1, 1, 0) + Output: 0 + + Possible decode can be 2-bits character (11) followed by 2-bits character (10) + i.e. the last character is not 1-bit character. + +=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 required output (1 or 0) is followed + by the decoded text. + +=cut +#=============================================================================== + +use strict; +use warnings; +use Const::Fast; +use Test::More; + +const my $VERBOSE => 1; +const my $USAGE => +"Usage: + perl $0 + perl $0 + + A string of binary bits ending in 0\n"; + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + $| = 1; + print "\nChallenge 209, Task #1: Special Bit Characters (Perl)\n\n"; +} + +#=============================================================================== +MAIN: +#=============================================================================== +{ + my $args = scalar @ARGV; + + if ($args == 0) + { + run_tests(); + } + elsif ($args == 1) + { + my $bits = parse_command_line( $ARGV[ 0 ] ); + + printf "Input: \@bits = (%s)\n", join ', ', @$bits; + + my ($text, $output) = decode( $bits ); + + print "Output: $output\n"; + print "\nDecoded string: $text\n" if $VERBOSE; + } + else + { + error( "Expected 1 or 0 command line arguments, found $args"); + } +} + +#------------------------------------------------------------------------------- +sub decode +#------------------------------------------------------------------------------- +{ + my ($bits) = @_; + my $text; + + while (@$bits) + { + my $bit0 = shift @$bits; + + if ($bit0 == 0) + { + $text .= 'a'; + } + else + { + my $bit1 = shift @$bits; + + $text .= $bit1 == 0 ? 'b' : 'c'; + } + } + + return ($text, $text =~ / a $ /x ? 1 : 0); +} + +#------------------------------------------------------------------------------- +sub parse_command_line +#------------------------------------------------------------------------------- +{ + my ($bits) = @_; + + $bits =~ / ^ [01]* 0 $ /x + or error( 'Invalid input string' ); + + my @bits = split //, $bits; + + return \@bits; +} + +#------------------------------------------------------------------------------- +sub run_tests +#------------------------------------------------------------------------------- +{ + print "Running the test suite\n"; + + while (my $line = ) + { + chomp $line; + + my ($test_name, $input, $expected) = split / \| /x, $line; + + $test_name =~ s/ \s+ $ //x; + $input =~ s/ \s+ $ //x; + + my @bits = split //, $input; + my ($text, $out) = decode( \@bits ); + my $got = "$text=$out"; + + is $got, $expected, $test_name; + } + + done_testing; +} + +#------------------------------------------------------------------------------- +sub error +#------------------------------------------------------------------------------- +{ + my ($message) = @_; + + die "ERROR: $message\n$USAGE"; +} + +################################################################################ + +__DATA__ +Example 1|100 |ba=1 +Example 2|1110 |cb=0 +Longer |11101001101000|cbbacabaa=1 diff --git a/challenge-209/athanasius/perl/ch-2.pl b/challenge-209/athanasius/perl/ch-2.pl new file mode 100644 index 0000000000..760eebd716 --- /dev/null +++ b/challenge-209/athanasius/perl/ch-2.pl @@ -0,0 +1,247 @@ +#!perl + +################################################################################ +=comment + +Perl Weekly Challenge 209 +========================= + +TASK #2 +------- +*Merge Account* + +Submitted by: Mohammad S Anwar + +You are given an array of accounts i.e. name with list of email addresses. + +Write a script to merge the accounts where possible. The accounts can only be +merged if they have at least one email address in common. + +Example 1: + + Input: @accounts = [ ["A", "a1@a.com", "a2@a.com"], + ["B", "b1@b.com"], + ["A", "a3@a.com", "a1@a.com"] ] + ] + + Output: [ ["A", "a1@a.com", "a2@a.com", "a3@a.com"], + ["B", "b1@b.com"] ] + +Example 2: + + Input: @accounts = [ ["A", "a1@a.com", "a2@a.com"], + ["B", "b1@b.com"], + ["A", "a3@a.com"], + ["B", "b2@b.com", "b1@b.com"] ] + + Output: [ ["A", "a1@a.com", "a2@a.com"], + ["A", "a3@a.com"], + ["B", "b1@b.com", "b2@b.com"] ] + +=cut +################################################################################ + +#--------------------------------------# +# Copyright © 2023 PerlMonk Athanasius # +#--------------------------------------# + +#=============================================================================== +=comment + +Interface +--------- +If no command-line arguments are given, the test suite is run. + +Assumptions +----------- +1. Accounts OF THE SAME NAME can be merged only if they have at least one email + address in common. +2. "Having an email address in common" is a transitive relation, so two accounts + with the same name but with no addresses in common can be merged if each has + an address in common with (say) a third account of the same name. + +Note +---- +No attempt is made to verify the format of email addresses. + +=cut +#=============================================================================== + +use strict; +use warnings; +use Const::Fast; +use Set::Scalar; +use Test::More; +use Text::CSV; + +const my $INDENT => ' ' x 8; +const my $USAGE => +"Usage: + perl $0 + perl $0 + + Name of accounts file\n"; + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + $| = 1; + print "\nChallenge 209, Task #2: Merge Account (Perl)\n\n"; +} + +#=============================================================================== +MAIN: +#=============================================================================== +{ + my $args = scalar @ARGV; + + if ($args == 0) + { + run_tests(); + } + elsif ($args == 1) + { + my $accounts = read_accounts_file( $ARGV[ 0 ] ); + + print format_accounts( "Input: \@accounts", $accounts ), "\n"; + + my $merged = merge_accounts( $accounts ); + + print format_accounts( "Output: \@merged", $merged ); + } + else + { + error( "Expected 1 or 0 command line arguments, found $args" ); + } +} + +#------------------------------------------------------------------------------- +sub merge_accounts +#------------------------------------------------------------------------------- +{ + my ($accounts) = @_; + my (%name2accounts, @merged); + + for my $account (@$accounts) + { + my ($name, @addresses) = @$account; + push @{ $name2accounts{ $name } }, \@addresses; + } + + for my $name (sort keys %name2accounts) + { + L_LOOP: + { + my $accounts = $name2accounts{ $name }; + + for my $i (0 .. $#$accounts - 1) + { + my $s = Set::Scalar->new( @{ $accounts->[ $i ] } ); + + for my $j ($i + 1 .. $#$accounts) + { + my $t = Set::Scalar->new( @{ $accounts->[ $j ] } ); + my $int = $s->intersection( $t ); + + if ($int->size > 0) + { + $accounts->[ $i ] = [ sort $s->union( $t )->members ]; + splice @$accounts, $j, 1; + redo L_LOOP; + } + } + } + + push @merged, [ $name, @$_ ] for @$accounts; + } + } + + return \@merged; +} + +#------------------------------------------------------------------------------- +sub read_accounts_file +#------------------------------------------------------------------------------- +{ + my ($filename) = @_; + -e $filename or error( qq[File "$filename" not found] ); + + my @accounts; + my $csv = Text::CSV->new( + { + allow_loose_quotes => 1, + auto_diag => 1, + binary => 1, + } + ); + + open( my $fh, '<', $filename ) + or die "Cannot open file $filename for reading, stopped"; + + while (my $row = $csv->getline( $fh )) + { + push @accounts, $row; + } + + close $fh + or die "Cannot close file $filename, stopped"; + + return \@accounts; +} + +#------------------------------------------------------------------------------- +sub format_accounts +#------------------------------------------------------------------------------- +{ + my ($header, $accounts) = @_; + + return sprintf "$header =\n%s[\n%s\n%s]\n", + $INDENT, + join + ( + ",\n", + map + { + $INDENT . ' [' . join( ', ', map { qq["$_"] } @$_ ) . ']' + + } @$accounts + ), + $INDENT; +} + +#------------------------------------------------------------------------------- +sub run_tests +#------------------------------------------------------------------------------- +{ + print "Running the test suite\n"; + + while (my $line = ) + { + chomp $line; + + my ($test_name, $in_file, $out_file) = split / \| /x, $line; + my $got = merge_accounts( read_accounts_file( $in_file ) ); + my $expected = read_accounts_file( $out_file ); + + is_deeply $got, $expected, $test_name; + } + + done_testing; +} + +#------------------------------------------------------------------------------- +sub error +#------------------------------------------------------------------------------- +{ + my ($message) = @_; + + die "ERROR: $message\n$USAGE"; +} + +################################################################################ + +__DATA__ +Example 1 |Example_1.txt |Example_1_answer.txt +Example 2 |Example_2.txt |Example_2_answer.txt +Transitive|Transitive.txt|Transitive_answer.txt diff --git a/challenge-209/athanasius/raku/ch-1.raku b/challenge-209/athanasius/raku/ch-1.raku new file mode 100644 index 0000000000..ca374cb8bc --- /dev/null +++ b/challenge-209/athanasius/raku/ch-1.raku @@ -0,0 +1,181 @@ +use v6d; + +################################################################################ +=begin comment + +Perl Weekly Challenge 209 +========================= + +TASK #1 +------- +*Special Bit Characters* + +Submitted by: Mohammad S Anwar + +You are given an array of binary bits that ends with 0. + +Valid sequences in the bit string are: + + [0] -decodes-to-> "a" + [1, 0] -> "b" + [1, 1] -> "c" + +Write a script to print 1 if the last character is an “a” otherwise print 0. + +Example 1 + + Input: @bits = (1, 0, 0) + Output: 1 + + The given array bits can be decoded as 2-bits character (10) followed by 1-bit + character (0). + +Example 2 + + Input: @bits = (1, 1, 1, 0) + Output: 0 + + Possible decode can be 2-bits character (11) followed by 2-bits character (10) + i.e. the last character is not 1-bit character. + +=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 True, the required output (1 or 0) is followed by the decoded + text. + +=end comment +#=============================================================================== + +use Test; + +my Bool constant $VERBOSE = True; + +subset Bit of Int where 0 | 1; + +#------------------------------------------------------------------------------- +BEGIN +#------------------------------------------------------------------------------- +{ + "\nChallenge 209, Task #1: Special Bit Characters (Raku)\n".put; +} + +#=============================================================================== +multi sub MAIN +( + Str:D $bits where / ^ <[01]>* 0 $ / #= A string of binary bits ending in 0 +) +#=============================================================================== +{ + my Bit @bits = $bits.split( '', :skip-empty ).map: { .Int }; + + "Input: \@bits = (%s)\n".printf: @bits.join: ', '; + + my (Str $text, Bit $output) = decode( @bits ); + + "Output: $output".put; + + "\nDecoded string: $text".put if $VERBOSE; +} + +#=============================================================================== +multi sub MAIN() # No input: run the test suite +#=============================================================================== +{ + run-tests(); +} + +#------------------------------------------------------------------------------- +sub decode( List:D[Bit:D] $bits --> List:D[Str:D, Bit:D] ) +#------------------------------------------------------------------------------- +{ + my Bit @bits = @$bits; # Make a copy + my Str $text; + + while @bits + { + my Bit $bit0 = @bits.shift; + + if $bit0 == 0 + { + $text ~= 'a'; + } + else + { + my Bit $bit1 = @bits.shift; + + $text ~= $bit1 == 0 ?? 'b' !! 'c'; + } + } + + return $text, $text ~~ / a $ / ?? 1 !! 0; +} + +#------------------------------------------------------------------------------- +sub run-tests() +#------------------------------------------------------------------------------- +{ + 'Running the test suite'.put; + + for test-data.lines -> Str $line + { + my Str ($test-name, $input, $expected) = $line.split: / \| /; + + $test-name ~~ s/ \s+ $ //; + $input ~~ s/ \s+ $ //; + + my Bit @bits = $input.split( '', :skip-empty ).map: { .Int }; + my (Str $text, + Bit $out) = decode( @bits ); + my Str $got = "$text=$out"; + + 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|100 |ba=1 + Example 2|1110 |cb=0 + Longer |11101001101000|cbbacabaa=1 + END +} + +################################################################################ -- cgit From 9832763638186750dcf385a9db491334db89a682 Mon Sep 17 00:00:00 2001 From: CY Fung Date: Mon, 27 Mar 2023 01:42:04 +0800 Subject: Week 209 Task 2 --- challenge-209/cheok-yin-fung/perl/ch-2.pl | 93 +++++++++++++++++++++++++++++++ 1 file changed, 93 insertions(+) create mode 100644 challenge-209/cheok-yin-fung/perl/ch-2.pl (limited to 'challenge-209') diff --git a/challenge-209/cheok-yin-fung/perl/ch-2.pl b/challenge-209/cheok-yin-fung/perl/ch-2.pl new file mode 100644 index 0000000000..183b2363ae --- /dev/null +++ b/challenge-209/cheok-yin-fung/perl/ch-2.pl @@ -0,0 +1,93 @@ +# The Weekly Challenge 209 +# Task 2 Merge Account +use v5.30.0; +use warnings; +use Graph::Undirected; +use Array::Utils qw/unique/; + +my @accounts1 = ( ['A', 'a1@a.com', 'a2@a.com'], + ['B', 'b1@b.com'], + ['A', 'a3@a.com', 'a1@a.com'] ); + + +my @accounts2 = ( ['A', 'a1@a.com', 'a2@a.com'], + ['B', 'b1@b.com'], + ['A', 'a3@a.com'], + ['B', 'b2@b.com', 'b1@b.com'] ); + +sub merge_acc { + my @acc = @_; + my @acc_mail = (); + my %acc_name; + for my $i (0..$#acc) { + $acc_name{$i} = $acc[$i][0]; + $acc_mail[$i] = [@{$acc[$i]}[1..$acc[$i]->$#*]]; + } + my %mail_acc; + for my $i (0..$#acc) { + for my $m ($acc_mail[$i]->@*) { + push $mail_acc{$m}->@*, $i if defined($mail_acc{$m}); + $mail_acc{$m} = [$i] if !defined($mail_acc{$m}); + } + } + + my $g = Graph::Undirected->new; + $g->add_vertex($_) foreach 0..$#acc; + for my $m (keys %mail_acc) { + if (scalar $mail_acc{$m}->@* > 1) { + for my $i (0..$mail_acc{$m}->$#*-1) { + $g->add_edge($mail_acc{$m}->[$i], $mail_acc{$m}->[$i+1]); + # can be enhanced to add edge between more accounts + } + } + } + + my @cc = $g->connected_components(); + my @ans = (); + for my $c (@cc) { + my @arr; + @arr = unique map {$acc_mail[$_]->@*} $c->@*; + unshift @arr, $acc_name{$c->[0]}; + push @ans, [@arr] + } + return @ans; +} + +my @result1 = merge_acc(@accounts1); +my @result2 = merge_acc(@accounts2); + +=pod From Data::Printer +@result1; + +[ + [0] [ + [0] "A", + [1] "a2@a.com", + [2] "a3@a.com", + [3] "a1@a.com" + ], + [1] [ + [0] "B", + [1] "b1@b.com" + ] +] + +@result2; +[ + [0] [ + [0] "A", + [1] "a3@a.com" + ], + [1] [ + [0] "B", + [1] "b1@b.com", + [2] "b2@b.com" + ], + [2] [ + [0] "A", + [1] "a2@a.com", + [2] "a1@a.com" + ] +] + + -- cgit From a9c3c64ac9aa05dd9f5ebfd19ef3f89b4c50467b Mon Sep 17 00:00:00 2001 From: Jan Krňávek Date: Sun, 26 Mar 2023 20:14:57 +0200 Subject: solution week 209-2 -- with class --- challenge-209/wambash/raku/ch-2.raku | 63 ++++++++++++++++++++++++++++++++++++ 1 file changed, 63 insertions(+) create mode 100644 challenge-209/wambash/raku/ch-2.raku (limited to 'challenge-209') diff --git a/challenge-209/wambash/raku/ch-2.raku b/challenge-209/wambash/raku/ch-2.raku new file mode 100644 index 0000000000..719d9bdc6d --- /dev/null +++ b/challenge-209/wambash/raku/ch-2.raku @@ -0,0 +1,63 @@ +#!/usr/bin/env raku + +class Account { + has $.name; + has Set() $.email; + + multi method COERCE (+@ (Str $name, +@email)) { + Account.new: :$name, :@email + } + + multi method List { + $!name, |$!email.keys.sort + } +} + + +multi join-account (+@acc) {samewith @acc} +multi join-account (Array[Account()]() \acc) { + Account.new: name => acc.head.name, email => [(|)] acc».email; +} + +sub merge-account-reducer ( @accounts, $email) { + @accounts + andthen .classify: { $email ∈ .email }\ + andthen |.{False}, join-account |.{True} +} + +multi merge-account (+@acc) {samewith @acc} +multi merge-account (Array[Account()]() \accounts) { + my @email = ([∪] accounts.map( *.email)).keys; + + accounts, |@email + andthen .reduce: &merge-account-reducer +} + +multi MAIN (Bool :test($)!) { + use Test; + is-deeply Account('A', 'a1@a.com', 'a2@a.com').email, .Set; + is Account().name, 'B'; + is-deeply join-account( + , , + ).email, .Set; + is-deeply join-account( + , , + ).name, 'A'; + is-deeply merge-account-reducer( + Array[Account()](, , ), + 'a1@a.com' + )».email, (.Set, .Set) ; + is-deeply merge-account( , , ).sort(*.name).head.email, + .Set; + is merge-account( , , )».List.sort, + (, ); + is merge-account( , , )».List.sort, + (, , ); + is merge-account( , , , )».List.sort, + (, , ); + done-testing; +} + +multi MAIN (@account) { + say merge-account @account +} -- cgit From ab5b38d3831d6ee115de0e362c43229e5a89df29 Mon Sep 17 00:00:00 2001 From: Jan Krňávek Date: Sun, 26 Mar 2023 21:35:38 +0200 Subject: solution week 209-2 -- without special class --- challenge-209/wambash/raku/ch-2.raku | 71 +++++++++++++----------------------- 1 file changed, 25 insertions(+), 46 deletions(-) (limited to 'challenge-209') diff --git a/challenge-209/wambash/raku/ch-2.raku b/challenge-209/wambash/raku/ch-2.raku index 719d9bdc6d..fe07c54e11 100644 --- a/challenge-209/wambash/raku/ch-2.raku +++ b/challenge-209/wambash/raku/ch-2.raku @@ -1,63 +1,42 @@ #!/usr/bin/env raku -class Account { - has $.name; - has Set() $.email; - - multi method COERCE (+@ (Str $name, +@email)) { - Account.new: :$name, :@email - } - - multi method List { - $!name, |$!email.keys.sort - } -} - - -multi join-account (+@acc) {samewith @acc} -multi join-account (Array[Account()]() \acc) { - Account.new: name => acc.head.name, email => [(|)] acc».email; +sub join-account (+@acc) { + @acc.head.head, |@acc.map( |*.skip ).sort.squish; } -sub merge-account-reducer ( @accounts, $email) { - @accounts - andthen .classify: { $email ∈ .email }\ - andthen |.{False}, join-account |.{True} +sub merge-account-reducer ( @account, $email) { + @account + andthen .classify: { $email ∈ .skip }\ + andthen |(.{False} // Empty), join-account |.{True} } -multi merge-account (+@acc) {samewith @acc} -multi merge-account (Array[Account()]() \accounts) { - my @email = ([∪] accounts.map( *.email)).keys; +sub merge-account (+@accounts) { + my @email = @accounts.map( |*.skip ).unique; - accounts, |@email + @accounts, |@email andthen .reduce: &merge-account-reducer } multi MAIN (Bool :test($)!) { use Test; - is-deeply Account('A', 'a1@a.com', 'a2@a.com').email, .Set; - is Account().name, 'B'; - is-deeply join-account( - , , - ).email, .Set; + my @accounts := , , ; + is-deeply join-account( @accounts ), ; is-deeply join-account( - , , - ).name, 'A'; - is-deeply merge-account-reducer( - Array[Account()](, , ), - 'a1@a.com' - )».email, (.Set, .Set) ; - is-deeply merge-account( , , ).sort(*.name).head.email, - .Set; - is merge-account( , , )».List.sort, - (, ); - is merge-account( , , )».List.sort, - (, , ); - is merge-account( , , , )».List.sort, - (, , ); + , + ), ; + is-deeply merge-account-reducer( @accounts, 'a1@a.com' ), (,); + is-deeply merge-account-reducer( @accounts, 'a2@a.com' ), (, , ); + is-deeply merge-account-reducer( @accounts, 'a3@a.com' ), (,, ); + is-deeply merge-account( @accounts ), ( , ); + is-deeply merge-account( , , ), + (, , ); + is merge-account( , , , ), + ( , , , ); + is-deeply merge-account( , ), ( ,); + is-deeply merge-account( , , , ), ( , ,); done-testing; } -multi MAIN (@account) { - say merge-account @account +multi MAIN (:@account) { + say merge-account @account.map: *.words.list } -- cgit From 996f2da081108dc83066daa918378d972a912c9d Mon Sep 17 00:00:00 2001 From: Jan Krňávek Date: Sun, 26 Mar 2023 22:00:42 +0200 Subject: solution week 209-1 --- challenge-209/wambash/raku/ch-1.raku | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) create mode 100644 challenge-209/wambash/raku/ch-1.raku (limited to 'challenge-209') diff --git a/challenge-209/wambash/raku/ch-1.raku b/challenge-209/wambash/raku/ch-1.raku new file mode 100644 index 0000000000..490f38abe3 --- /dev/null +++ b/challenge-209/wambash/raku/ch-1.raku @@ -0,0 +1,29 @@ +#!/usr/bin/env raku + +my token A {0}; +my token B {10}; +my token C {11}; + +multi special-bit-charakters (+@bits) { + samewith @bits.join +} + +multi special-bit-charakters ($str) { + $str.contains: /^ [ | | ]* $/ +} + +multi MAIN (Bool :test($)!) { + use Test; + is special-bit-charakters(1,0,0), True; + is special-bit-charakters(1,1,1,0), False; + is special-bit-charakters(1110), False; + done-testing; +} + +multi MAIN (Str $sbits) { + say +special-bit-charakters $sbits +} + +multi MAIN (*@bits) { + say +special-bit-charakters @bits +} -- cgit From 77f736e6f0fe9b490b7949ca6fe5a9874d41dac9 Mon Sep 17 00:00:00 2001 From: Util Date: Sun, 26 Mar 2023 16:02:34 -0500 Subject: Add TWC 209 solutions by Bruce Gray (Raku only). --- challenge-209/bruce-gray/raku/ch-1.raku | 21 ++++ challenge-209/bruce-gray/raku/ch-2.raku | 168 ++++++++++++++++++++++++++++++++ 2 files changed, 189 insertions(+) create mode 100644 challenge-209/bruce-gray/raku/ch-1.raku create mode 100644 challenge-209/bruce-gray/raku/ch-2.raku (limited to 'challenge-209') diff --git a/challenge-209/bruce-gray/raku/ch-1.raku b/challenge-209/bruce-gray/raku/ch-1.raku new file mode 100644 index 0000000000..6aaf374abb --- /dev/null +++ b/challenge-209/bruce-gray/raku/ch-1.raku @@ -0,0 +1,21 @@ +sub task1 ( @bits --> Bool ) { + constant %h = 0 => 'a', 10 => 'b', 11 => 'c'; + + @bits.join ~~ / ^ ( <{ %h.keys }> )+ $ / + orelse return False; + + my @decoded = %h{ $/[0] }; + + return @decoded.tail eq 'a'; +} + + +constant @tests = + ( (1, 0, 0) , 1 ), + ( (1, 1, 1, 0) , 0 ), +; +use Test; +plan +@tests; +for @tests -> ( $in, $expected ) { + is task1($in).Int, $expected; +} diff --git a/challenge-209/bruce-gray/raku/ch-2.raku b/challenge-209/bruce-gray/raku/ch-2.raku new file mode 100644 index 0000000000..991eafff14 --- /dev/null +++ b/challenge-209/bruce-gray/raku/ch-2.raku @@ -0,0 +1,168 @@ +# Thanks to e-choroba & james-smith & mark-anderson for +# unknowingly providing the tests cases I needed to exercise the multi-pass merging. +# I scanned the repo for such bonus tests, but have not looked at their coded solutions. + +sub transative_closures ( @groups_input ) { + my @groups = @groups_input; + + # I am sure this could be greatly simplified, + # and also made faster for large numbers of merges, + # but I am out of time for this week. + + loop { + my $unmodified = True; + my @transative_closures; + for @groups -> SetHash $g { + with @transative_closures.first( :k, { $_ ∩ $g } ) -> $k { + @transative_closures[$k] ∪= $g; + $unmodified = False; + } + else { + push @transative_closures, $g; + } + } + last if $unmodified; + @groups = @transative_closures; + } + return @groups; +} +sub task2 ( @in ) { + my %h; + for @in.kv -> $i, ( $letter, *@addresses ) { + for @addresses -> $add { + %h{"$letter:$add"}.push: $i; + } + } + + my SetHash @groups = %h.sort.map({ .value.SetHash if .value.elems > 1 }); + + my @to_merge = transative_closures(@groups).map( *.keys».Int.sort ).sort; + + my @r = @in; + for @to_merge -> @tm { + my ($target, @sources) = @tm; + my @addresses = @r[@tm].map({ .skip }).flat.unique; + @r[$target] = [ @r[$target].head, |@addresses ]; + @r[$_] = Nil for @sources; + } + + return @r.grep(?*); +} + + +# To simplify the debugging output, all `@` have been replaced with `-`, and `.com` has been removed. +my @tests = + # Task example 1 + [ + [ + [], + [], + [], + ], + [ + [], + [], + ], + ], + # Task example 2 + [ + [ + [], + [], + [], + [], + ], + [ + [], + [], + [], + ], + ], + + # From mark-anderson : + [ + [ + [], + [], + [], + [], + [], + [], + [], + [], + [], + [], + ], + [ + [], + [], + [], + [], + [], + [], + [], + ], + ], + # From e-choroba : + [ + [ + [], + [], + [], + ], + [ + [], + ], + ], + [ + [ + [], + [], + [], + [], + ], + [ + [], + ], + ], + + # From james-smith : + [ + [ + [], + [], + [], + ], + [,], + + ], + [ + [ + [], + [], + [], + [], + [], + ], + [,], + ], + [ + [ + [], + [], + [], + [], + [], + [], + [], + ], + [,], + ], +; +use Test; +plan +@tests; +for @tests -> ( $in, @expected ) { + my @got = task2($in).map(*.sort).sort; + my @exp = @expected.map(*.sort).sort; + is-deeply @got, @exp; +} -- cgit From 040c65055d5c2f92219f9b3c18e176d299510729 Mon Sep 17 00:00:00 2001 From: Polgár Márton Date: Mon, 27 Mar 2023 00:36:10 +0200 Subject: Weeklies by 2colours --- challenge-209/2colours/raku/ch-1.raku | 17 +++++++++++ challenge-209/2colours/raku/ch-2.raku | 54 +++++++++++++++++++++++++++++++++++ 2 files changed, 71 insertions(+) create mode 100755 challenge-209/2colours/raku/ch-1.raku create mode 100755 challenge-209/2colours/raku/ch-2.raku (limited to 'challenge-209') diff --git a/challenge-209/2colours/raku/ch-1.raku b/challenge-209/2colours/raku/ch-1.raku new file mode 100755 index 0000000000..3b4a2ac689 --- /dev/null +++ b/challenge-209/2colours/raku/ch-1.raku @@ -0,0 +1,17 @@ +#!/usr/bin/env raku + + +my token bit { <[01]> }; +subset BitList of Str where /^ '(' * % ',' ')' $/; + +sub MAIN(Str $bits) { + die 'Please supply a valid list of bits.' unless $bits.subst(/\s/, '', :g) ~~ BitList; + my Str() @bits = $; + die 'The last bit must be zero!' unless @bits[*-1] == 0; + my $bit-string = @bits.join; + $bit-string + .trans: <0 10 11> => andthen + .substr(*-1) eq 'a' andthen + .Int + .say; +} diff --git a/challenge-209/2colours/raku/ch-2.raku b/challenge-209/2colours/raku/ch-2.raku new file mode 100755 index 0000000000..3a6ce5e96d --- /dev/null +++ b/challenge-209/2colours/raku/ch-2.raku @@ -0,0 +1,54 @@ +#!/usr/bin/env raku + +use Email::Valid; # zef install Email::Valid +my $email = Email::Valid.new; + +# Constraints: +# - the name can't have quotation marks + +my token name { '"' <( .*? )> '"' } +my token email { '"' <( .*? )> '"' } +my token account { '[' [ ',' + % ',' ]? ']' } +subset AccountList of Str where /^ '[' * % ',' ']' $/; + +use MONKEY-TYPING; +augment class Array { + proto method unify-transitive is nodal {*} + multi method unify-transitive([]:) { [] } + multi method unify-transitive([@emails-head, **@rest]:) { + my @unified-rest = @rest.unify-transitive; + my @result; + @result.push: @emails-head; + for @unified-rest -> @emails-current { + given @result.head { + if $_ (&) @emails-current { + .append: keys(@emails-current (-) $_); + } + else { + @result.push: @emails-current; + } + } + } + @result + } +} + +sub build-account-str($name, @mails) { + my $mails-part = @mails.map('"' ~ * ~ '"').join(', '); + qq:to/END/.chomp + ["$name"{", $_" if .so given $mails-part}] + END +} + +sub MAIN(Str $accounts) { + die 'Please supply a valid list of accounts.' unless $accounts.subst(/\s/, '', :g) ~~ AccountList; + my @accounts <== + $.map: { ..Str => .>>.Str }; + @accounts + .classify: *.key, as => *.value andthen + .duckmap: *.unify-transitive andthen + .map: {slip(.key X[&build-account-str] .value[])} andthen + .join: ', ' andthen + "[$_]" andthen + .say; +} -- cgit From e26e6c2116af0c7e813a715ac5d0cf5a1c712578 Mon Sep 17 00:00:00 2001 From: Mohammad S Anwar Date: Sun, 26 Mar 2023 23:50:48 +0100 Subject: - Added solutions by Robert Ransbottom. - Added solutions by Athanasius. - Added solutions by Paulo Custodio. - Added solutions by Cheok-Yin Fung. - Added solutions by Jan Krnavek. - Added solutions by Bruce Gray. - Added solutions by Robert DiCicco. - Added solutions by Marton Polgar. --- challenge-209/robert-dicicco/julia/ch-2.jl | 47 ++++++++++++++++++++++++ challenge-209/robert-dicicco/python/ch-2.py | 56 +++++++++++++++++++++++++++++ challenge-209/robert-dicicco/ruby/ch-2.rb | 50 ++++++++++++++++++++++++++ 3 files changed, 153 insertions(+) create mode 100644 challenge-209/robert-dicicco/julia/ch-2.jl create mode 100644 challenge-209/robert-dicicco/python/ch-2.py create mode 100644 challenge-209/robert-dicicco/ruby/ch-2.rb (limited to 'challenge-209') diff --git a/challenge-209/robert-dicicco/julia/ch-2.jl b/challenge-209/robert-dicicco/julia/ch-2.jl new file mode 100644 index 0000000000..aad1da2a7e --- /dev/null +++ b/challenge-209/robert-dicicco/julia/ch-2.jl @@ -0,0 +1,47 @@ +#!/usr/bin/env julia +#= +------------------------------------------------------ +AUTHOR: Robert DiCicco +DATE : 2023-03-26 +Challenge 209 Merge Account ( Julia ) +------------------------------------------------------ +=# + +using Printf + +accounts = [["A", "a1@a.com", "a2@a.com"], ["B", "b1@b.com"], ["A", "a3@a.com", "a1@a.com"]] +#accounts = [ ["A", "a1@a.com", "a2@a.com"], ["B", "b1@b.com"], ["A", "a3@a.com"], ["B", "b2@b.com", "b1@b.com"] ] + +a = [] +b = [] +@printf("Input: @accounts = %s\n", accounts) +for sub in accounts + if sub[1] == "A" + for x in sub + push!(a,x) + end + elseif sub[1] == "B" + for x in sub + push!(b,x) + end + end +end +@printf("\t%s\n",unique(sort(a))) +@printf("\t%s\n",unique(sort(b))) +println(" ") + +#= +------------------------------------------------------ +julia .\MergeAccount.jl +Input: @accounts = [["A", "a1@a.com", "a2@a.com"], ["B", "b1@b.com"], ["A", "a3@a.com", "a1@a.com"]] + Any["a1@a.com", "a2@a.com", "a3@a.com"] + Any["b1@b.com"] + +PS G:\Projects\Perl\Challenges> julia .\MergeAccount.jl +Input: @accounts = [["A", "a1@a.com", "a2@a.com"], ["B", "b1@b.com"], ["A", "a3@a.com"], ["B", "b2@b.com", "b1@b.com"]] + Any["a1@a.com", "a2@a.com", "a3@a.com"] + Any["b1@b.com", "b2@b.com"] +------------------------------------------------------ +=# + + diff --git a/challenge-209/robert-dicicco/python/ch-2.py b/challenge-209/robert-dicicco/python/ch-2.py new file mode 100644 index 0000000000..67c03bf220 --- /dev/null +++ b/challenge-209/robert-dicicco/python/ch-2.py @@ -0,0 +1,56 @@ +#!/usr/bin/env python +''' +----------------------------------------------------------- +AUTHOR: Robert Dicicco +DATE : 2023-03-26 +Challenge 209 Merge Account ( Python ) +----------------------------------------------------------- +''' + +#accounts = [["A", "a1@a.com", "a2@a.com"], ["B", "b1@b.com"], ["A", "a3@a.com", "a1@a.com"]] +accounts = [ ["A", "a1@a.com", "a2@a.com"], ["B", "b1@b.com"], ["A", "a3@a.com"], ["B", "b2@b.com", "b1@b.com"] ] + +a = [] +b = [] + +def unique(list1): + unique_list = [] + for x in list1: + if x not in unique_list: + unique_list.append(x) + print("\t",unique_list) + +print(f"Input: @accounts = {accounts}") +for sub in accounts: + + if sub[0] == "A": + for x in sub: + #print(x) + a.append(x) + elif sub[0] == "B": + for x in sub: + #print(x) + b.append(x) +print("Output: ") +unique(a) +unique(b) +print(" ") + +''' +----------------------------------------------------------- +SAMPLE OUTPUT +python .\MergeAccount.py +Input: @accounts = [['A', 'a1@a.com', 'a2@a.com'], ['B', 'b1@b.com'], ['A', 'a3@a.com', 'a1@a.com']] +Output: + ['A', 'a1@a.com', 'a2@a.com', 'a3@a.com'] + ['B', 'b1@b.com'] + +PS G:\Projects\Perl\Challenges> python .\MergeAccount.py +Input: @accounts = [['A', 'a1@a.com', 'a2@a.com'], ['B', 'b1@b.com'], ['A', 'a3@a.com'], ['B', 'b2@b.com', 'b1@b.com']] +Output: + ['A', 'a1@a.com', 'a2@a.com', 'a3@a.com'] + ['B', 'b1@b.com', 'b2@b.com'] +----------------------------------------------------------- +''' + + diff --git a/challenge-209/robert-dicicco/ruby/ch-2.rb b/challenge-209/robert-dicicco/ruby/ch-2.rb new file mode 100644 index 0000000000..3d22ad6eba --- /dev/null +++ b/challenge-209/robert-dicicco/ruby/ch-2.rb @@ -0,0 +1,50 @@ +#!/usr/bin/env ruby +=begin +---------------------------------------------------------- +AUTHOR: Robert DiCicco +DATE : 2023-03-26 +Challenge 209 Merge Account ( Ruby ) +---------------------------------------------------------- +=end + +accounts = [["A", "a1\@a.com", "a2\@a.com"], ["B", "b1\@b.com"], ["A", "a3\@a.com", "a1\@a.com"]] +#accounts = [ ["A", "a1\@a.com", "a2\@a.com"], ["B", "b1\@b.com"], ["A", "a3\@a.com"], ["B", "b2\@b.com", "b1\@b.com"] ] +puts("Input: @accounts = #{accounts}") +a = Array.new() +b = Array.new() +accounts.each do |sub| + if (sub[0] == 'A') + sub.each do |x| + a.push(x) + end + end + if (sub[0] == 'B') + sub.each do |y| + b.push(y) + end + end +end + +puts("Output: ") +puts("\t#{a.uniq}") +puts("\t#{b.uniq}") + +=begin +---------------------------------------------------------- +SAMPLE OUTPUT +ruby .\MergeAccount.rb +Input: @accounts = [["A", "a1@a.com", "a2@a.com"], ["B", "b1@b.com"], ["A", "a3@a.com", "a1@a.com"]] +Output: + ["A", "a1@a.com", "a2@a.com", "a3@a.com"] + ["B", "b1@b.com"] + + +PS G:\Projects\Perl\Challenges> ruby .\MergeAccount.rb +Input: @accounts = [["A", "a1@a.com", "a2@a.com"], ["B", "b1@b.com"], ["A", "a3@a.com"], ["B", "b2@b.com", "b1@b.com"]] +Output: + ["A", "a1@a.com", "a2@a.com", "a3@a.com"] + ["B", "b1@b.com", "b2@b.com"] +---------------------------------------------------------- +=end + + -- cgit From c5fb8164dcc10f8cb67002d9d5a419e42dc00485 Mon Sep 17 00:00:00 2001 From: BarrOff <58253563+BarrOff@users.noreply.github.com> Date: Mon, 27 Mar 2023 01:18:11 +0200 Subject: feat: add solution for challenge 209-1 from BarrOff --- challenge-209/barroff/raku/ch-1.raku | 33 +++++++++++++++++++++++++++++++++ 1 file changed, 33 insertions(+) create mode 100644 challenge-209/barroff/raku/ch-1.raku (limited to 'challenge-209') diff --git a/challenge-209/barroff/raku/ch-1.raku b/challenge-209/barroff/raku/ch-1.raku new file mode 100644 index 0000000000..ea7857dc7c --- /dev/null +++ b/challenge-209/barroff/raku/ch-1.raku @@ -0,0 +1,33 @@ +#!/usr/bin/env raku + +use v6.d; + +grammar Sbc { + regex TOP { } + token a { '0' } + token b { '10' } + token c { '11' } + regex prelude { ^ [ | | ]* } + token end { $ } +} + +sub special-bit-characters(Int @numbers --> Int) { + my Str $bit-string = @numbers.join; + Sbc.parse($bit-string) ?? 1 !! 0; +} + +#| Run test cases +multi sub MAIN('test') { + use Test; + plan 2; + + is special-bit-characters(Array[Int].new([1, 0, 0])), 1, "works for (1, 0, 0)"; + is special-bit-characters(Array[Int].new([1, 1, 1, 0])), 0, "works for (1, 1, 1, 0)"; +} + +#| Take user provided list like 1 1 1 0 +multi sub MAIN(*@elements where @elements.elems ≥ 1 && all(@elements) ~~ /^<[01]>$/) { + my Int @int-elements = @elements; + say "the result is { special-bit-characters(@int-elements) }" +} + -- cgit From 07744bc404fe0be15f6a50ab42d298df77464b81 Mon Sep 17 00:00:00 2001 From: dcw Date: Mon, 27 Mar 2023 00:27:39 +0100 Subject: imported my solutions to this week's tasks, task 1+2 in Perl, task 1 in C also, will do task 2 in C tomorrow when I have time --- challenge-209/duncan-c-white/C/.cbuild | 1 + challenge-209/duncan-c-white/C/Makefile | 19 +++ challenge-209/duncan-c-white/C/README | 11 ++ challenge-209/duncan-c-white/C/args.c | 207 ++++++++++++++++++++++++++++ challenge-209/duncan-c-white/C/args.h | 11 ++ challenge-209/duncan-c-white/C/ch-1.c | 105 ++++++++++++++ challenge-209/duncan-c-white/C/csvsplit.c | 47 +++++++ challenge-209/duncan-c-white/C/csvsplit.h | 14 ++ challenge-209/duncan-c-white/C/parseints.c | 114 +++++++++++++++ challenge-209/duncan-c-white/C/parseints.h | 1 + challenge-209/duncan-c-white/C/printarray.c | 39 ++++++ challenge-209/duncan-c-white/C/printarray.h | 1 + challenge-209/duncan-c-white/README | 103 ++++++-------- challenge-209/duncan-c-white/perl/ch-1.pl | 61 ++++++++ challenge-209/duncan-c-white/perl/ch-2.pl | 114 +++++++++++++++ 15 files changed, 789 insertions(+), 59 deletions(-) create mode 100644 challenge-209/duncan-c-white/C/Makefile create mode 100644 challenge-209/duncan-c-white/C/README create mode 100644 challenge-209/duncan-c-white/C/args.c create mode 100644 challenge-209/duncan-c-white/C/args.h create mode 100644 challenge-209/duncan-c-white/C/ch-1.c create mode 100644 challenge-209/duncan-c-white/C/csvsplit.c create mode 100644 challenge-209/duncan-c-white/C/csvsplit.h create mode 100644 challenge-209/duncan-c-white/C/parseints.c create mode 100644 challenge-209/duncan-c-white/C/parseints.h create mode 100644 challenge-209/duncan-c-white/C/printarray.c create mode 100644 challenge-209/duncan-c-white/C/printarray.h create mode 100755 challenge-209/duncan-c-white/perl/ch-1.pl create mode 100755 challenge-209/duncan-c-white/perl/ch-2.pl (limited to 'challenge-209') diff --git a/challenge-209/duncan-c-white/C/.cbuild b/challenge-209/duncan-c-white/C/.cbuild index a14ec76520..835981f6f1 100644 --- a/challenge-209/duncan-c-white/C/.cbuild +++ b/challenge-209/duncan-c-white/C/.cbuild @@ -1,4 +1,5 @@ BUILD = ch-1 ch-2 +BUILD = ch-1 CFLAGS = -Wall -g #LDFLAGS = -lm #CFLAGS = -g diff --git a/challenge-209/duncan-c-white/C/Makefile b/challenge-209/duncan-c-white/C/Makefile new file mode 100644 index 0000000000..513f8703b6 --- /dev/null +++ b/challenge-209/duncan-c-white/C/Makefile @@ -0,0 +1,19 @@ +# Makefile rules generated by CB +CC = gcc +CFLAGS = -Wall -g +BUILD = ch-1 ch-2 + +all: $(BUILD) + +clean: + /bin/rm -f $(BUILD) *.o core a.out + +args.o: args.c +ch-1: ch-1.o args.o csvsplit.o +ch-1.o: ch-1.c args.h csvsplit.h +ch-2: ch-2.o args.o parseints.o printarray.o +ch-2.o: ch-2.c args.h parseints.h printarray.h +csvsplit.o: csvsplit.c csvsplit.h +parseints.o: parseints.c args.h parseints.h printarray.h +printarray.o: printarray.c + diff --git a/challenge-209/duncan-c-white/C/README b/challenge-209/duncan-c-white/C/README new file mode 100644 index 0000000000..dd5f3346f7 --- /dev/null +++ b/challenge-209/duncan-c-white/C/README @@ -0,0 +1,11 @@ +Thought I'd also have a go at translating ch-1.pl and ch-2.pl into C.. + +Both C versions produce identical (non-debugging and debugging) +output to the Perl originals. + +These C versions use most of my regular support modules: +- a command-line argument processing module args.[ch], +- a csvlist-of-int parsing module parseints.[ch], and +- an int-array printing module printarray.[ch]. +- plus a (new for PWC) csv splitting module csvsplit.[ch] to split + a single argument into a wordlist diff --git a/challenge-209/duncan-c-white/C/args.c b/challenge-209/duncan-c-white/C/args.c new file mode 100644 index 0000000000..d4a2d38b9a --- /dev/null +++ b/challenge-209/duncan-c-white/C/args.c @@ -0,0 +1,207 @@ +#include +#include +#include +#include +#include +#include + + +bool debug = false; + + +// process_flag_noarg( name, argc, argv ); +// Process the -d flag, and check that there are no +// remaining arguments. +void process_flag_noarg( char *name, int argc, char **argv ) +{ + int arg=1; + if( argc>1 && strcmp( argv[arg], "-d" ) == 0 ) + { + debug = true; + arg++; + } + + int left = argc-arg; + if( left != 0 ) + { + fprintf( stderr, "Usage: %s [-d]\n", name ); + exit(1); + } +} + + +// int argno = process_flag_n_args( name, argc, argv, n, argmsg ); +// Process the -d flag, and check that there are exactly +// n remaining arguments, return the index position of the first +// argument. If not, generate a fatal Usage error using the argmsg. +// +int process_flag_n_args( char *name, int argc, char **argv, int n, char *argmsg ) +{ + int arg=1; + if( argc>1 && strcmp( argv[arg], "-d" ) == 0 ) + { + debug = true; + arg++; + } + + int left = argc-arg; + if( left != n ) + { + fprintf( stderr, "Usage: %s [-d] %s\n Exactly %d " + "arguments needed\n", name, argmsg, n ); + exit(1); + } + return arg; +} + + +// int argno = process_flag_n_m_args( name, argc, argv, min, max, argmsg ); +// Process the -d flag, and check that there are between +// min and max remaining arguments, return the index position of the first +// argument. If not, generate a fatal Usage error using the argmsg. +// +int process_flag_n_m_args( char *name, int argc, char **argv, int min, int max, char *argmsg ) +{ + int arg=1; + if( argc>1 && strcmp( argv[arg], "-d" ) == 0 ) + { + debug = true; + arg++; + } + + int left = argc-arg; + if( left < min || left > max ) + { + fprintf( stderr, "Usage: %s [-d] %s\n Between %d and %d " + "arguments needed\n", name, argmsg, min, max ); + exit(1); + } + return arg; +} + + +// process_onenumarg_default( name, argc, argv, defvalue, &n ); +// Process the -d flag, and check that there is a single +// remaining numeric argument (or no arguments, in which case +// we use the defvalue), putting it into n +void process_onenumarg_default( char *name, int argc, char **argv, int defvalue, int *n ) +{ + char argmsg[100]; + sprintf( argmsg, "[int default %d]", defvalue ); + int arg = process_flag_n_m_args( name, argc, argv, 0, 1, argmsg ); + + *n = arg == argc ? defvalue : atoi( argv[arg] ); +} + + +// process_onenumarg( name, argc, argv, &n ); +// Process the -d flag, and check that there is a single +// remaining numeric argument, putting it into n +void process_onenumarg( char *name, int argc, char **argv, int *n ) +{ + int arg = process_flag_n_args( name, argc, argv, 1, "int" ); + + // argument is in argv[arg] + *n = atoi( argv[arg] ); +} + + +// process_twonumargs( name, argc, argv, &m, &n ); +// Process the -d flag, and check that there are 2 +// remaining numeric arguments, putting them into m and n +void process_twonumargs( char *name, int argc, char **argv, int *m, int *n ) +{ + int arg = process_flag_n_args( name, argc, argv, 2, "int" ); + + // arguments are in argv[arg] and argv[arg+1] + *m = atoi( argv[arg++] ); + *n = atoi( argv[arg] ); +} + + +// process_twostrargs() IS DEPRECATED: use process_flag_n_m_args() instead + + +// int arr[100]; +// int nel = process_listnumargs( name, argc, argv, arr, 100 ); +// Process the -d flag, and check that there are >= 2 +// remaining numeric arguments, putting them into arr[0..nel-1] +// and returning nel. +int process_listnumargs( char *name, int argc, char **argv, int *arr, int maxel ) +{ + int arg=1; + if( argc>1 && strcmp( argv[arg], "-d" ) == 0 ) + { + debug = true; + arg++; + } + + int left = argc-arg; + if( left < 2 ) + { + fprintf( stderr, "Usage: %s [-d] list_of_numeric_args\n", name ); + exit(1); + } + if( left > maxel ) + { + fprintf( stderr, "%s: more than %d args\n", name, maxel ); + exit(1); + } + + // elements are in argv[arg], argv[arg+1]... + + if( debug ) + { + printf( "debug: remaining arguments are in arg=%d, " + "firstn=%s, secondn=%s..\n", + arg, argv[arg], argv[arg+1] ); + } + + int nel = 0; + for( int i=arg; i