# Perl Weekly Challenge 209.

My solutions (task 1 and task 2 ) to the The Weekly Challenge - 209.

# Task 1: 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:

 -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.

Example 1
Input: @bits = (1, 0, 0)
Output: 1

The given array bits can be decoded as 2-bits character (10) followed by 1-bit
character (0).
Example 2
Input: @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.
``````

I guess an anchored regular expression might do the job:

``````perl -E 'say " \$_ ->", /^(1(1|0)|0)*0\$/?1:0 for(@ARGV)' 100 1110
``````

Results:

``````100 ->1
1110 ->0
``````

With slightly more work I can also decode the string:

``````perl -E '
@p{qw(0 10 11)}=qw(a b c);say " \$_ -> ", (map {\$x=\$p{\$_}} grep {length \$_} split /(1.|0)/), " -> ",
\$x eq "a"?1:0 for(@ARGV)' 100 1110
``````

Results:

``````100 -> ba -> 1
1110 -> cb -> 0
``````

Here I first build a hash of patterns to translate bit sequences to characters. Then, I `split` the input on the expected sequences `1.` or `0`, capturing the separators (I could have used `/(1.)/` above). I throw away with `grep` the empty strings produced by `split` between separators. Then I convert the patterns to their corresponding characters, print them, and check the last one, saved in a variable, is an “a”.

The full code adds a couple of checks.

`````` 1  # Perl weekly challenge 209
2  # Task 1:  Special Bit Characters
3  #
5  use v5.36;
6  my %patterns;
7  die <<~"EOF" unless @ARGV;
8      Usage: \$0 S1 [S2...]
9      to decode the binary sequences S1 S2
10      using the code 0->a, 10->b 11->c
11      EOF
12
13  @patterns{qw(0 10 11)}=qw(a b c);
14  for(@ARGV){
15      my \$last;
16      die "Not a binary pattern: \$_\n" unless /^(0|1)+/; #Check input
17      say " \$_ -> ",
18          (
19  	 map {\$last=\$patterns{\$_}}
20  	 grep {length \$_}
21  	 split /(1.|0)/
22  	),
23  	" -> ",
24  	\$last eq "a"?1:0;
25  }
``````

Example:

``````./ch-1.pl  100 1110
``````

Results:

``````100 -> ba -> 1
1110 -> cb -> 0
``````

``````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.

Example 1:

Input: @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"] ]
Example 2:

Input: @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"] ]
``````

It is not clear what to do if two accounts share an email but do share name. I will merge anyway. I will assume the array of accounts is given in an input file, one space separated row per account in the format

``````name address1 address2...
``````

I made several attempts to solve this task, and all worked well with the given examples, but I found other examples where they failed. A solution that finally seems to work is to map each address to the merged line number and to map each line number to its corresponding addresses as the input is read line by line. If any address has already been assigned a line number, all its addresses are added to the current line and the previous line is deleted. At the end print the resulting lines. The result fits a two and a half liner.

``````perl -MList::Util=uniq -nE 'chomp; (\$n[\$.],@a)=split " "; @m=grep {defined \$_} map {\$l{\$_}} @a;
push @a, map {@{\$a{\$_}}} @m; @a=uniq @a; delete \$a{\$_} for @m;@l{@a}=(\$.)x@a; \$a{\$.}=[@a];
END {say "\$n[\$_] @{\$a{\$_}}" for keys %a;}' <<EOF
A a1@a.com a2@a.com
B b1@b.com
A a3@a.com a1@a.com
EOF
``````

Results:

``````A a3@a.com a1@a.com a2@a.com
B b1@b.com
``````

Other example:

``````perl -MList::Util=uniq -nE 'chomp; (\$n[\$.],@a)=split " "; @m=grep {defined \$_} map {\$l{\$_}} @a;
push @a, map {@{\$a{\$_}}} @m; @a=uniq @a; delete \$a{\$_} for @m;@l{@a}=(\$.)x@a; \$a{\$.}=[@a];
END {say "\$n[\$_] @{\$a{\$_}}" for keys %a;}' <<EOF
A a1@a.com a2@a.com
B b1@b.com
A a3@a.com a1@a.com
EOF
``````

Results:

``````A a3@a.com a1@a.com a2@a.com
B b1@b.com
``````

Results:

``````A a1@a.com a3@a.com a2@a.com
B b1@b.com
``````

Yet another example:

