Merge pull request #7779 from polettix/polettix/pwc209

Add polettix's solution to challenge-209

6 files changed, 147 insertions, 0 deletions

diff --git a/challenge-209/polettix/blog.txt b/challenge-209/polettix/blog.txt
new file mode 100644
index 0000000000..caf904fe84
--- /dev/null
+++ b/challenge-209/polettix/blog.txt
@@ -0,0 +1 @@
+https://etoobusy.polettix.it/2023/03/23/pwc209-special-bit-characters/
diff --git a/challenge-209/polettix/blog1.txt b/challenge-209/polettix/blog1.txt
new file mode 100644
index 0000000000..e5d77f15d4
--- /dev/null
+++ b/challenge-209/polettix/blog1.txt
@@ -0,0 +1 @@
+https://etoobusy.polettix.it/2023/03/24/pwc209-merge-account/
diff --git a/challenge-209/polettix/perl/ch-1.pl b/challenge-209/polettix/perl/ch-1.pl
new file mode 100644
index 0000000000..a2720c0efe
--- /dev/null
+++ b/challenge-209/polettix/perl/ch-1.pl
@@ -0,0 +1,11 @@
+#!/usr/bin/env perl
+use v5.24;
+use warnings;
+use experimental 'signatures';
+
+my @bits = map { split m{}mxs } @ARGV;
+say special_bits_characters(\@bits);
+
+sub special_bits_characters ($bits) {
+   join('', $bits->@*) =~ m{\A (?: 1[01] | 0 )* 0 \z}mxs ? 1 : 0;
+}
diff --git a/challenge-209/polettix/perl/ch-2.pl b/challenge-209/polettix/perl/ch-2.pl
new file mode 100644
index 0000000000..b6c7fe78e4
--- /dev/null
+++ b/challenge-209/polettix/perl/ch-2.pl
@@ -0,0 +1,84 @@
+#!/usr/bin/env perl
+use v5.24;
+use warnings;
+use experimental 'signatures';
+
+use constant TRUE  => (!0);
+use constant FALSE => (!!0);
+
+my @accounts = (
+   ['A', 'a1@a.com', 'a2@a.com'],
+   ['B', 'b1@b.com'],
+   ['A', 'a3@a.com', 'a4@a.com'],
+   ['B', 'b2@b.com', 'b1@b.com'],
+   ['A', 'a8@a.com'],
+   ['A', 'a3@a.com', 'a2@a.com'],
+);
+
+for my $merged (merge_accounts(\@accounts)->@*) {
+   say '[', join(', ', map { +"'$_'"} $merged->@* ), ']';
+}
+
+sub hashes_intersect ($h1, $h2) {
+   my $n1 = scalar(keys($h1->%*));
+   my $n2 = scalar(keys($h2->%*));
+   ($h1, $h2) = ($h2, $h1) if $n1 > $n2;
+
+   # now $h1 has *at most* as many elements as $h2, it's beneficial to
+   # iterate over it
+   for my $key (keys $h1->%*) {
+      return TRUE if exists $h2->{$key};
+   }
+   return FALSE;
+}
+
+sub merge_accounts ($aref) {
+   my %alternatives_for;  # track each name separately
+   my %group_for;         # track aggregated groups by order of appearance
+   for my $i (0 .. $aref->$#*) {
+      my ($name, @addresses) = $aref->[$i]->@*;
+      $group_for{$i} = my $new = {
+         i => $i,
+         name => $name,
+         addresses => { map { $_ => 1 } @addresses },
+      };
+
+      # Add this group like it's detached
+      my $all_groups = $alternatives_for{$name} //= [];
+      push $all_groups->@*, $new;
+
+      # sweep back to merge when necessary
+      my $challenger = $all_groups->$#*;
+      my $resistant = $challenger - 1;
+      my $last_wiped;
+      while ($resistant >= 0) {
+         my $cas = $all_groups->[$challenger]{addresses};
+         my $ras = $all_groups->[$resistant]{addresses};
+         if (hashes_intersect($cas, $ras)) {
+            $ras->%* = ($ras->%*, $cas->%*);     # merge
+
+            ($last_wiped, $challenger) = ($challenger, $resistant);
+            delete $group_for{$all_groups->[$last_wiped]{i}};
+            $all_groups->[$last_wiped] = undef;
+         }
+         --$resistant;
+      }
+
+      # sweep ahead to remove wiped out stuff, if necessary
+      if (defined($last_wiped)) {
+         my $marker = my $cursor = $last_wiped;
+         while (++$cursor < $all_groups->$#*) {
+            next if defined($all_groups->[$cursor]);
+            $all_groups->[$marker++] = $all_groups->[$cursor];
+         }
+         splice $all_groups->@*, $marker if $marker < $all_groups->@*;
+      }
+   }
+
+   my @accounts = map {
+      my $group = $group_for{$_};
+      [ $group->{name}, sort { $a cmp $b } keys $group->{addresses}->%* ];
+   } sort { $a <=> $b } keys %group_for;
+
+   return \@accounts;
+}
diff --git a/challenge-209/polettix/raku/ch-1.raku b/challenge-209/polettix/raku/ch-1.raku
new file mode 100644
index 0000000000..c05dacc298
--- /dev/null
+++ b/challenge-209/polettix/raku/ch-1.raku
@@ -0,0 +1,7 @@
+#!/usr/bin/env raku
+use v6;
+sub MAIN ($bits) { put special-bits-characters($bits.comb.Array) }
+
+sub special-bits-characters ($bits) {
+   $bits.join('') ~~ m{^ [ 1 <[ 0 1 ]> | 0 ]* 0 $} ?? 1 !! 0;
+}
diff --git a/challenge-209/polettix/raku/ch-2.raku b/challenge-209/polettix/raku/ch-2.raku
new file mode 100644
index 0000000000..9c82420168
--- /dev/null
+++ b/challenge-209/polettix/raku/ch-2.raku
@@ -0,0 +1,43 @@
+#!/usr/bin/env raku
+use v6;
+sub MAIN {
+   my @accounts =
+      ['A', 'a1@a.com', 'a2@a.com'],
+      ['B', 'b1@b.com'],
+      ['A', 'a3@a.com', 'a4@a.com'],
+      ['B', 'b2@b.com', 'b1@b.com'],
+      ['A', 'a8@a.com'],
+      ['A', 'a3@a.com', 'a2@a.com'],
+   ;
+
+   for merge-accounts(@accounts) -> $merged {
+      put '[', $merged.map({"'$_'"}).join(', '), ']';
+   }
+}
+
+sub merge-accounts (@accounts) {
+   my %alternatives_for;
+   for @accounts -> $account {
+      my ($name, @addresses) = @$account;
+      my $new = { name => $name, addresses => @addresses.Set };
+
+      my @disjoint;
+      my $all = %alternatives_for{$name} //= [];
+      for @$all -> $candidate {
+         if ($new<addresses> ∩ $candidate<addresses>) { # merge
+            $new<addresses> = (
+               $new<addresses>.keys.Slip,
+               $candidate<addresses>.keys.Slip
+            ).Set;
+         }
+         else {
+            @disjoint.push: $candidate;
+         }
+      }
+      @disjoint.push: $new;
+      %alternatives_for{$name} = @disjoint;
+   }
+   return %alternatives_for.values».Slip.flat
+      .map({[ $_<name>, $_<addresses>.keys.Slip ]})
+      .Array;
+}