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!

Task #1: Excel Column

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($_));} .


Task #2 Find Numbers

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 #059

linked_item.png

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!

Task 1: Invert Tree

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.

Stay healthy and alert! □


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!

named.jpg

Oh.

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