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