From 3f1b014fba8655d40a3a750d1bd6266fc91a0b74 Mon Sep 17 00:00:00 2001 From: Mark <53903062+andemark@users.noreply.github.com> Date: Mon, 20 Mar 2023 08:16:35 +0000 Subject: initial 209 (Raku) --- challenge-209/mark-anderson/raku/ch-1.raku | 21 +++++++++++++ challenge-209/mark-anderson/raku/ch-2.raku | 49 ++++++++++++++++++++++++++++++ 2 files changed, 70 insertions(+) create mode 100644 challenge-209/mark-anderson/raku/ch-1.raku create mode 100644 challenge-209/mark-anderson/raku/ch-2.raku diff --git a/challenge-209/mark-anderson/raku/ch-1.raku b/challenge-209/mark-anderson/raku/ch-1.raku new file mode 100644 index 0000000000..dac544bd91 --- /dev/null +++ b/challenge-209/mark-anderson/raku/ch-1.raku @@ -0,0 +1,21 @@ +#!/usr/bin/env raku +use Test; + +ok special-bit-chars(0); +ok special-bit-chars(1,0,0); +ok special-bit-chars(1,0,1,1,0); +ok special-bit-chars(0,0,0,0,0,0); +ok special-bit-chars(0,1,0,1,0,0); +ok special-bit-chars(0,1,0,1,0,0); + +nok special-bit-chars(1,1,1,0); +nok special-bit-chars(1,1,1,1,1,0); +nok special-bit-chars(1,1,0,0,1,0); +nok special-bit-chars(1,0,1,0,1,0); +nok special-bit-chars(0,0,0,0,1,0); + +sub special-bit-chars(+$a) +{ + my $r = / 0+ | [10]+ | [11]+ /; + $a.join ~~ /^ $r* 0 $/ +} diff --git a/challenge-209/mark-anderson/raku/ch-2.raku b/challenge-209/mark-anderson/raku/ch-2.raku new file mode 100644 index 0000000000..5248fc8c76 --- /dev/null +++ b/challenge-209/mark-anderson/raku/ch-2.raku @@ -0,0 +1,49 @@ +#!/usr/bin/env raku + +merge-accounts([ + ["A", "a1@a.com", "a2@a.com"], + ["B", "b1@b.com"], + ["A", "a3@a.com", "a1@a.com"] + ]); + +merge-accounts([ + ["A", "a1@a.com", "a2@a.com"], + ["B", "b1@b.com"], + ["A", "a3@a.com"], + ["B", "b2@b.com", "b1@b.com"] + ]); + +merge-accounts([ + ["C", "c2@c.com"], + ["C", "c1@c.com", "c4@c.com"], + ["A", "a1@a.com", "a2@a.com"], + ["B", "b1@b.com"], + ["A", "a3@a.com"], + ["C", "c1@c.com", "c3@c.com"], + ["B", "b2@b.com", "b1@b.com"], + ["A", "a3@a.com", "a4@a.com"], + ["B", "b3@b.com"]; + ]); + +sub merge-accounts(@accounts) +{ + my @a = @accounts.classify({ .[0] }, :as{ .[1..*] }); + + for @a.sort(*.key) + { + my $key = .key; + my @value = .value>>.Array; + + my @g = gather + { + while @value + { + my @v := @value.shift; + my $k = @value.first({ $_ (&) @v }, :k); + $k.defined ?? @value[$k].append(@v) .= unique !! take @v; + } + } + + say $key => @g>>.sort; + } +} -- cgit From 5f43b20d334b56392e36810c85bedea9f5196751 Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 20 Mar 2023 10:53:13 +0000 Subject: Update README.md --- challenge-209/james-smith/README.md | 78 ++++++++++++++++++------------------- 1 file changed, 37 insertions(+), 41 deletions(-) diff --git a/challenge-209/james-smith/README.md b/challenge-209/james-smith/README.md index 60038de5c3..cfe1ee3420 100644 --- a/challenge-209/james-smith/README.md +++ b/challenge-209/james-smith/README.md @@ -1,7 +1,7 @@ -[< Previous 207](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-207/james-smith) | -[Next 209 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-209/james-smith) +[< Previous 208](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-209/james-smith) | +[Next 210 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-210/james-smith) -# The Weekly Challenge 208 +# The Weekly Challenge 209 You can find more information about this weeks, and previous weeks challenges at: @@ -13,64 +13,60 @@ submit solutions in whichever language you feel comfortable with. You can find the solutions here on github at: -https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-208/james-smith +https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-209/james-smith -# Task 1: Minimum Index Sum +# Task 1: Special Bit Characters -***You are given two arrays of strings. Write a script to find out all common strings in the given two arrays with minimum index sum. If no common strings found returns an empty list.*** +***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]` to `"b"`, `[1, 1]` to `"c"`. Write a script to print `1` if the last character is an `"a"` otherwise print `0`.*** ## Solution -We proceed to do a pass of each array. +Firstly we quickly check the last entry is a `0` if it isn't we return `-1` "error". We then look through each bit in turn - if it is `0` we go to the next bit; if it is a `1` we skip one bit and go to the next. We loop through to the end of the array. We loop till the array has `0` or `1` elements left - if we have one element left then the last character is an "a" if we have none it is not. So we can just return scalar @a`. ```perl -sub min_index_sum { - my( $b, %x, $t, $s, @best ) = ( 1e99, #0 - map { $_[0][$_] => $_ } reverse ( 0 .. $#{$_[0]} ) #1 - ); - exists $x{$t = $_[1][$_]} && #3 - ( $b > ($s=$x{$t}+$_) ? ($b,@best) = ( $s,$t ) #4 - : $b == $s && push @best, $t ) #5 - for 0 .. $#{$_[1]}; #2 - \@best #6 +sub special_bit_chars { + return -1 if $_[-1]; + ($_[0]&&shift),shift until @_<2; + scalar @_ } ``` -First we start with the first array and find the lowest index for each word in it - and store them in the hash `%x`. Note we work backwards through the list to ensure that it is the lowest index if the word is duplicated. This is the `map` in line 1. - -We then loop through the second list of strings (`#2`) looking for words which are in the first list (`#3`). If it has a lower index sum that the best so far we record this and reset the list of words (`#4`). If it has the same we just push it onto the list. (`#5`) - -At the end we just return the current list of words (which could be empty if there are no duplicates). (`#6`) - -Note we set the initial best index sum (`#0`) as `10^99` as the index sum will be no where near this and so we can treat this as effectively infinity... - -# Task 2: Duplicate and Missing +# Task 2: Merge Account Try all combinations and -***You are given an array of integers in sequence with one missing and one duplicate. Write a script to find the duplicate and missing integer in the given array. Return `-1` if none found. For the sake of this task, let us assume the array contains no more than one duplicate and missing.*** +***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.*** ## Observation -It is not 100% clear in the desciption - but we have assumed that it means a list of integers from `n` ... `m` with a step of `1`. +It is not 100% clear in the desciption - whether or not to assume the name must be the same - I am going to assume it isn't and that we chose one name from the list. ## Solution -We loop through looking for a duplicate `$p[n+1]==$p[$n]` or gap `$p[n+1]!=$p[$n]+1`. +The first pass at a solution, keeps a track of which emails that we have seen and links together an account with the current one if we have already seen the email address. This works most of the time - but it can go wrong - when there are three accounts with overlapping emails BUT they have no common email address. This is the `for my $acc` loop below. To resolve this we can allow ourselves to do multiple passes reducing the list each time. -We have two special cases - if there are no duplicates return -1 +Now ```perl -sub dup_missing { - my($p,$d,$m) = shift; - ($_==$p ? ($d=$_) : $_ == $p+2 && ($m=$_-1)), $p=$_ for @_; - defined $d ? ( defined $m ? [ $d, $m ] : [ $d,$p+1 ] ): [-1] +sub merge_accounts { + my($in,$out,%seen,$t) = ([],shift); + while(@{$out}!=@{$in}) { + ($in,$out,%seen) = ($out,[]); + O: for my $acc (@{$in}) { + my( $name, @e )=@{ $acc }; + for(@e) { + if( exists $seen{$_} ) { + my( $m, @f ) = @{ $out->[ $t = $seen{$_} ] }; + my %T = map { $_=>1 } @e, @f; + $seen{$_} = $t for keys %T; + $out->[ $t ] = [ $m, keys %T ]; + next O; + } + } + $seen{$_} = @{$out} for @e; + push @{$out},$acc; + } + } + $out } - ``` -We note that if the two neighbouring values are the same we have found the duplicate, and if the difference is `2` we've found the missing value. - -At the end of the loop we have 3 cases: - - 1) We have not found the duplicate (`$d` is undefined) - so we return `[-1]`; - 2) We have found the duplicate and we've found the missing value as well so we return `[$d,$m]`; - 3) We have found the duplicate BUT we haven't found the missing value - there is no solution here - the missing value is at one end or other of the list. As at this point we know what the last value of the list is (but not the first - we threw that away) we just return last value + 1. -- cgit From 3530508680653f52aba943e27292b68d6005d996 Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 20 Mar 2023 10:54:31 +0000 Subject: Create ch-2.pl --- challenge-209/james-smith/perl/ch-2.pl | 57 ++++++++++++++++++++++++++++++++++ 1 file changed, 57 insertions(+) create mode 100644 challenge-209/james-smith/perl/ch-2.pl diff --git a/challenge-209/james-smith/perl/ch-2.pl b/challenge-209/james-smith/perl/ch-2.pl new file mode 100644 index 0000000000..458f0b80ca --- /dev/null +++ b/challenge-209/james-smith/perl/ch-2.pl @@ -0,0 +1,57 @@ +#!/usr/local/bin/perl + +use strict; +use warnings; +use feature qw(say); +use Test::More; +use Benchmark qw(cmpthese timethis); +use Data::Dumper qw(Dumper); + +my @ACC = ( + [ ['A', 'a1@a.com', 'a2@a.com'], + ['B', 'b1@b.com'], + ['A', 'a3@a.com', 'a1@a.com'] ], + [ ['A', 'a1@a.com', 'a2@a.com'], + ['B', 'b1@b.com'], + ['A', 'a3@a.com'], + ['B', 'b2@b.com', 'b1@b.com'] ], + [ ['A', 'a1@a.com', 'a2@a.com'], + ['A', 'a3@a.com', 'a4@a.com'], + ['A', 'a2@a.com', 'a4@a.com'] ], + [ ['A', 'a1@a.com', 'a2@a.com'], + ['A', 'a2@a.com', 'a3@a.com'], + ['A', 'a3@a.com', 'a4@a.com'], + ['A', 'a4@a.com', 'a5@a.com'], + ['A', 'a5@a.com', 'a6@a.com'] ], + [ ['A', 'a1@a.com', 'a2@a.com'], + ['A', 'a3@a.com', 'a4@a.com'], + ['A', 'a5@a.com', 'a6@a.com'], + ['A', 'a7@a.com', 'a8@a.com'], + ['A', 'a1@a.com', 'a3@a.com'], + ['A', 'a5@a.com', 'a7@a.com'], + ['A', 'a1@a.com', 'a5@a.com'] ], +); + +say Dumper(merge_accounts( $_ )) for @ACC; + +sub merge_accounts { + my($in,$out,%seen,$t) = ([],shift); + while(@{$out}!=@{$in}) { + ($in,$out,%seen) = ($out,[]); + O: for my $acc (@{$in}) { + my( $name, @e )=@{ $acc }; + for(@e) { + if( exists $seen{$_} ) { + my( $m, @f ) = @{ $out->[ $t = $seen{$_} ] }; + my %T = map { $_=>1 } @e, @f; + $seen{$_} = $t for keys %T; + $out->[ $t ] = [ $m, keys %T ]; + next O; + } + } + $seen{$_} = @{$out} for @e; + push @{$out},$acc; + } + } + $out +} -- cgit From 8a7e0c098e6971515c121ed61cd3d773f3b32cdb Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 20 Mar 2023 10:54:53 +0000 Subject: Create ch-1.pl --- challenge-209/james-smith/perl/ch-1.pl | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) create mode 100644 challenge-209/james-smith/perl/ch-1.pl diff --git a/challenge-209/james-smith/perl/ch-1.pl b/challenge-209/james-smith/perl/ch-1.pl new file mode 100644 index 0000000000..98ddd16e71 --- /dev/null +++ b/challenge-209/james-smith/perl/ch-1.pl @@ -0,0 +1,19 @@ +#!/usr/local/bin/perl + +use strict; +use warnings; +use feature qw(say); +use Test::More; +use Benchmark qw(cmpthese timethis); + +my @TESTS = ( + [ [1,0,0] => 1 ], + [ [1,1,1,0] => 0 ], + [ [1,1,1] => -1 ], +); + +sub special_bit_chars { + return -1 if $_[-1]; + ($_[0]&&shift),shift until @_<2; + scalar @_ +} -- cgit From 9ce537ca090a9c60df09bd14313a4bb7f32308d0 Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 20 Mar 2023 10:55:20 +0000 Subject: Create blog.txt --- challenge-209/james-smith/blog.txt | 1 + 1 file changed, 1 insertion(+) create mode 100644 challenge-209/james-smith/blog.txt diff --git a/challenge-209/james-smith/blog.txt b/challenge-209/james-smith/blog.txt new file mode 100644 index 0000000000..e43621c16f --- /dev/null +++ b/challenge-209/james-smith/blog.txt @@ -0,0 +1 @@ +https://github.com/manwar/perlweeklychallenge-club/blob/master/challenge-209/james-smith/blog.txt -- cgit From 4a19df254223dbdbf4dca25a5d1d1e4c09a6bc13 Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 20 Mar 2023 10:55:41 +0000 Subject: Update README.md --- challenge-209/james-smith/README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/challenge-209/james-smith/README.md b/challenge-209/james-smith/README.md index cfe1ee3420..6f0efeb439 100644 --- a/challenge-209/james-smith/README.md +++ b/challenge-209/james-smith/README.md @@ -1,7 +1,7 @@ [< Previous 208](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-209/james-smith) | [Next 210 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-210/james-smith) -# The Weekly Challenge 209 +# ED 209: The Weekly Challenge You can find more information about this weeks, and previous weeks challenges at: -- cgit From c9eb1d7d7e40fc1180e8afb0b814a44a8c727bc4 Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 20 Mar 2023 10:56:07 +0000 Subject: Update README.md --- challenge-209/james-smith/README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/challenge-209/james-smith/README.md b/challenge-209/james-smith/README.md index 6f0efeb439..b190031e1c 100644 --- a/challenge-209/james-smith/README.md +++ b/challenge-209/james-smith/README.md @@ -1,7 +1,7 @@ [< Previous 208](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-209/james-smith) | [Next 210 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-210/james-smith) -# ED 209: The Weekly Challenge +# ED-209: The Weekly Challenge You can find more information about this weeks, and previous weeks challenges at: -- cgit From a211182f33e82c555fbbf729e124fd667f3d1b44 Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 20 Mar 2023 22:53:50 +0000 Subject: Update README.md --- challenge-209/james-smith/README.md | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/challenge-209/james-smith/README.md b/challenge-209/james-smith/README.md index b190031e1c..908f8c30b2 100644 --- a/challenge-209/james-smith/README.md +++ b/challenge-209/james-smith/README.md @@ -30,6 +30,23 @@ sub special_bit_chars { scalar @_ } ``` +## Solution 2 + +As well as tracking from the front we can track from the back. + +First we need to note: + + * Last character must be a `0` + * If there is string ending in a `0` then we can ignore anything up to this, as `0` is always at the right hand character in a string; + * Additionally if the last two characters are 0 then we know that the answer is true. + * So breaking this down we need to work out whether the value is true or false if the list ends: `.....,1,0`. If the string consists of series of `n` pairs of `1`s then this converts to "...CCA" and so the last character is `A` so we return 0; If it is an odd number of 1s we have the string "...CCB" so the return value is false. + +```perl +sub special_bit_chars_reverse { + my$f,pop?return-1:pop||return 1; + $f=!$f,pop||last while@_; + ~~$f +} # Task 2: Merge Account -- cgit From 60f4518b353390ccd821bc973fd5ac7619deb526 Mon Sep 17 00:00:00 2001 From: James Smith Date: Mon, 20 Mar 2023 22:54:24 +0000 Subject: Update ch-1.pl --- challenge-209/james-smith/perl/ch-1.pl | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/challenge-209/james-smith/perl/ch-1.pl b/challenge-209/james-smith/perl/ch-1.pl index 98ddd16e71..c5a908afd5 100644 --- a/challenge-209/james-smith/perl/ch-1.pl +++ b/challenge-209/james-smith/perl/ch-1.pl @@ -17,3 +17,9 @@ sub special_bit_chars { ($_[0]&&shift),shift until @_<2; scalar @_ } + +sub special_bit_chars_reverse { + my$f,pop?return-1:pop||return 1; + $f=!$f,pop||last while@_; + ~~$f +} -- cgit From 47c95f2813ae6086c36f4e2c092079856215054f Mon Sep 17 00:00:00 2001 From: James Smith Date: Tue, 21 Mar 2023 11:25:06 +0000 Subject: Update README.md --- challenge-209/james-smith/README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/challenge-209/james-smith/README.md b/challenge-209/james-smith/README.md index 908f8c30b2..644fcfe6b9 100644 --- a/challenge-209/james-smith/README.md +++ b/challenge-209/james-smith/README.md @@ -44,8 +44,8 @@ First we need to note: ```perl sub special_bit_chars_reverse { my$f,pop?return-1:pop||return 1; - $f=!$f,pop||last while@_; - ~~$f + $f++,pop||last while@_; + $f&1 } # Task 2: Merge Account -- cgit From 0c3c9327bce650128225528c286482326051ad7a Mon Sep 17 00:00:00 2001 From: James Smith Date: Tue, 21 Mar 2023 11:25:38 +0000 Subject: Update README.md --- challenge-209/james-smith/README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/challenge-209/james-smith/README.md b/challenge-209/james-smith/README.md index 644fcfe6b9..98328e9b48 100644 --- a/challenge-209/james-smith/README.md +++ b/challenge-209/james-smith/README.md @@ -47,7 +47,7 @@ sub special_bit_chars_reverse { $f++,pop||last while@_; $f&1 } - +``` # Task 2: Merge Account Try all combinations and -- cgit From 842fa27317958486e2c40592eb7e33366e99eb21 Mon Sep 17 00:00:00 2001 From: James Smith Date: Tue, 21 Mar 2023 15:38:11 +0000 Subject: Update README.md --- challenge-209/james-smith/README.md | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/challenge-209/james-smith/README.md b/challenge-209/james-smith/README.md index 98328e9b48..47a6bbcd83 100644 --- a/challenge-209/james-smith/README.md +++ b/challenge-209/james-smith/README.md @@ -25,8 +25,8 @@ https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-209/ja Firstly we quickly check the last entry is a `0` if it isn't we return `-1` "error". We then look through each bit in turn - if it is `0` we go to the next bit; if it is a `1` we skip one bit and go to the next. We loop through to the end of the array. We loop till the array has `0` or `1` elements left - if we have one element left then the last character is an "a" if we have none it is not. So we can just return scalar @a`. ```perl sub special_bit_chars { - return -1 if $_[-1]; - ($_[0]&&shift),shift until @_<2; + return 0 if $_[-1]; + ($_[0]&&shift), shift until @_<2; scalar @_ } ``` @@ -43,9 +43,9 @@ First we need to note: ```perl sub special_bit_chars_reverse { - my$f,pop?return-1:pop||return 1; + my$f,pop?return 0:pop||return 1; $f++,pop||last while@_; - $f&1 + 1&$f } ``` # Task 2: Merge Account -- cgit From 2aebc498393b08f2d6249ef5fdc0697f64cf9f30 Mon Sep 17 00:00:00 2001 From: James Smith Date: Tue, 21 Mar 2023 15:47:31 +0000 Subject: Update ch-1.pl --- challenge-209/james-smith/perl/ch-1.pl | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/challenge-209/james-smith/perl/ch-1.pl b/challenge-209/james-smith/perl/ch-1.pl index c5a908afd5..7539610ef9 100644 --- a/challenge-209/james-smith/perl/ch-1.pl +++ b/challenge-209/james-smith/perl/ch-1.pl @@ -9,17 +9,17 @@ use Benchmark qw(cmpthese timethis); my @TESTS = ( [ [1,0,0] => 1 ], [ [1,1,1,0] => 0 ], - [ [1,1,1] => -1 ], + [ [1,1,1] => 0 ], ); sub special_bit_chars { - return -1 if $_[-1]; + return 0 if $_[-1]; ($_[0]&&shift),shift until @_<2; scalar @_ } sub special_bit_chars_reverse { - my$f,pop?return-1:pop||return 1; - $f=!$f,pop||last while@_; - ~~$f + my$f,pop?return 0:pop||return 1; + $f++,pop||last while@_; + 1&$f } -- cgit From a6318584dd29d4ceb0ed68cee9f99628a0c8dece Mon Sep 17 00:00:00 2001 From: Mark <53903062+andemark@users.noreply.github.com> Date: Wed, 22 Mar 2023 21:12:08 +0000 Subject: Challenge 209 Solutions (Raku) --- challenge-209/mark-anderson/raku/ch-1.raku | 3 +- challenge-209/mark-anderson/raku/ch-2.raku | 82 ++++++++++++++++++------------ 2 files changed, 50 insertions(+), 35 deletions(-) diff --git a/challenge-209/mark-anderson/raku/ch-1.raku b/challenge-209/mark-anderson/raku/ch-1.raku index dac544bd91..1584ebecc2 100644 --- a/challenge-209/mark-anderson/raku/ch-1.raku +++ b/challenge-209/mark-anderson/raku/ch-1.raku @@ -16,6 +16,5 @@ nok special-bit-chars(0,0,0,0,1,0); sub special-bit-chars(+$a) { - my $r = / 0+ | [10]+ | [11]+ /; - $a.join ~~ /^ $r* 0 $/ + $a.join ~~ /^ [ 0 | 10 | 11 ]* 0 $/ } diff --git a/challenge-209/mark-anderson/raku/ch-2.raku b/challenge-209/mark-anderson/raku/ch-2.raku index 5248fc8c76..dbe3f6efda 100644 --- a/challenge-209/mark-anderson/raku/ch-2.raku +++ b/challenge-209/mark-anderson/raku/ch-2.raku @@ -1,49 +1,65 @@ #!/usr/bin/env raku +use Test; -merge-accounts([ - ["A", "a1@a.com", "a2@a.com"], - ["B", "b1@b.com"], - ["A", "a3@a.com", "a1@a.com"] - ]); +is-deeply merge-accounts([ + [], + [], + [] + ]), + [ + [], + [] + ]; -merge-accounts([ - ["A", "a1@a.com", "a2@a.com"], - ["B", "b1@b.com"], - ["A", "a3@a.com"], - ["B", "b2@b.com", "b1@b.com"] - ]); +is-deeply merge-accounts([ + [], + [], + [], + [] + ]), + [ + [], + [], + [] + ];; -merge-accounts([ - ["C", "c2@c.com"], - ["C", "c1@c.com", "c4@c.com"], - ["A", "a1@a.com", "a2@a.com"], - ["B", "b1@b.com"], - ["A", "a3@a.com"], - ["C", "c1@c.com", "c3@c.com"], - ["B", "b2@b.com", "b1@b.com"], - ["A", "a3@a.com", "a4@a.com"], - ["B", "b3@b.com"]; - ]); +is-deeply merge-accounts([ + [], + [], + [], + [], + [], + [], + [], + [], + [], + []; + ]), + [ + [], + [], + [], + [], + [], + [], + [] + ]; sub merge-accounts(@accounts) { my @a = @accounts.classify({ .[0] }, :as{ .[1..*] }); - for @a.sort(*.key) + .Array given gather for @a.sort(*.key) { my $key = .key; my @value = .value>>.Array; - my @g = gather + while @value { - while @value - { - my @v := @value.shift; - my $k = @value.first({ $_ (&) @v }, :k); - $k.defined ?? @value[$k].append(@v) .= unique !! take @v; - } + my @v := @value.shift; + my $k = @value.first({ $_ (&) @v }, :k); + $k.defined ?? (@value[$k] = [(@value[$k] (|) @v).keys]) + !! take [($key, @v.sort.Slip)]; } - - say $key => @g>>.sort; - } + } } -- cgit From 284c2b7d28928a733a627fe213ff719cd3ff4e10 Mon Sep 17 00:00:00 2001 From: Mark <53903062+andemark@users.noreply.github.com> Date: Wed, 22 Mar 2023 21:22:19 +0000 Subject: Challenge 209 Solutions (Raku) --- challenge-209/mark-anderson/raku/ch-2.raku | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/challenge-209/mark-anderson/raku/ch-2.raku b/challenge-209/mark-anderson/raku/ch-2.raku index dbe3f6efda..b84ffb5aae 100644 --- a/challenge-209/mark-anderson/raku/ch-2.raku +++ b/challenge-209/mark-anderson/raku/ch-2.raku @@ -51,15 +51,13 @@ sub merge-accounts(@accounts) .Array given gather for @a.sort(*.key) { - my $key = .key; my @value = .value>>.Array; - while @value + while @value.shift -> @v { - my @v := @value.shift; my $k = @value.first({ $_ (&) @v }, :k); $k.defined ?? (@value[$k] = [(@value[$k] (|) @v).keys]) - !! take [($key, @v.sort.Slip)]; + !! take [(.key, @v.sort.Slip)]; } } } -- cgit