diff options
| -rwxr-xr-x | challenge-209/e-choroba/perl/ch-1.pl | 66 | ||||
| -rwxr-xr-x | challenge-209/e-choroba/perl/ch-2.pl | 92 |
2 files changed, 158 insertions, 0 deletions
diff --git a/challenge-209/e-choroba/perl/ch-1.pl b/challenge-209/e-choroba/perl/ch-1.pl new file mode 100755 index 0000000000..2b3e39c8e0 --- /dev/null +++ b/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% -- diff --git a/challenge-209/e-choroba/perl/ch-2.pl b/challenge-209/e-choroba/perl/ch-2.pl new file mode 100755 index 0000000000..cf74d143ca --- /dev/null +++ b/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'); |