## CY's Post on PWC#060: Numbers with Headache

This is a part of Perl Weekly Challenge(PWC) #060 and the followings are related to my solution. If you want to challenge yourself on Perl, go to https://perlweeklychallenge.org, code the latest challenges, submit codes on-time (by GitHub or email) if possible, before reading my blog post

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

Firstly we observe that 16384 < 263 = 17576 . Therefore there are at most 3 alphabets for the spreedsheet nomenclature. Knowing the cases to handle are not massive, I handle the cases with some subroutines named AtoOne, AtoZero and OnetoA.

The in-production testing line is for (1..3000) {print (numtoExcelCol(\$_),"\n"} and the finalized testing line is     for (1..\$MAX) {print(\$_,"\n") unless \$_ == excelcoltoNum(numtoExcelCol(\$_));} .

The original task makes me feel it is an exercise for using the module Math::Combinatorics .

Afterall, hence I modify the following more mathematically interesting task for myself:

Write a script that accepts a list of non-necessarily-to-be-unique digits (@L) and two positive numbers \$X and \$Y.

The script should print all possible numbers made by concatenating the items from @L, whose length is exactly \$X but value is less than \$Y.

Example

Input:

````@L ``=`` (``0``, ``1``, ``2``, ``5``);`
`\$X ``=`` ``2``;`
`\$Y ``=`` ``21``;````

Output: 10, 11, 12, 15, 20

It will be a bit fun challenging and we have to do optimization when \$X and \$Y is both large (in two different senses)...

Example

Input:

````@L ``=`` (``0``, 1, 1 , 1, 1 , 1 ,1, 1, 1, 1, 2, 3, 4, 4, 4, 4, 5, 6);`
`\$Y ``=`` ``13179794``;````
(But, for fun, \$X has to equal to length(\$Y) now.)

On my poor laptop, it spends about 33~34 sec to output the 45451 solutions , from 10111111 to 13165444, by a "brute-force"-styled script.

May To Be Continued (if the author has time before Monday, and reflect whether this modification of problem statement is really that interesting 😅)...  # written on Friday night

--------------------------------------

#written on Monday early morning BEGIN

Hi All! I have just finished coding my targeted coding task. It spent about 2~3 sec for \$Y=13179794 and @L = (0, 1, 1 , 1, 1 , 1 ,1, 1, 1, 1, 2, 3, 4, 4, 4, 4, 5, 6); now.

#END

#!/usr/bin/perl
use strict;
use Math::Combinatorics;

#my @L = (0,1,1, 2, 3, 5);
#my \$Y = 247;

my @L = (0, 11 , 11 , 1 ,1,1 , 1123, 4, 4, 4, 4, 56);
my \$Y = 13179794;
#my \$Y = 131797;
#my \$Y = 13;
#my \$Y = 34;
my \$X = length(\$Y);

my @freq = myfreq(@L);

my @combo = ();
my @ydigits = split //\$Y;

(\$X <= \$#L and \$freq[0] != \$Xor die "no solution, too few non-zero digits";

sub myfreq {
my @box = map {0} (0..9);
for (@_) {\$box[\$_]++};
return @box;
}

sub removed {
my \$unpopular = shift @_;
my @list = @_;
for (split //\$unpopular) { \$list[\$_]-- if \$list[\$_] > 0 ;}
return @list;
}

sub findall {
my \$item = shift @_;
my @list = @_;
for (split //\$item) {
if (\$list[\$_] > 0) {
\$list[\$_]--;
}
elsif (\$list[\$_] == 0) {
return 0;
}

}
return 1;
}

my \$i = 1;
my \$ship = "";
running(1,1);

for \$i (2..\$X-1) {
\$ship .= \$ydigits[\$i-2];
if (findall(\$ship@freq)) {
running(0,\$i)
};
}

\$i = \$X;
\$ship .= \$ydigits[\$X-2];
for my \$p (0..9) {
if (findall(\$ship@freqand \$p < \$ydigits[\$X-1]) {
my @tailfreq = removed(\$ship@freq);
if (\$tailfreq[\$p] != 0) {
push @combo\$ship.\$p;
}
}
}

sub running {
my \$starter = \$_[0];
my \$j = \$_[1];
for (my \$temp = \$starter\$temp < \$ydigits[\$j-1]; \$temp++) {
my @tailfreq = @freq;
if (\$ship ne "") { @tailfreq = removed(\$ship@freq) };
if (\$tailfreq[\$temp] != 0) {
@tailfreq = removed( \$temp ,@tailfreq );
my \$a = Math::Combinatorics->new(
count=>\$X-\$j
data => [(0..9)],
frequency => [@tailfreq
);

while (my @elems = \$a->next_multiset) {
my @newfreq = myfreq(@elems);
my \$c = Math::Combinatorics->new(
count=>\$X-\$j,
data=> [(0..9)],
frequency => [@newfreq]
);
while (my @b = \$c->next_string) {
push @combo, ( \$ship.\$temp.(join "" , @b) ) ;
}
}
}
}
}

print join "\n" , sort @combo;
print "\n";

## CY's take on Perl Weekly Challenge #057

This is a part of Perl Weekly Challenge(PWC) #057 and the followings are related to my solution.

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

There is a module Tree::Binary on CPAN and its method "mirror" does what exactly describe in the Task 1. Of course, the experience of using a shortcut won't be filled a blog post.

Last week (PWC #056) I did not attempt the binary tree task but I did read the blogs of other PWC members.

Hence, it's time for my "blog report". Blog posts I use as reference are

Discovered from reading, one of the ways of representing a binary tree which I hadn't thought of but very intuitive, is putting the nodes row by row!

Just like this:

( [5], [4,8], [11, 14, 13, 9],
[7, 2, 141, 142, 6, 5, 5, 1] );

Using this representation, it is very easy to invert the tree. Just swap the elements.

sub swaprowformtree {
my @btree = @_;
my \$N = \$#btree;
for my \$i (1..\$N) {
for my \$j (0..2**(\$i-1)-1) {
(\$btree[\$i][\$j], \$btree[\$i][2**(\$i)-1-\$j])
= (\$btree[\$i][2**(\$i)-1-\$j], \$btree[\$i][\$j]);
}
}

return @btree;
}

(May I name this "row form" of binary tree representation.)

The two most common ways are using nested array and using nested hash. I have implemented the nested array form.

The details of scripting is, again, transformation and reverse transformation!

To be lazy, I use Data::Dumper to output the binary tree:

use Data::Dumper;

...

\$Data::Dumper::Terse = 1
\$Data::Dumper::Indent = 0;

print Dumper rowform_transform_array swaprowformtree @ro_tree1;

where @ro_tree1 is the product of these codes:

my @ro_tree1;

sub array_transform_rowform {

my (\$h\$val@kids) = @_;
if (! defined(@ro_tree1[\$h])) {
@{\$ro_tree1[\$h]} = ();
}
push @{\$ro_tree1[\$h]}, \$val

if (\$kids[0]) {
my (\$temp@smallkids) = @{kids[0]};
array_transform_rowform(\$h+1shift @{\$kids[0]}, @{\$kids[0]});
}
if (\$kids[1]) {
my (\$temp@smallkids) = @{kids[1]};
array_transform_rowform(\$h+1shift @{\$kids[1]}, @{\$kids[1]});
}

}

Actually the transformations between nested array and row form is the most difficult part of the coding for me this week.

sub rowform_transform_array {
my @rowform = @_;
my \$height = \$#rowform;
my @data = ();
for (0..2**\$height-1) { push @data, [ \$rowform[\$height][\$_] ];  }
for my \$i (reverse 1..\$height-1) {
my @newdata = ();
for my \$j (0..2**\$i-1) {
\$newdata[\$j] = CombineTwo(\$data[\$j*2], \$data[\$j*2+1]);
unshift @{\$newdata[\$j]}, \$rowform[\$i][\$j];
}
for my \$j (0..2**(\$i-1)) {\$data[\$j] = \$newdata[\$j];}
}
return [\$rowform[0][0], \$data[0], \$data[1]] ;
}

sub CombineTwo {
my @temp = (\$_[0], \$_[1]);
return \@temp;
}

I would like to implement the nested hash if I had more spare time.

#### Task 2: Shortest Unique Prefix

With sorting, this task doesn't seem difficult, so I try on it.

This is my first time to use dualvar in Scalar::Util. It is quite a funny construct. I use it to keep the order of the provided list.

Its official description is: " my \$var = dualvar( \$num\$string ); # Returns a scalar that has the value \$num in a numeric context and the value \$string in a string context." [source] The funny thing about it is we ask for its numeric value by \$var+0, and ask for its string value by "\$var".

There should be many ways and tricks on manipulations sorting on hashes. As a dessert of the post, visit Tutorial section of Perl Monks I read today and see the trick of "||" with uc(\$a) cmp uc(\$b), written by Our Respected davido in 2003. (Being extraordinarily formal seems like the culture of PM; unable to follow yet.) Time for the end of this blog.

My code can be found in  GitHub.

## the Giant Planet of Perl

Finally I saw posts of PWC#056 on blogs.perl.org .

I haven't found what to discuss about #056 Task #1. Just to keep people know this code producer is alive and healthy, I share my recent life:

On Perl resources:

1. Perl Monks

From a blogpost[1], I was hooked to https://www.perlmonks.com/ . Apart from many advanced Perl discussions, there is a book review section (not very active):

Book Reviews of Perl Monks

Yesterday I got…

## CY's take Perl Weekly Challenge on #055

This is a part of Perl Weekly Challenge(PWC) #055 and the followings are related to my solution.

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

Oh.

/var/www/users/c_y_fung/index.html