Pip Stuart's submission for challenge-209.

4 files changed, 187 insertions, 0 deletions

diff --git a/challenge-209/pip/perl/ch-1.pl b/challenge-209/pip/perl/ch-1.pl
new file mode 100644
index 0000000000..eb59fda5e0
--- /dev/null
+++ b/challenge-209/pip/perl/ch-1.pl
@@ -0,0 +1,34 @@
+#!/usr/bin/perl
+# HTTPS://TheWeeklyChallenge.Org - Perl/Raku Weekly Challenge #209 - Pip Stuart
+# Task1: Special Bit Characters:  Submitted by: Mohammad S Anwar;  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.
+# Example1:
+#   In-put: @bits = (1, 0, 0   )
+#   Output:          1           The given array bits can be decoded as 2-bits character (10) followed by 1-bit character (0).
+# Example2:
+#   In-put: @bits = (1, 1, 1, 0)
+#   Output:          0           Possible decode can be 2-bits character (11) followed by 2-bits character (10) i.e. the last character is not 1-bit character.
+use strict;use warnings;use utf8;use v5.12;my $d8VS='N3PM6NSe';
+sub SBCh {my @bitz = @_;my @bits = @bitz;my $sbch = 0;my $dcds = '';
+  while     (@bits        ) {
+    if      ($bits[0] == 1) { shift(@bits);
+      if    (@bits        ) {
+        if  ($bits[0] == 1) { $dcds .= 'c';
+        } else              { $dcds .= 'b';
+        };                    shift(@bits); }
+    }     else              { shift(@bits);
+                              $dcds .= 'a'; } }
+  $sbch = 1 if              ( $dcds =~ /a$/ );
+  printf("(%-10s) => %s;\n", join(', ', @bitz), $sbch);
+  return($sbch);
+}
+if    (@ARGV) {
+  SBCh(@ARGV);
+} else {
+  SBCh(1, 0, 0   ); # => 1;
+  SBCh(1, 1, 1, 0); # => 0;
+}
diff --git a/challenge-209/pip/perl/ch-2.pl b/challenge-209/pip/perl/ch-2.pl
new file mode 100644
index 0000000000..fd39420d35
--- /dev/null
+++ b/challenge-209/pip/perl/ch-2.pl
@@ -0,0 +1,59 @@
+#!/usr/bin/perl
+# HTTPS://TheWeeklyChallenge.Org - Perl/Raku Weekly Challenge #209 - Pip Stuart
+# Task2: Merge Account:  Submitted by: Mohammad S Anwar;  You are given an array of accounts i.e. 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.
+# Example1:
+#   In-put: @accounts = [ ["A", "a1@a.com", "a2@a.com"],
+#                         ["B", "b1@b.com"],
+#                         ["A", "a3@a.com", "a1@a.com"] ]
+#   Output:             [ ["A", "a1@a.com", "a2@a.com", "a3@a.com"],
+#                         ["B", "b1@b.com"] ]
+# Example2:
+#   In-put: @accounts = [ ["A", "a1@a.com", "a2@a.com"],
+#                         ["B", "b1@b.com"],
+#                         ["A", "a3@a.com"],
+#                         ["B", "b2@b.com", "b1@b.com"] ]
+#   Output:             [ ["A", "a1@a.com", "a2@a.com"],
+#                         ["A", "a3@a.com"],
+#                         ["B", "b1@b.com", "b2@b.com"] ]
+# Last date to submit the solution 23:59 (UK Time) Sunday 26th March 2023.
+use strict;use warnings;use utf8;use v5.12;my $d8VS='N3PM8qQm';
+sub MrgA { my    $actz = shift(@_);    my $outp =[];
+  for   my $andx (0 .. @{$actz} - 1) { my $cmnf = 0;
+    for my $ondx (0 .. @{$outp} - 1) { # loop thru outp for any aref matching actz->[$andx][0] with same group name (A or B)
+      if  ($actz->[$andx][0] eq $outp->[$ondx][   0]) {my %emlz = ();
+        for   my $aend ( 1 .. @{$actz->[$andx]} - 1 ) { $emlz{ $actz->[$andx][$aend]} = 1;
+          for my $oend ( 1 .. @{$outp->[$ondx]} - 1 ) {
+            if  ($actz->[$andx][$aend] eq $outp->[$ondx][$oend]) { $cmnf = 1; last; } }
+        };  if  ($cmnf                              ) {
+          for my $oend ( 1 .. @{$outp->[$ondx]} - 1 ) { $emlz{ $outp->[$ondx][$oend]} = 1; } # save the output e-mails in the hash too...
+          for my $oend ( 1 .. @{$outp->[$ondx]} - 1 ) { pop( @{$outp->[$ondx]       }   ); } #   ... before popping them all off then ...
+          for my $emal (sort(keys(%emlz))           ) { push(@{$outp->[$ondx]       }, $emal ); } } } # ... add both original accounts && matching output ones
+    };  unless  ($cmnf                              ) { push(@{$outp                },    [] ); # can't just push orig actz array refz since outp needs diff
+      for     my $aall ( 0 .. @{$actz->[$andx]} - 1 ) { push(@{$outp->[   -1]       }, $actz->[$andx][$aall]); } } }
+  printf(           "[ ['%s']", join("', '", @{$actz->[ 0]})) if (@{$actz});
+  if    (     @{$actz} > 1) {   say   ',';
+    for (1 .. @{$actz} - 1) {
+      printf(       "  ['%s']", join("', '", @{$actz->[$_]}));
+      say                    ','  if (  $_ < @{$actz} - 1   ); }
+  };  printf( " ] => [ ['%s']", join("', '", @{$outp->[ 0]})) if (@{$outp});
+  if    (     @{$outp} > 1) {   say   ',';
+    for (1 .. @{$outp} - 1) {   print ' ' x 31;
+      printf( "        ['%s']", join("', '", @{$outp->[$_]}));
+      say                    ','  if (  $_ < @{$outp} - 1   ); }
+  };  say     " ];";
+  return($outp); }
+if    (@ARGV) { say "!*Eror*! This code doesn't accept arguments. Please edit the source to specify an anonymous array of anonymous arrays as input.";
+# MrgA(@ARGV);
+} else { # I switched all the strings to single-quoted so that the at-signs @ wouldn't need escaping or try to interpolate as arrays.
+  MrgA( [ ['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'] ];
+  MrgA( [ ['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'],
+                                             #      ['B', 'b1@b.com', 'b2@b.com'], # maybe supposed to re-order all A groups together before all B groups...
+                                             #      ['A', 'a3@a.com'] ];           #   ... but I think my output is close enough preserving input  group order;
+}
diff --git a/challenge-209/pip/raku/ch-1.raku b/challenge-209/pip/raku/ch-1.raku
new file mode 100644
index 0000000000..20d0df3649
--- /dev/null
+++ b/challenge-209/pip/raku/ch-1.raku
@@ -0,0 +1,34 @@
+#!/usr/bin/env raku
+# HTTPS://TheWeeklyChallenge.Org - Perl/Raku Weekly Challenge #209 - Pip Stuart
+# Task1: Special Bit Characters:  Submitted by: Mohammad S Anwar;  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.
+# Example1:
+#   In-put: @bits = (1, 0, 0   )
+#   Output:          1           The given array bits can be decoded as 2-bits character (10) followed by 1-bit character (0).
+# Example2:
+#   In-put: @bits = (1, 1, 1, 0)
+#   Output:          0           Possible decode can be 2-bits character (11) followed by 2-bits character (10) i.e. the last character is not 1-bit character.
+use v6;my $d8VS='N3PM952g';
+sub SBCh {my @bitz = @_;my @bits = @bitz;my $sbch = 0;my $dcds = '';
+  while     (@bits        ) {
+    if      (@bits[0] == 1) { shift(@bits);
+      if    (@bits        ) {
+        if  (@bits[0] == 1) { $dcds ~= 'c';
+        } else              { $dcds ~= 'b';
+        };                    shift(@bits); }
+    }     else              { shift(@bits);
+                              $dcds ~= 'a'; } }
+  $sbch = 1 if              ( $dcds ~~ /a$/ );
+  printf("(%-10s) => %s;\n", join(', ', @bitz), $sbch);
+  return($sbch);
+}
+if    (@*ARGS) {
+  SBCh(@*ARGS);
+} else {
+  SBCh(1, 0, 0   ); # => 1;
+  SBCh(1, 1, 1, 0); # => 0;
+}
diff --git a/challenge-209/pip/raku/ch-2.raku b/challenge-209/pip/raku/ch-2.raku
new file mode 100644
index 0000000000..1a0dcd7c0b
--- /dev/null
+++ b/challenge-209/pip/raku/ch-2.raku
@@ -0,0 +1,60 @@
+#!/usr/bin/env raku
+# HTTPS://TheWeeklyChallenge.Org - Perl/Raku Weekly Challenge #209 - Pip Stuart
+# Task2: Merge Account:  Submitted by: Mohammad S Anwar;  You are given an array of accounts i.e. 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.
+# Example1:
+#   In-put: @accounts = [ ["A", "a1@a.com", "a2@a.com"],
+#                         ["B", "b1@b.com"],
+#                         ["A", "a3@a.com", "a1@a.com"] ]
+#   Output:             [ ["A", "a1@a.com", "a2@a.com", "a3@a.com"],
+#                         ["B", "b1@b.com"] ]
+# Example2:
+#   In-put: @accounts = [ ["A", "a1@a.com", "a2@a.com"],
+#                         ["B", "b1@b.com"],
+#                         ["A", "a3@a.com"],
+#                         ["B", "b2@b.com", "b1@b.com"] ]
+#   Output:             [ ["A", "a1@a.com", "a2@a.com"],
+#                         ["A", "a3@a.com"],
+#                         ["B", "b1@b.com", "b2@b.com"] ]
+# Last date to submit the solution 23:59 (UK Time) Sunday 26th March 2023.
+use v6;my $d8VS='N3PM9779';
+sub MrgA { my @argv = @_;my $actz = []; my $outp = [];
+  while   (   @argv.elems) {$actz.push(shift(@argv)); }
+  for          ( 0 .. @($actz       ).elems - 1 ) -> $andx { my $cmnf = 0;
+    for        ( 0 .. @($outp       ).elems - 1 ) -> $ondx { # loop thru outp for any aref matching actz->[$andx][0] with same group name (A or B)
+      if  ($actz[$andx][0] eq $outp[$ondx][  0] )          { my %emlz = ();
+        for    ( 1 .. @($actz[$andx]).elems - 1 ) -> $aend { %emlz{ $actz[$andx][$aend]} = 1;
+          for  ( 1 .. @($outp[$ondx]).elems - 1 ) -> $oend {
+            if ($actz[$andx][$aend] eq  $outp[$ondx][$oend]) {  $cmnf = 1; last; } }
+        };  if ($cmnf                           )          {
+          for  ( 1 .. @($outp[$ondx]).elems - 1 ) -> $oend { %emlz{ $outp[$ondx][$oend]} = 1; } # save the output e-mails in the hash too...
+          for  ( 1 .. @($outp[$ondx]).elems - 1 ) -> $oend { pop( @($outp[$ondx]       )   ); } #   ... before popping them all off then ...
+          for  (sort(keys(%emlz))               ) -> $emal { push(@($outp[$ondx]       ), $emal ); } } } # ... add both orig accounts && matching output ones
+    };  unless ($cmnf                           )          { push(@($outp              ),    [] ); # can't just push orig actz arefz since outp needs diff
+      for      ( 0 .. @($actz[$andx]).elems - 1 ) -> $aall { push(@($outp[  *-1]       ), $actz[$andx][$aall]); } } }
+  printf(           "[ ['%s']", join("', '", @($actz[ 0]))) if (@($actz).elems);
+  if    (     @($actz).elems > 1) {   say   ',';
+    for (1 .. @($actz).elems - 1) {
+      printf(       "  ['%s']", join("', '", @($actz[$_])));
+      say                    ','  if (  $_ < @($actz).elems - 1   ); }
+  };  printf( " ] => [ ['%s']", join("', '", @($outp[ 0]))) if (@($outp).elems);
+  if    (     @($outp).elems > 1) {   say   ',';
+    for (1 .. @($outp).elems - 1) {   print ' ' x 31;
+      printf( "        ['%s']", join("', '", @($outp[$_])));
+      say                    ','  if (  $_ < @($outp).elems - 1   ); }
+  };  say     " ];";
+  return($outp); }
+if    (@*ARGS) { say "!*Eror*! This code doesn't accept arguments. Please edit the source to specify an anonymous array of anonymous arrays as input.";
+# MrgA(@*ARGS);
+} else { # I switched all the strings to single-quoted so that the at-signs @ wouldn't need escaping or try to interpolate as arrays.
+  MrgA( [ ['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'] ];
+  MrgA( [ ['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'],
+                                             #      ['B', 'b1@b.com', 'b2@b.com'], # maybe supposed to re-order all A groups together before all B groups...
+                                             #      ['A', 'a3@a.com'] ];           #   ... but I think my output is close enough preserving input  group order;
+}