``````perl -MList::Util=uniq -nE 'chomp; (\$n[\$.],@a)=split " "; @m=grep {defined \$_} map {\$l{\$_}} @a;
push @a, map {@{\$a{\$_}}} @m; @a=uniq @a; delete \$a{\$_} for @m;@l{@a}=(\$.)x@a; \$a{\$.}=[@a];
END {say "\$n[\$_] @{\$a{\$_}}" for keys %a;}' <<EOF
A a1@a.com a2@a.com
B b1@b.com
A a3@a.com
B b2@b.com b1@b.com
EOF
``````

Results:

``````A a1@a.com a2@a.com
A a3@a.com
B b2@b.com b1@b.com
``````

Last example:

``````perl -MList::Util=uniq -nE 'chomp; (\$n[\$.],@a)=split " "; @m=grep {defined \$_} map {\$l{\$_}} @a;
push @a, map {@{\$a{\$_}}} @m; @a=uniq @a; delete \$a{\$_} for @m;@l{@a}=(\$.)x@a; \$a{\$.}=[@a];
END {say "\$n[\$_] @{\$a{\$_}}" for keys %a;}' <<EOF
A a@a.com
B b@b.com
C c@c.com
D b@b.com a@a.com c@c.com
EOF
``````

Results:

``````D b@b.com a@a.com c@c.com
``````

The full code is similar:

`````` 1  # Perl weekly challenge 209
2  # Task 2:  Merge Account
3  #
5  use v5.36;
6  use English;
7  use List::Util qw(uniq);
8  my %line_of;
10  my @names;
11  while(<>){
12      chomp;
14      my (\$name, @addresses)=split ' ';
15      next unless \$name; # skip empty lines
16      \$names[\$INPUT_LINE_NUMBER]=\$name;
17      my @merged=grep {defined \$_} map {\$line_of{\$_}} @addresses; # lines to merge with current
20      delete \$addresses_of{\$_} for @merged;                       # delete merged lines
23  }
24  # Output. Sort by account name and line number, and sort addresses
25  say "\$names[\$_] (\$_): ", join " ",
26      sort {\$a cmp \$b} @{\$addresses_of{\$_}}
27      for sort {\$names[\$a] cmp \$names[\$b] || \$a <=>\$b} keys %addresses_of;
``````

Example:

``````./ch-2.pl <<EOF
A a1@a.com a2@a.com
B b1@b.com
A a3@a.com a1@a.com
EOF
``````

Results:

``````A (3): a1@a.com a2@a.com a3@a.com
B (2): b1@b.com
``````

Another example:

``````./ch-2.pl <<EOF
A a1@a.com a2@a.com
B b1@b.com
A a3@a.com
B b2@b.com b1@b.com
EOF
``````

Results:

``````A (1): a1@a.com a2@a.com
A (3): a3@a.com
B (4): b1@b.com b2@b.com
``````

I added line numbers to the output, to distinguish different accounts with the same name.

A more complicated example:

``````./ch-2.pl <<EOF
A a@a.com
B b@b.com
C c@c.com
D b@b.com c@c.com a@a.com
EOF
``````

Results:

``````D (4): a@a.com b@b.com c@c.com
``````

Last example:

``````./ch-2.pl <<EOF
A a@a.com
B b@b.com c@c.com
C a@a.com c@c.com
EOF
``````

Results:

``````C (3): a@a.com b@b.com c@c.com
``````

## Additional tests, suggested by E. Choroba

Taken from his github page: Solve 209…

``````perl -MList::Util=uniq -nE 'chomp; (\$n[\$.],@a)=split " "; @m=grep {defined \$_} map {\$l{\$_}} @a;
push @a, map {@{\$a{\$_}}} @m; @a=uniq @a; delete \$a{\$_} for @m;@l{@a}=(\$.)x@a; \$a{\$.}=[@a];
END {say "\$n[\$_] @{\$a{\$_}}" for keys %a;}' <<EOF
A a1@a.com a2@a.com
A b1@b.com a1@a.com
A a3@a.com b1@b.com
EOF
./ch-2.pl <<EOF
A a1@a.com a2@a.com
A b1@b.com a1@a.com
A a3@a.com b1@b.com
EOF
perl -MList::Util=uniq -nE 'chomp; (\$n[\$.],@a)=split " "; @m=grep {defined \$_} map {\$l{\$_}} @a;
push @a, map {@{\$a{\$_}}} @m; @a=uniq @a; delete \$a{\$_} for @m;@l{@a}=(\$.)x@a; \$a{\$.}=[@a];
END {say "\$n[\$_] @{\$a{\$_}}" for keys %a;}' <<EOF
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
EOF
./ch-2.pl <<EOF
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
EOF
``````

Both the two liner and the full code passed!

Written on March 20, 2023