CY's Take on PWC#094
If you want to challenge yourself on programming, especially on Perl and/or Raku, go to https://perlweeklychallenge.org, 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]
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
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 @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];
$k++;
}
else {
push @{$arr[ $hash_compounds{$l} ]}, $w;
}
}
The remaining is printing result:
print "(\"";
print join "\",\"", @{$arr[$j]};
print "\")\n";
}
Here are my manual tests:
$ perl ch-1.pl "opt" "bat" "saw" "tab" "pot" "top" "was"
("opt","pot","top")
("bat","tab")
("saw","was")
$ perl -CA ch-1.pl 屢敗屢戰 東南西北 屢戰屢敗 陳年 屢屢戰敗 年陳 過錯 錯過 東西南北 真善美 美善真 一二三 三二一 真善美聖 真 善 美
("屢敗屢戰","屢戰屢敗","屢屢戰敗")
("東南西北","東西南北")
("陳年","年陳")
("過錯","錯過")
("真善美","美善真")
("一二三","三二一")
("真善美聖")
("真")
("善")
("美")
$ perl ch-1.pl "x"
("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:
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], undef, undef)
}
}
}
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 ‐
For the traversal (inside the package BinaryTreeNode):
sub to_llnode {
return SLL::Node->new(shift, undef);
}
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) ;
$baby->set_nextnode(tree_travel($self,${$t->leftchild}));
} elsif (defined $t->rightchild) {
$baby->set_nextnode(tree_travel($self,${$t->rightchild}));
} elsif (scalar @tt_stack != 0) {
my $n = pop @tt_stack;
$baby->set_nextnode(tree_travel($self,${$n}));
}
return $$preserve;
}
For the printing (similar to the post in the three months ago):
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)
This blog is inactive and replaced by https://e7-87-83.github.io/coding/blog.html ; but I post highly Perl-related posts here.
Leave a comment