Perl Weekly Challenge 94.

My solutions (task 1, task 2 and an alternative solution to task 2) to the The Weekly Challenge - 094.

Task 1: Group Anagrams

Submitted by: Mohammad S Anwar

You are given an array of strings @S.

Write a script to group Anagrams together in any random order.

An Anagram is a word or phrase formed by rearranging the letters of a different word or phrase, typically using all the original letters exactly once.

Example 1:

Input: ("opt", "bat", "saw", "tab", "pot", "top", "was")
Output: [ ("bat", "tab"),
          ("saw", "was"),
          ("top", "pot", "opt") ]

Example 2:
    Input: ("x")
    Output: [ ("x") ]

This task has a very compact solution. Two words are anagrams if and only if they are mapped to identical canonical representations. We choose as the canonical representation of the words a word made with the same letters ordered alphabetically. I read the arguments from the command line, push them into arrays indexed by the corresponding canonical strings and then print these arrays one per line. For simplicity I disregarded the format: quotation marks, commas and square brackets.

# Perl weekly challenge 094
# Task 1: Group anagrams.
# From a list of strings recognize anagrams and group them.
# See https:/wlmb.github.io/2020/01/04/PWC94/#task-1-group-anagrams
use v5.12;
my %anagrams;
push @{$anagrams{join '', sort split '', $_}}, $_ foreach @ARGV;
say join(" ", @{$anagrams{$_}})foreach keys %anagrams;

Example 1:

./ch-1.pl opt bat saw tab pot top was

Results:

opt pot top
saw was
bat tab

Example 2:

./ch-1.pl x

Results:

x

Actually, the code is short enough that it is appropriate for a one-liner.

Example 1’:

perl -E 'push @{$anagrams{join "", sort split "", $_}}, $_ foreach @ARGV; say join(" ", @{$anagrams{$_}})foreach keys %anagrams;' opt bat saw tab pot top was

Results:

saw was
opt pot top
bat tab

Example 2’:

perl -E 'push @{$anagrams{join "", sort split "", $_}}, $_ foreach @ARGV; say join(" ", @{$anagrams{$_}})foreach keys %anagrams;' x

Results:

x

Task 2: Binary Tree to Linked List

Submitted by: Mohammad S Anwar

You are given a binary tree.

Write a script to represent the given binary tree as an object and flatten it to a linked list object. Finally print the linked list object.

Example:

Input:

    1
   / \
  2   3
 / \
4   5
   / \
  6   7

Output:

    1 -> 2 -> 4 -> 5 -> 6 -> 7 -> 3

If I omit the ‘object’ part of the task, it also has a very short solution, using the fact that perl flattens lists automatically. Thus, I may represent each node as a three element list, where the first element is the value and the second and third are its left and right descendants, empty for the leaves. Thus, the tree above would be represented as (1,(2,(4,(),()),(5,(6,(),()),(7,(),()))),(3,(),())). The program would simply evaluate this expression in perl.

Example

perl -E 'say join "->", (1,(2,(4,(),()),(5,(6,(),()),(7,(),()))),(3,(),()))'

Results:

1->2->4->5->6->7->3

A not so nice and simple program doing the same and obtaining its arguments as a string from the command line follows.

# Perl weekly challenge 094
# Task 2: Binary tree to linked list.
#
# See https:/wlmb.github.io/2020/01/04/PWC94/#task-1-binary-tree-to-linked-list
use v5.12;
use Text::Balanced qw(extract_bracketed extract_multiple);

I use Moose to define the tree object, together with a flatten method.

package Tree;
use Moose;
has value=>(is=>'ro', required=>1);
has left=>(is=>'ro', required=>1);
has right=>(is=>'ro', required=>1);

sub flatten {
    my $self=shift;
    return () unless defined $self->value;
    return ($self->value, $self->left?$self->left->flatten:(), $self->right?$self->right->flatten:());
}

Back to the main package, the program builds the tree, flattens it and prints it, as detailed in the task description. The arguments are taken from the command line as parenthesized strings.

package main;
foreach(@ARGV){
    # remove unnecesary commas
    tr/,//d;
    my $tree=build_tree($_);
    say("Empty tree"), next unless defined $tree;
    my @values=$tree->flatten;
    say join '->', @values;
}

The trees are built from string of the form ‘(value, left, right)’, parsed with Text::Balanced.

