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";

Leave a comment

About C.-Y. Fung

user-pic This blog is inactive and replaced by https://e7-87-83.github.io/coding/blog.html ; but I post highly Perl-related posts here.