Solve 209: Special Bit Characters & Merge Account by E. Choroba

challenge-209/e-choroba/perl/ch-1.pl

@@ -0,0 +1,66 @@
+#! /usr/bin/perl
+use warnings;
+use strict;
+use experimental qw( signatures );
+
+sub special_bit_characters(@bits) {
+    my $pos = $#bits - 1;
+    --$pos while 1 == $bits[$pos];
+    return ($#bits - $pos) % 2
+}
+
+sub special_bit_characters_slow(@bits) {
+    my $string = "";
+    for (my $pos = 0; $pos <= $#bits; ++$pos) {
+        if ($bits[$pos] eq 0) {
+            $string .= 'a';
+        } else {
+            $string .= $bits[++$pos] ? 'c' : 'b';
+        }
+    }
+    return ('a' eq substr $string, -1) ? 1 : 0
+}
+
+my %TO_BITS = (a => [0],
+               b => [1, 0],
+               c => [1, 1]);
+sub encode($string) {
+    return map @{ $TO_BITS{$_} }, split //, $string
+}
+
+use Test::More tests => 2 + 72;
+is special_bit_characters_slow(1, 0, 0), 1, 'Example 1';
+is special_bit_characters_slow(1, 1, 1, 0), 0, 'Example 2';
+
+my @strings = qw( a b aa ab ba bb ca cb
+                  aaa aab aba abb aca acb
+                  baa bab bba bbb bca bcb
+                  caa cab cba cbb cca ccb );
+push @strings, map $_ . qw( a b )[int rand 2],
+               join "",
+               map qw( a b c )[int rand 3],
+               1 .. 100
+    for 1 .. 10;
+
+for my $string (@strings) {
+    my @bits = encode($string);
+    is special_bit_characters_slow(@bits),
+        ($string =~ /a$/) ? 1 : 0,
+        "$string";
+    is special_bit_characters(@bits),
+       special_bit_characters_slow(@bits),
+       "same $string";
+}
+
+use Benchmark qw{ cmpthese };
+
+my @inputs = map [encode($_)], @strings;
+cmpthese(-3, {
+    slow => sub { special_bit_characters_slow(@$_) for @inputs },
+    fast => sub { special_bit_characters(@$_) for @inputs }
+});
+
+__END__
+        Rate slow fast
+slow  5103/s   -- -82%
+fast 27748/s 444%   --

challenge-209/e-choroba/perl/ch-2.pl

@@ -0,0 +1,92 @@
+#! /usr/bin/perl
+use warnings;
+use strict;
+
+use Test2::V0;
+
+use experimental qw( signatures );
+
+use Graph::Undirected;
+
+sub merge_account(@accounts) {
+    my %seen;
+    for my $idx (0 .. $#accounts) {
+        my $account = $accounts[$idx];
+        my ($name, @addresses) = @$account;
+        undef $seen{$_}{$name}{$idx} for @addresses;
+    }
+
+    my $g = 'Graph::Undirected'->new(unionfind => 1);
+    for my $address (keys %seen) {
+        for my $name (keys %{ $seen{$address} }) {
+            my @indices = keys %{ $seen{$address}{$name} };
+            for my $i (0 .. $#indices - 1) {
+                for my $j ($i + 1 .. $#indices) {
+                    $g->add_edge(@indices[$i, $j]);
+                }
+            }
+        }
+    }
+
+    for my $component ($g->connected_components) {
+        my $first = shift @$component;
+        my %emails;
+        @emails{ @{ $accounts[$first] }[1 .. $#{ $accounts[$first] }] } = ();
+        for my $next (@$component) {
+            @emails{ @{ $accounts[$next] }[1 .. $#{ $accounts[$next] }] } = ();
+            undef $accounts[$next];
+        }
+        $accounts[$first] = [$accounts[$first][0], keys %emails];
+    }
+    return [grep defined, @accounts]
+}
+
+plan 8;
+sub verify($got, $expected, $name) {
+    is $got, bag {
+        for my $account (@$expected) {
+            item bag {
+                item $_ for @$account;
+                end();
+            }
+        }
+        end();
+    }, $name;
+
+    is $got, bag {
+        item array {
+            item $_->[0];
+            etc();
+        } for @$expected;
+        end();
+    }, "$name: name goes first";
+}
+
+verify(merge_account(['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', 'a3@a.com'],
+        ['B', 'b1@b.com']],
+       'Example 1');
+
+verify(merge_account(['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'],
+        ['B', 'b1@b.com', 'b2@b.com']],
+       'Example 2');
+
+verify(merge_account(['A', 'a1@a.com', 'a2@a.com'],
+                     ['A', 'b1@b.com', 'a1@a.com'],
+                     ['A', 'a3@a.com', 'b1@b.com']),
+       [['A', 'a1@a.com', 'a2@a.com', 'a3@a.com', 'b1@b.com']],
+       'Merge 3');
+
+verify(merge_account(['A', 'a1@a.com', 'a2@a.com'],
+                     ['A', 'b1@b.com', 'a1@a.com'],
+                     ['A', 'a3@a.com', 'b1@b.com'],
+                     ['A', 'a3@a.com', 'b2@b.com']),
+       [['A', 'a1@a.com', 'a2@a.com', 'a3@a.com', 'b1@b.com', 'b2@b.com']],
+       'Merge 4');