sub build_tree { #Build tree recursively from string representation
    my $string=shift @_;
    # strip parenthesis
    die "Wrong format of string $string" unless $string=~s/^\s*\((.*)\)\s*$/$1/;
    return undef if $string=~/^\s*$/; # empty tree
    my @parts=extract_multiple($string,[\&extract_bracketed]);
    die "Not a binary tree ", join " ",@parts unless @parts==3;
    my($value, $left, $right)=@parts;
    die "Value can contain only alphanumerics: $value" unless $value=~s/^\s*(\w+)\s*$/$1/;
    return Tree->new(value=>$value, left=> build_tree($left), right=>build_tree($right));
}

Somewhat more complicated than the oneliner above. Anyway, I test the given example:

./ch-2.pl '(1,(2,(4,(),()),(5,(6,(),()),(7,(),()))),(3,(),()))'

Results:

1->2->4->5->6->7->3

Other examples (subtrees only on the right, only on the left, a balanced binary tree, an empty tree):

./ch-2.pl '(1,(2,(3,(4,(),()),()),()),())'\
	  '(1,(),(2,(),(3,(),(4,(),()))))'\
	  '(1,(2,(4,(),()),(5,(),())),(3,(6,(),()),(7,(),())))'\
	  '()'

Results:

1->2->3->4
1->2->3->4
1->2->4->5->3->6->7
Empty tree

The inputs as parenthesized lists don’t look terribly nice and it is easy to make errors. I guess they would look better if the input tree is coded as a yaml file. To that end, I rewrite the program above using the YAML::Tiny package to process the inputs.

# Perl weekly challenge 094
# Task 2: Binary tree to linked list.
#
# See https:/wlmb.github.io/2020/01/04/PWC94/#task-1-binary-tree-to-linked-list
use v5.12;

package Tree;
use Moose;
has value=>(is=>'ro', required=>1);
has left=>(is=>'ro', required=>1);
has right=>(is=>'ro', required=>1);

sub flatten {
    my $self=shift;
    return () unless defined $self->value;
    return ($self->value,
	    $self->left?$self->left->flatten:(),
	    $self->right?$self->right->flatten:());
}

The program receives paths to yaml files in @ARGV, opens them and processes all its trees, one to each document.

package main;
use Data::Dumper;
use YAML::Tiny;
# @ARGV contains yaml filenames
foreach(@ARGV){ # for each yaml file
    my $yaml=YAML::Tiny->read($_); # convert yaml document to perl structure
    foreach(@{$yaml}){ #for each document in the file
	my $tree=build_tree($_);
	say("Empty tree"), next unless defined $tree;
	my @values=$tree->flatten;
	say join '->', @values;
    }
}

The trees are built from yaml objects: scalars for leaves, value:array pairs to represent a node with an array of of two subtrees, null is for for empty subtrees.

sub build_tree { #Build tree recursively
    my $tree=shift;
    return undef unless defined $tree; #Empty tree
    return Tree->new(value=>$tree, left=>undef, right=>undef) unless ref $tree; # a leaf
    # Die with an unsophisticated dump of the current subtree in case of errors
    die "Not a binary tree\n". Dumper($tree) unless ref $tree eq "HASH";
    my @keys=keys %{$tree};
    die "Not a binary tree\n". Dumper($tree) unless @keys==1;
    my $node=$keys[0];
    my $subtrees=$tree->{$node};
    die "Not a binary tree\n". Dumper($tree) unless ref $subtrees eq "ARRAY" and @$subtrees==2;
    my ($left,$right)=@$subtrees;
    return Tree->new(value=>$node, left=> build_tree($left), right=>build_tree($right));
}

For testing purposes, I make a yaml file and run the program on all the examples above.

cat <<EOF >rem.yml
---
# original example
1:
 - 2:
   - 4
   - 5:
     - 6
     - 7
 - 3
---
# only left descendants
1:
  - 2:
     - 3:
	- 4
	- ~
     - ~
  - ~
---
# only right descendants
1:
 - ~
 - 2:
    - ~
    - 3:
       - ~
       - 4
---
# balanced tree
1:
 - 2:
    - 4
    - 5
 - 3:
    - 6
    - 7
---
# empty
EOF
./ch-2a.pl rem.yml

Results:

1->2->4->5->6->7->3
1->2->3->4
1->2->3->4
1->2->4->5->3->6->7
Empty tree
Written on January 4, 2021