Merge pull request #7776 from jacoby/master

#209 DAJ

3 files changed, 147 insertions, 0 deletions

diff --git a/challenge-209/dave-jacoby/blog.txt b/challenge-209/dave-jacoby/blog.txt
new file mode 100644
index 0000000000..12120c127d
--- /dev/null
+++ b/challenge-209/dave-jacoby/blog.txt
@@ -0,0 +1 @@
+https://jacoby.github.io/2023/03/20/give-a-little-bit-weekly-challenge-209.html
diff --git a/challenge-209/dave-jacoby/perl/ch-1.pl b/challenge-209/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..d0f1cee700
--- /dev/null
+++ b/challenge-209/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,71 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+
+my @examples = (
+
+    [qw{ 0 }],
+    [qw{ 0 0 }],
+    [qw{ 1 0 }],
+    [qw{ 0 0 0 }],
+    [qw{ 0 1 0 }],
+    [qw{ 1 0 0 }],
+    [qw{ 1 1 0 }],
+
+    [qw{ 1 1 1 1 1 0 }],
+    [qw{ 1 1 1 1 1 1 0 }],
+    [qw{ 1 1 1 1 1 1 1 0 }],
+    [qw{ 1 1 1 1 1 1 1 1 0 }],
+
+);
+
+for my $e (@examples) {
+    my @bits = $e->@*;
+    my $bits = join ', ', @bits;
+    $bits = qq{($bits)};
+    my $o = special_bit_chars(@bits);
+    my $p = sbc(@bits);
+    say <<"END";
+    Input:  \@bits = $bits
+    Output: $o
+            $p
+END
+}
+
+sub sbc (@array) {
+    return 1 if scalar @array == 1;    #           0
+    return 1 if $array[-2] == 0;       #     ... 0 0
+    my $str = join '', @array;
+    my ($c) = $str =~ m{(1+)0$}g;
+    return ( length $c ) % 2 ? 0 : 1;
+}
+
+sub special_bit_chars (@array) {
+
+    # 0 = a
+    # 1,0 = b
+    # 1,1 = c
+
+    my $last;
+    while (@array) {
+        if ( $array[0] == 1 ) {
+            if ( $array[1] == 1 ) {
+                $last = 'C';
+                shift @array;
+                shift @array;
+            }
+            elsif ( $array[1] == 0 ) {
+                $last = 'B';
+                shift @array;
+                shift @array;
+            }
+        }
+        else {
+            $last = 'A';
+            shift @array;
+        }
+    }
+    return $last eq 'A' ? 1 : 0;
+}
diff --git a/challenge-209/dave-jacoby/perl/ch-2.pl b/challenge-209/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..5516082ae5
--- /dev/null
+++ b/challenge-209/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,75 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+
+use List::Compare;
+use JSON;
+my $json = JSON->new->pretty;
+
+my @examples = (
+
+    [
+        [ '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' ]
+    ],
+);
+
+for my $e (@examples) {
+    my $i = format_mailbox( $e->@* );
+    my @o = merge_mailbox( $e->@* );
+    my $o = format_mailbox(@o);
+    say <<"END";
+    Input:  \@accounts = 
+      $i
+    Output: 
+      $o
+END
+    say '';
+}
+
+# yes, a more complex version of JSON->encode
+sub format_mailbox (@accounts) {
+    @accounts = sort { $a->[0] cmp $b->[0] } @accounts;
+    my $output = join ",\n\t", map { qq{[$_]} }
+        map {
+        join ',',
+            map { qq{"$_"} }
+            $_->@*
+        } @accounts;
+    $output = join ' ', '[', $output, ']';
+    return $output;
+}
+
+sub merge_mailbox (@input) {
+    my @accounts = @input;
+    for my $i ( 0 .. -2 + scalar @accounts ) {
+        my $ai = $accounts[$i];
+        my @ii = $ai->@*;
+        shift @ii;
+        for my $j ( $i + 1 .. -1 + scalar @accounts ) {
+            my $aj = $accounts[$j];
+            next unless defined $aj;
+            my @jj = $aj->@*;
+            shift @jj;
+            my $lc    = List::Compare->new( \@ii, \@jj );
+            my @inter = $lc->get_intersection;
+            if ( scalar @inter ) {
+                my @union = $lc->get_union;
+                my $ni    = $ai->[0];
+                $ai->@* = ( $ni, @union );
+                $aj->@* = ();
+            }
+        }
+    }
+    @accounts = sort { $a->[0] cmp $b->[0] } grep { scalar $_->@* } @accounts;
+    return @accounts;
+}