CY's Take on PWC#094

If you want to challenge yourself on programming, especially on Perl and/or Raku, go to, code the latest challenges, submit codes on-time (by GitHub or email).

Do tell me if I am wrong or you strongly oppose my statements!

Task 1 of #094 looks like a sibling of Task 1 of #092 (which Perl codes are recently reviewed, my submitted code here) and Task 2 of #094 looks like a sibling of Task 2 of #093 (where I use the array representation of binary tree, code here).

Task 1: Group Anagrams

Now I was thinking of CJK characters. When comparing terms, put -CA; and inside scripts, put use utf8; use open ':std', ':encoding(UTF-8)';.

And my approach is similar to that of Week #092. On #092, a sub learn_pattern produces a hash from the first parameter; and sub verify_pattern for the second parameter returns true or false. Now, this time we face a bulk of terms, therefore we have to &collect_alphabets: [1]

my %hash_num;

sub collect_alphabets {
    my @words = @_;
    my @alphabets = split //join("" , @words); 
    my $i = 0;
    for (@alphabets) {
        if (!exists $hash_num{$_}) { 
            $hash_num{$_} = $i++;

Afterwards a function for learning again

sub learn_atoms {
    my $word = $_[0];
    my @alphabets = split //$word;
    my @coord = map {$hash_num{$_}} @alphabets;
    @coord = sort @coord;
    return join ","@coord;

And I wrote a &compare_two_words without second thought. But it is not included in the main dish.

I group all the terms by an array of arrays and make use of a hash (%hash_compounds):

my %hash_compounds;
my @arr;
my $k = 0;

for my $w (@ARGV) {
    my $l = learn_atoms($w);
    if (!exists $hash_compounds{$l}) {
        $hash_compounds{$l} = $k
        $arr[$k] = [$w];
    else {
        push @{$arr$hash_compounds{$l} ]}, $w;

The remaining is printing result:

for my $j (0..$k) {
    print "(\"";
    print join "\",\""@{$arr[$j]};
    print "\")\n"

Here are my manual tests:

$ perl "opt" "bat" "saw" "tab" "pot" "top" "was"

$ perl -CA 屢敗屢戰 東南西北 屢戰屢敗 陳年 屢屢戰敗 年陳 過錯 錯過 東西南北 真善美 美善真 一二三 三二一 真善美聖 真 善 美

$ perl "x"

For the Unicode part, the reference: a stackoverflow post and a reddit post.

Task 2: Binary Tree to Linked List

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

Underlining is added by CY. Terms in programming can be obscure. I thought of object-oriented programming when I decided to start coding. I wrote two packages, one for linked lists, one for binary trees, in "traditional" Perl object-oriented system. I got "unblessed...". Then after a sleep, I tried Moose. The situation did not improve, Perl still gave out "unblessed..." messages. I accepted my capacity, and, looked at submitted solutions (an action I rarely do), no inspirations ‐ other submitters hadn't not touched on OO for this task. Then, unlike the previously hot celebrity in politics, I soon Accepted the Defeat ; wrote a version of script with OO linked list and array representation of binary tree; and, tweeted.

We know, tweets can be powerful! Our challenge organizer, Mohammand , replied my tweet with the word "please" and encouraged me not to give up. Initially I would like to reply with excuses. But some mysterious forces put me try harder. Although I have never written a full application by OOP (for any languages), I have heard of some OO terms. Suddenly the term "(multiple) inheritance" popped. Then I tried to write three packages, the third one specific for traversal. I used traditional Perl OO system (because I don't know how to alter attribute values in Moose). Well, my script still met hurdles - "Can't locate object method "nextnode" via package "BinaryTreeNode" ".

In the morning of Saturday, I have used two packages; put the traversal subroutine inside the binary tree package and let this package our @ISA = qw/ SLL::Node /;. Finally the script Works (and More Importantly, I Can Tweet)!

Here is the binary tree, very direct:

package BinaryTreeNode;

our @ISA = qw/ SLL::Node /;

sub new {
    my ($class) = @_;
    bless {
        _value => $_[1],
        _leftchild => $_[2],
        _rightchild => $_[3],
    }, $class;

sub value { $_[0]->{_value} }

sub leftchild { $_[0]->{_leftchild} }

sub rightchild { $_[0]->{_rightchild} }

sub create_tree_from_list {
    my ($class,@arr) = @_;
    my $lastleaf = $#arr;
    my @tree;

    for my $k (reverse 0..$lastleaf) {
        if (defined($arr[$k])) {
            if (defined($arr[$k*2+1]) and defined($arr[$k*2+2])) {
                $tree[$k] = BinaryTreeNode->new(
                  $arr[$k], \$tree[$k*2+1], \$tree[$k*2+2]) 
            if (defined($arr[$k*2+1]) and !defined($arr[$k*2+2])) {
                $tree[$k] = BinaryTreeNode->new(
                  $arr[$k], \$tree[$k*2+1], undef
            if (!defined($arr[$k*2+1]) and defined($arr[$k*2+2])) {
                $tree[$k] = BinaryTreeNode->new(
                  $arr[$k], undef, \$tree[$k*2+2]) 
            if (!defined($arr[$k*2+1]) and !defined($arr[$k*2+2])) {
                $tree[$k] = BinaryTreeNode->new(
                  $arr[$k], undefundef

    return $class$tree[0];  #return tree root

The linked list used differ from codes written three months ago (the post here) just by an additional one-line method ‐

sub set_nextnode { $_[0]->{_nextnode} = $_[1]; }

For the traversal (inside the package BinaryTreeNode):

my @tt_stack = ();

sub to_llnode {
    return SLL::Node->new(shiftundef);

sub tree_travel {
    my $self = shift;
    my $t = shift;
    my $baby = to_llnode($t->value);
    my $preserve = \$baby;
    if (defined $t->leftchild) {
        push @tt_stack$t->rightchild if defined($t->rightchild) ;
    } elsif (defined $t->rightchild) {
    } elsif (scalar @tt_stack != 0) {
        my $n = pop @tt_stack;

    return $$preserve;

For the printing (similar to the post in the three months ago):

my $node = $rootnode;
while (defined $node->nextnode) {
    print $node->value" -> ";
    $node = $node->nextnode;
print $node->value#final value
print "\n";

Full code on GitHub: link (with Java solution for task 2) □

Stay healthy! (written on 9th Jan 2021 (probably a remarkable day in the 21st century history) night, Hong Kong Time Zone).

[1] better name as "collect_letters"... As we won't say Chinese alphabets or Korean alphabets.
For those who may be interested in the meaning of those Chinese terms:
屢敗屢戰 fight disregard of previous failures
屢戰屢敗 fight again and again , but fail always
屢屢戰敗 fight again and again , but fail always
東 East
西 West
北 North
南 South
真 truth
善 goodness
美 beauty
聖 holiness
一二三 one, two, three
陳年 aged
年陳 well... This could be a name of someone.
過錯 wrongness
錯過 miss ("to fail to do or experience something", from dictionary)

Leave a comment

About C.-Y. Fung

user-pic This blog is inactive and replaced by ; but I post highly Perl-related posts here.