From f315e53ab03f076f9e19ffbba48ee8a6f96ea4eb Mon Sep 17 00:00:00 2001 From: Peter Campbell Smith Date: Wed, 22 Mar 2023 11:24:46 +0000 Subject: Week 209 ... --- challenge-209/peter-campbell-smith/blog.txt | 1 + challenge-209/peter-campbell-smith/perl/ch-1.pl | 43 +++++++++++ challenge-209/peter-campbell-smith/perl/ch-2.pl | 95 +++++++++++++++++++++++++ 3 files changed, 139 insertions(+) create mode 100644 challenge-209/peter-campbell-smith/blog.txt create mode 100755 challenge-209/peter-campbell-smith/perl/ch-1.pl create mode 100755 challenge-209/peter-campbell-smith/perl/ch-2.pl diff --git a/challenge-209/peter-campbell-smith/blog.txt b/challenge-209/peter-campbell-smith/blog.txt new file mode 100644 index 0000000000..be1df69e9c --- /dev/null +++ b/challenge-209/peter-campbell-smith/blog.txt @@ -0,0 +1 @@ +http://ccgi.campbellsmiths.force9.co.uk/challenge/209 diff --git a/challenge-209/peter-campbell-smith/perl/ch-1.pl b/challenge-209/peter-campbell-smith/perl/ch-1.pl new file mode 100755 index 0000000000..5f0181121e --- /dev/null +++ b/challenge-209/peter-campbell-smith/perl/ch-1.pl @@ -0,0 +1,43 @@ +#!/usr/bin/perl + +# Peter Campbell Smith - 2023-03-20 + +use v5.28; +use utf8; +use warnings; + +# 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. + +# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge/209/1 + +test_for_a([1, 0, 0]); +test_for_a([1, 1, 1, 0]); +test_for_a([1, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 0]); +test_for_a([1, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 0]); +test_for_a([0]); + +sub test_for_a { + + my (@bits, $bit_string, $good); + + # get array and convert to string + @bits = @{$_[0]}; + $bit_string = join('', @bits); + + # if it ends 00 or is just 0 then it ends in 'a' + if ($bit_string =~ m|00$| or $bit_string eq '0') { + $good = 1; + + # if it ends 10 then it ends in 'a' if the final 0 is preceded by an even no of 1s + } else { + $bit_string =~ m|(1*)0$|; + $good = length($1) & 1 ? 0 : 1; + } + + # say the answer + say qq[\nInput: \@bits = (] . join(', ', @bits) . qq[)\nOutput: $good]; +} diff --git a/challenge-209/peter-campbell-smith/perl/ch-2.pl b/challenge-209/peter-campbell-smith/perl/ch-2.pl new file mode 100755 index 0000000000..24456af3a5 --- /dev/null +++ b/challenge-209/peter-campbell-smith/perl/ch-2.pl @@ -0,0 +1,95 @@ +#!/usr/bin/perl + +# Peter Campbell Smith - 2023-03-20 + +use v5.28; +use utf8; +use warnings; + +# You are given an array of accounts, ie 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. + +# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge/209/2 + +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(['fred', 'fred@gmail.com', 'fgh@fgh.com', 'freddy@home.org'], + ['frederick', 'freddy@home.org'], + ['fbloggs', 'fbloggs@bloggs.co.uk'], + ['mary', 'freddy@home.org', 'mary@home.org']); + +sub merge_accounts { + + my (@accounts, $a, $j, $k, @acct_name, @emails, $merge, %owns_emails, $email, $rubric, + $line, %lines, $owner, $rubric1); + + @accounts = @_; # array of refs to accts + + # loop over accounts + for $j (0 .. scalar @accounts - 1) { + + # loop over account details + $merge = -1; + for $k (0 .. scalar @{$accounts[$j]} - 1) { + + # save account name and emails + if ($k == 0) { + $acct_name[$j] = $accounts[$j]->[0]; + } else { + $email = $accounts[$j]->[$k]; + + # mark for merging if email has been seen in a previous acct + if (defined $owns_emails{$email}) { + $merge = $owns_emails{$email}; + + # or record as seen here + } else { + $owns_emails{$email} = $j; + } + } + } + + # move emails from this account to $merge + if ($merge >= 0) { + for $email (keys %owns_emails) { + if ($owns_emails{$email} == $j) { + $owns_emails{$email} = $merge; + } + } + } + } + + # format input + say qq{\nInput: \@accounts = [}; + $rubric = $rubric1 = ''; + for $j (0 .. scalar @accounts - 1) { + $rubric1 = ''; + for $k (0 .. scalar @{$accounts[$j]} - 1) { + $rubric1 .= qq{'$accounts[$j]->[$k]', }; + } + $rubric1 =~ s|, $||; + $rubric .= qq{ [$rubric1],\n}; + } + $rubric =~ s|,\n$|]\n|; + say qq{$rubric}; + + # and output + for $email (sort keys %owns_emails) { + $owner = $owns_emails{$email}; + $lines{$owner} .= qq['$email', ]; + } + + $rubric = ''; + for $owner (sort keys %lines) { + $lines{$owner} =~ s|, $|],|; + $rubric .= qq{ ['$accounts[$owner]->[0]', $lines{$owner}\n}; + } + $rubric =~ s|,\n$|]|; + say qq{Output: \@accounts = [\n$rubric}; +} -- cgit